Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате
Форум программистов > Delphi: ActiveX/СОМ/CORBA > Картинку из TWebBrowser в TImage


Автор: Jetus 25.10.2006, 09:23
На страничке в моём WebBrowser'e есть несколько картинок. На форме также есть компонент TImage.
Как мне скопировать конкретную картинку из браузера в TImage?

Автор: Yanis 25.10.2006, 09:52
Как вариант, узнать адрес картинки и загрузить её в TImage. А страница в WebBrowser загружается откуда?

Добавлено @ 09:55 
Ещё можно узнать координаты картинки и скопировать её изображение. Но это уже сомнительнее...

Добавлено @ 09:56 
Для первого варианта:
Код
uses
  UrlMon;

function DownloadFile(SourceFile, DestFile: string): Boolean;
begin
  try
    Result := UrlDownloadToFile(nil, PChar(SourceFile), PChar(DestFile), 0,
      nil) = 0;
  except
    Result := False;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  k, p: Integer;
  Source, dest, ext: string;
begin
  for k := 0 to WebBrowser1.OleObject.Document.Images.Length - 1 do
  begin
    Source := WebBrowser1.OleObject.Document.Images.Item(k).Src;
    p := LastDelimiter('.', Source);
    ext := UpperCase(Copy(Source, p + 1, Length(Source)));
    if (ext = 'GIF') or (ext = 'JPG') then
    begin
      p  := LastDelimiter('/', Source);
      dest := ExtractFilePath(ParamStr(0)) + Copy(Source, p + 1,
        Length(Source));
      DownloadFile(Source, dest);
    end;
  end;
end;


Взято с Швейцарского Delphi центра.

Автор: Jetus 26.10.2006, 13:56
Это я умею =)
Думаю, как бы это побыстрее делать, без сохранения в файл (ведь картинка уже вроде как загружена).

Автор: December 27.10.2006, 11:55
Универсальный ответ - никак smile
Если картинка гарантированно видна при текущем положении скроллбара TWebBrowser'a - то можно через специальный интерфейс взять его "скриншот" и ручками вырезать...

Автор: Yanis 28.10.2006, 17:49
Цитата(December @  27.10.2006,  12:55 Найти цитируемый пост)
Если картинка гарантированно видна при текущем положении скроллбара TWebBrowser'a - то можно через специальный интерфейс взять его "скриншот" и ручками вырезать... 


Я это и имел ввиду, когда говорил:
Цитата(Yanis @  25.10.2006,  10:52 Найти цитируемый пост)
Ещё можно узнать координаты картинки и скопировать её изображение. Но это уже сомнительнее...


Но по моему это не очень правильно smile

Автор: TrillerMan 28.12.2006, 16:33
Я кнечно с запазданицем)))
Но для чего всякие интерфейсы?
Если можно отловить где была зажата мышка и где отпущена получить прямоугольник,либо даже лучше прям визуально его менять растягивайся соответственно позиции мышы,как тока мышка отпустилась и выделить весь кусок,короче тот же фотошоп у вас в браузере,если замутите такое или если есть такие сорцы у кого-нить не обязательно с броузером подкиньте буду рад))

Автор: Sergey912 3.1.2007, 08:43
TrillerMan, 
Сам вот с ним мучаюсь, я незнаю как точно, но можно попробовать кэшировать страницы и брать ее потом из кэша. Будет как раз как надо - картинка на диске и мы ее еще раз не качаем.

Только его сначала надо точно включить и проверить куда и как  он все хозяйство сохраняет smile

Автор: IzumeRoot 4.1.2007, 13:52
У меня вот следующая проблема. Есть exe-шник. В нем находятся html-ки. Отображает он их с помощью контрола ActiveX. Я в своей программе нахожу контрол, в котором отображаетются странички, получаю IWebbrowser2, получаю IHTMLDocument2, IPersistFile и затем сохраняю страничку на винт:

Код

PersistFile.Save(StringToOleStr(fileName), True);
  while (HTMLDocument.readyState <> 'complete') do
    Application.ProcessMessages;



Всё это происходит благополучно. Но ведь таким образом не сохраняются картинки. Тогда я получаю адреса картинок и сохраняю их в ЛистБоксе, чтобы видеть
Код



........
var
 HTMLDocument: IHTMLDocument2; 
  PersistFile: IPersistFile;
  i:integer;
  Disp: IHTMLImgElement;
  Result1: Hresult;

.......


  ListBox1.Items.Clear;
  for  i:=0 to (HTMLDocument.images.length-1) do
  begin
     DIsp:= (HTMLDocument.images.item(i,0)) as IHTMLImgElement;
     ListBox1.Items.Add(Disp.src);
  end;




Получились имена в виде ebook: image1.gif. Если я делаю WebBrowser.Navigate к этим картинкам, что картинка благополучно отображается в контроле, а вот если не делать Навигейт а попытаться сохранить картинку (как я и хочу), то картинка не сохраняется. Сохраняю я их так

Код


for i:=0 to ListBox1.Items.Count-1 do
    begin

      Result1:=UrlDownLoadToFile(nil,PChar(ListBox1.Items[i]),PChar(sPathToGif),0,nil);
      if (Result1=S_OK) then  MessageBox(self.Handle, 'S_OK' ,'Down',mb_ok);
      if (Result1=E_OUTOFMEMORY) then  MessageBox(self.Handle, 'E_OUTOFMEMORY' ,'Down',mb_ok);
      if (Result1=INET_E_DOWNLOAD_FAILURE) then  MessageBox(self.Handle, 'INET_E_DOWNLOAD_FAILURE' ,'Down',mb_ok);
     
    end;





Не появляются и MessageBox-ы. Кто подскажет как же мне сохранить эти самые картинки? 

Автор: TrillerMan 19.1.2007, 00:47
Вот нашёл следующую строчку кода по теме 
Var
HTMLDocument: IHTMLDocument2;

for counter := 0 to htmldocument.images.length - 1 do
begin
(htmldocument.images.item(counter, 0) as IHTMLImgElement).src := 'new_image.jpg';
end;

Но когда я компилю этот код и вызываю его так:
procedure TForm1.Button2Click(Sender: TObject);
 begin
(htmldocument.images.item(2, 0) as IHTMLImgElement).src := 'new_image.jpg';
end;

Делфа ругаеться acces violation

В чём проблема ктонить знает решение?
Нужно чтобы сохранилась картинка в файл,но этого не выходит smile  smile 

Автор: IzumeRoot 20.1.2007, 00:11

TrillerMan, я что-то не вижу в твоем коде попытки сохранения в файл. Есть 

только попытка поменять ссылку на картинку в html-исходнике на свою 

new_image.jpg.

На счет моей проблемы. Я так понимаю, что мне остаётся только программно 

скрин загруженой странички снять для получения картинки. Но этож туфта. А с 

гифами как быть? Должен же быть способ. Сами эйч-ти-эм-элки то я достал...

Автор: andruha10 9.7.2010, 02:58
Цитата

Jetus  Дата 25.10.2006, 09:23

    На страничке в моём WebBrowser'e есть несколько картинок. На форме также есть компонент TImage.
Как мне скопировать конкретную картинку из браузера в TImage?


Так работает на 100% (сам долго перебирал варианты)
Код

procedure TForm1.btn2Click(Sender: TObject);
var
  body, imgs, controlRange: olevariant;
begin
        body := wb1.OleObject.document.body;
        imgs := wb1.OleObject.document.images.item(i);//нужный img
        controlRange := body.createControlRange;
        controlRange.add(imgs);
        controlRange.execCommand('Copy', False, EmptyParam);//копируем
        if ClipBoard.HasFormat(CF_BITMAP) then begin
          img1.Picture.Bitmap.LoadFromClipboardFormat(cf_BitMap, ClipBoard.GetAsHandle(cf_Bitmap), 0);//вставляем
          Clipboard.Clear;//если нужно очищаем буфер...
        end;
end;


P.S. Если проблема с копированием в буфер обмена:

Цитата

Не работает потому что нужно подключить функцию и процедуру из ole32.dll эта проблема описана на сайте майксофта.
Вот решение:

  • Подгрузил функцию и процедуру из dll
    Код

    var
      Form1: TForm1;

      function  OleInitialize(pvReserved: Pointer): HResult; stdcall;
    procedure OleUninitialize; stdcall;

    implementation


      function  OleInitialize;     external 'ole32.dll' name 'OleInitialize';
    procedure OleUninitialize;   external 'ole32.dll' name 'OleUninitialize';

    {$R *.dfm}


  • и только потом в конце перед end. инициализировал функцию.
    Код

    initialization
      OleInitialize(nil);

    finalization
      OleUninitialize;

      end.

Powered by Invision Power Board (http://www.invisionboard.com)
© Invision Power Services (http://www.invisionpower.com)