Živě.cz o počítačích a internetu

Tipy a triky v Delphi, díl 125. - uložení webové stránky do obrázku

Jan Šindelář - 28.1.2004

Kompletní ukládání stránek z prohlížeče na disk pro pozdější offline čtení je jistě užitečná věc a je až s podivem, že tuto celkem jednoduchou a základní funkci začaly prohlížeče mít až od poměrně pokročilých verzí. Jedná se ale o uložení do HTML formátu (případně MHT souboru, což je webový archiv IE). My dnes zkusíme rovněž uložit stránku, ale v podobě obrázku JPEG.

Na prázdný formulář umístíme komponentu WebBrowser a tlačítko. Tlačítkem jako obvykle celou akci spustíme. Před samotným uložením stránky, resp. jejího obrázku, je potřeba zajistit, aby v komponentě WebBrowser již byla stránka kompletně načtena. Můžete například přidat na formulář další tlačítko nebo provést načtení požadované stránky jinak, ale důležité je to, aby byla stránka načtena před uložením, protože jinak bude logicky uložena nekompletní.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, MSHTML, JPEG, ActiveX, ComObj, OleCtrls, SHDocVw, StdCtrls;

type
  TForm1 = class(TForm)
    WebBrowser1: TWebBrowser;
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure JPEGfromBrowser(browser: iWebBrowser2; jpegFQFilename: string; srcHeight: Integer; srcWidth: Integer; tarHeight: Integer; tarWidth: Integer);
var
  sourceDrawRect, targetDrawRect: TRect;
  sourceBitmap, targetBitmap: TBitmap;
  jpeg: TJPEGImage;
  viewObject: IViewObject;
begin
  sourceBitmap := TBitmap.Create;
  targetBitmap := TBitmap.Create;
  jpeg := TJPEGImage.Create;
  try
    try
      sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
      sourceBitmap.Width := srcWidth;
      sourceBitmap.Height := srcHeight;
      viewObject := browser as IViewObject;
      if viewObject = nil then Exit;
      OleCheck(viewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Form1.Handle, sourceBitmap.Canvas.Handle, @sourceDrawRect, nil, nil, 0));
      targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
      targetBitmap.Height := tarHeight;
      targetBitmap.Width := tarWidth;
      targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);
      jpeg.Assign(targetBitmap);
      jpeg.SaveToFile(jpegFQFilename);
    finally
      jpeg.Free;
      sourceBitmap.Free;
      targetBitmap.Free;
    end;
  except
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  IDoc1: IHTMLDocument2;
  Web: ShDocVW.IWebBrowser2;
  tmpX, tmpY: Integer;
begin
  with WebBrowser1 do
  begin
    Document.QueryInterface(IHTMLDocument2, iDoc1);
    Web := ControlInterface;
    tmpX := Height;
    tmpY := Width;
    WebBrowser1.Visible := false;
    Height := OleObject.Document.ParentWindow.Screen.Height;
    Width := OleObject.Document.ParentWindow.Screen.Width;
    JPEGfromBrowser(Web,`c:\browser.jpg`, Height, Width, Height, Width);
    Height := tmpX;
    Width := tmpY;
    WebBrowser1.Visible := true;
  end;
end;

end.

Poslední dva parametry procedury JPEGfromBrowser určují rozměry výsledného obrázku. Zde právě vidím reálné využití tohoto postupu, protože rozměry mohou být pochopitelně i menší než je originál. Získáme tak zmenšený náhled načteného webu. Asi nemá cenu ukládat pro pozdější použití obrázek webové stránky v původní velikosti, ale zmenšené náhledy jednotlivých stránek mohou být šikovné rozšíření možností nějakého programu, který se webem zabývá (například nějaký správce oblíbených položek či něco podobného).