Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Начинающим";
Текущий архив: 2008.08.10;
Скачать: [xml.tar.bz2];

Вниз

Скриншот окна броузера   Найти похожие ветки 

 
kyn66 ©   (2008-07-09 11:57) [0]

Уважаемые мастера, возникла задача снять скриншот окна броузера, именно его рабочего окна, а не всего окна монитора.
Спасибо.


 
Palladin ©   (2008-07-09 12:28) [1]

Alt+Print Screen


 
kyn66 ©   (2008-07-09 12:36) [2]

Мне не нужна распечатка, а тем боле всег экрана. В вопросе четко указана зона захвата.


 
Palladin ©   (2008-07-09 12:51) [3]

Alt+Print Screen
Paint


 
Leonid Troyanovsky ©   (2008-07-09 12:52) [4]

Удалено модератором
Примечание: Выбираем выражения...


 
brother ©   (2008-07-09 12:57) [5]

Удалено модератором


 
Anatoly Podgoretsky ©   (2008-07-09 13:00) [6]

Ну так Print же. Перевожу на падонский Распечатка


 
kyn66 ©   (2008-07-09 13:06) [7]

Ну и как доступ к этой области заполучить? Мне нужно в файл сохранить. Раньше делал так:

procedure TGenTFrm.SaveImageToFile(NameSave : String; TypeFile : Byte);
var
 BitMap1 : Graphics.TBitmap;
 Image1  : TImage;
 Jpeg1   : TJPEGImage;  
 Png1    : TPNGObject;
begin
 BitMap1 := TBitMap.Create;
 try
   BitMap1.Height:=GPanel1.Height;
   BitMap1.Width:=GPanel1.Width;
   BitBlt(BitMap1.Canvas.Handle, 0 {Лево}, 0{Top},GPanel1.Width, GPanel1.Height,
          GetDC(GPanel1.Handle), 0, 0, SRCCOPY);
   Image1 := TImage.Create(nil);
   BitMap1.IgnorePalette := True;
   Image1.Picture.Assign(BitMap1);
   Case TypeFile of
      0 : begin
            BitMap1.SaveToFile(NameSave + ".bmp");
          end;
      1 : begin
            Jpeg1 := TJpegImage.Create;
            Jpeg1.Assign(Image1.Picture.Bitmap);
            Jpeg1.SaveToFile(NameSave + ".jpg");
            Jpeg1.Free;
          end;
      2 : begin
            Png1 := TPNGObject.Create;
            Png1.Assign(Image1.Picture.Bitmap);
            Png1.SaveToFile(NameSave + ".png");
            Png1.Free;
          end;
   end;{Case}
   Image1.Free;
   Messager.Message := "Картинка скопирована " + #10#13 +
                       "на жесткий диск.";
   Messager.Show;
 finally
   BitMap1.Free;
 end;
end;


Только в данном случае я четко указывал на область копирования. А сейчас как быть?


 
brother ©   (2008-07-09 13:09) [8]

про delphi никто не говорил ;)


 
brother ©   (2008-07-09 13:12) [9]

как я себе это представляю:
находим окно броузера
выясняем его left, top, heigh, width
копируем только эту область...


 
kyn66 ©   (2008-07-09 13:18) [10]

Приблизительно так. Осталось его найти. Известен тока класс. Не имени нет , ничего.

про delphi никто не говорил ;)
А мы на каком форуме находимся? ;)


 
turbouser ©   (2008-07-09 13:19) [11]


> kyn66 ©   (09.07.08 13:18) [10]
>
> Приблизительно так. Осталось его найти.

GetForegroundWindow


 
brother ©   (2008-07-09 13:21) [12]

> А мы на каком форуме находимся? ;)

не знаю где остальные, я в танке))))))))))


 
clickmaker ©   (2008-07-09 13:22) [13]

> Приблизительно так. Осталось его найти. Известен тока класс

FindWindow


 
brother ©   (2008-07-09 13:23) [14]

> Известен тока класс.

по нему, как мне помнится, тож можно искать


 
Rouse_ ©   (2008-07-09 13:41) [15]

Это устроит?
http://www.swissdelphicenter.ch/en/showcode.php?id=1983


 
kyn66 ©   (2008-07-09 13:41) [16]

>FindWindow
Про окно ничего не известно. Попробуйте сами посмотреть прогой, которая покажет тока класс активного окна.


 
ketmar ©   (2008-07-09 14:03) [17]

>[16] kyn66 © (2008-07-09 13:41:00)
>Про окно ничего не известно

так узнай.

---
All Your Base Are Belong to Us


 
kyn66 ©   (2008-07-09 15:13) [18]

>Это устроит?
Что-то вроде похоже.... Спасибо, попробую разбираться.


 
Zeqfreed ©   (2008-07-09 15:26) [19]

Как вариант — использовать lynx и fbgrab ;)


 
ketmar ©   (2008-07-09 15:34) [20]

>[19] Zeqfreed © (2008-07-09 15:26:00)
тю. links --dump %-)

---
All Your Base Are Belong to Us


 
kyn66 ©   (2008-07-09 16:37) [21]

gs nf.cm разобраться с примером http://www.swissdelphicenter.ch/en/showcode.php?id=1983 , однако не понятно откуда взято:

 IDoc1: IHTMLDocument2;
 Web: ShDocVW_TLB.IWebBrowser2;


 
Rouse_ ©   (2008-07-09 18:22) [22]

