Opět se po čase vracíme ke komponentě WebBrowser. Naučíme se uložit její obsah, tedy právě načtenou stránku. Ne však jako HTML dokument, ale jako obrázek JPEG.
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).