uses ShDocVW


 
kyn66 ©   (2008-07-10 09:15) [23]

Да, с этим разобрался, однако ни пример http://www.swissdelphicenter.ch/en/showcode.php?id=1983 ни GetForegroundWindow не подходит. В первом случае используется TWebBrowser(а задача сосотит в том, чтобы получить скрин со стндртного IE или Оперы), во втором случае берется полностью окно, а не его рабочая область. Решение пока не найдено. Есть ешшо варианты?


 
Rouse_ ©   (2008-07-10 09:26) [24]


> используется TWebBrowser(а задача сосотит в том, чтобы получить
> скрин со стндртного IE

Интерфейс один и тот-же. Немного измени и все. А для получения окна IE вот тебе пример, ищет хэндл браузера в который открыт указанный путь, походя перебирает все открытые окна браузеров.

procedure TForm1.Button1Click(Sender: TObject);

 function ParceURLName(const Value: String): String;
 const
   scFilePath: array [0..7] of Char = ("f", "i", "l", "e", ":", "/", "/", "/");
 begin
   if CompareMem(@scFilePath[0], @Value[1], 8) then
   begin
     Result := Copy(Value, 9, Length(Value));
     Result := StringReplace(Result, "/", "\", [rfReplaceAll]);
     Result := StringReplace(Result, "%20", " ", [rfReplaceAll]);
   end
   else
     Result := Value;
 end;

var
 iShellWindow: IShellWindows;
 iWB: IWebBrowserApp;
 spDisp: IDispatch;
 I: Integer;
 S: String;
begin
 iShellWindow := CoShellWindows.Create;
 for I := 0 to iShellWindow.Count - 1 do
 begin
   spDisp := iShellWindow.Item(I);
   if spDisp = nil then Continue;
   spDisp.QueryInterface(IWebBrowserApp, iWB);
   if iWB <> nil then
   begin
     S := ParceURLName(iWB.LocationURL);
     if AnsiUpperCase(S) = AnsiUpperCase(Edit1.Text) then
     begin
       ShowMessage("Окно найдено, хэндл окна: " + IntToStr(iWB.HWND));
       Exit;
     end;
   end;
 end;
 ShowMessage("Окно не найдено");
end;


 
iZEN   (2008-07-10 09:35) [25]

Используй ImageMagick.

man import


 
kyn66 ©   (2008-07-10 11:48) [26]

>Rouse_
Так, уже что-то ближе. Однако проверив  убедился, что данный код работает только с IE, а с Оперой нет. И нет смысла перебирать все окна, нужно остановиться только на тивном. Получается, что найти хэндл окна можно только зная урл.... НУжно активное и все.

>iZEN
Используй ImageMagick.
Это мне ни о чем не говорит :(


 
Rouse_ ©   (2008-07-10 12:10) [27]


> Получается, что найти хэндл окна можно только зная урл..
> .. НУжно активное и все.

А с активным то у тебя какие проблемы? Неужто чуть-чуть покумекать и поменять немного код нельзя?

uses
 SHDocVw;

function ParceURLName(const Value: String): String;
const
 scFilePath: array [0..7] of Char = ("f", "i", "l", "e", ":", "/", "/", "/");
begin
 if CompareMem(@scFilePath[0], @Value[1], 8) then
 begin
   Result := Copy(Value, 9, Length(Value));
   Result := StringReplace(Result, "/", "\", [rfReplaceAll]);
   Result := StringReplace(Result, "%20", " ", [rfReplaceAll]);
 end
 else
   Result := Value;
end;

function GetBrowserPath(TID: DWORD): String;
var
 iShellWindow: IShellWindows;
 iWB: IWebBrowserApp;
 spDisp: IDispatch;
 I: Integer;
begin
 Result := "";
 iShellWindow := CoShellWindows.Create;
 for I := 0 to iShellWindow.Count - 1 do
 begin
   spDisp := iShellWindow.Item(I);
   if spDisp = nil then Continue;
   spDisp.QueryInterface(IWebBrowserApp, iWB);
   if iWB <> nil then
     if GetWindowThreadProcessId(iWB.HWND) = TID then
     begin
       Result := ParceURLName(iWB.LocationURL);
       Break;
     end;
 end;
end;

procedure TForm25.Timer1Timer(Sender: TObject);
begin
 Memo1.Lines.Add(GetBrowserPath(
   GetWindowThreadProcessId(GetForegroundWindow)));
end;


 
Anatoly Podgoretsky ©   (2008-07-10 12:34) [28]

> kyn66  (10.07.2008 11:48:26)  [26]

> Это мне ни о чем не говорит :(

Спроси у Гугл, он знает и тебе расскажет тоже.



Страницы: 1 вся ветка

Форум: "Начинающим";
Текущий архив: 2008.08.10;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.52 MB
Время: 0.009 c
2-1215156404
laao
2008-07-04 11:26
2008.08.10
объясните поведение Delphi при выполнении следующего кода


15-1213898858
Knight
2008-06-19 22:07
2008.08.10
Железячники, что можно установить на MB Asus A7V600-X ?


15-1214040262
Kostafey
2008-06-21 13:24
2008.08.10
С днем рождения ! 21 июня


2-1215491519
hater
2008-07-08 08:31
2008.08.10
Параметры


15-1214220098
int64
2008-06-23 15:21
2008.08.10
Нет притока программистов в Delphi?





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский