URL转图片

fMain.pas

unit fMain;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, OleCtrls, SHDocVw, StdCtrls, MSHTML;

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

var
  Form1: TForm1;

implementation

uses
  JPEG, ActiveX, ComObj;

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin { TForm1.Button1Click }
  WebBrowser1.Navigate(Edit1.Text)
end; { TForm1.Button1Click }

procedure GenerateJPEGfromBrowser(browser: iWebBrowser2;
                                  jpegFQFilename: string; srcHeight:
                                  integer; srcWidth: integer;
                                  tarHeight: integer; tarWidth: integer);
var
  sourceDrawRect: TRect;
  targetDrawRect: TRect;
  sourceBitmap  : TBitmap;
  targetBitmap  : TBitmap;
  aJPG          : TJPEGImage;
  aViewObject   : IViewObject;
begin { GenerateJPEGfromBrowser }
  sourceBitmap := TBitmap.Create;
  targetBitmap := TBitmap.Create;
  aJPG := TJPEGImage.Create;
  try
    try
      sourceDrawRect := Rect(0, 0, srcWidth, srcHeight);
      sourceBitmap.Width := srcWidth;
      sourceBitmap.Height := srcHeight;

      aViewObject := browser as IViewObject;

      if aViewObject=nil then
        Exit;

      OleCheck(aViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil,
                               Form1.Handle,
                               sourceBitmap.Canvas.Handle,
                               @sourceDrawRect, nil, nil, 0));

      // Resize the src bitmap to the target bitmap
      // Need to make thumbnails instead of full size?
      // set the target size here..
      targetDrawRect := Rect(0, 0, tarWidth, tarHeight);
      targetBitmap.Height := tarHeight;
      targetBitmap.Width := tarWidth;
      targetBitmap.Canvas.StretchDraw(targetDrawRect, sourceBitmap);

      // Create a JPEG from the Bitmap and save it
      aJPG.Assign(targetBitmap);

      aJPG.SaveToFile(jpegFQFilename)
    finally
      aJPG.Free;
      sourceBitmap.Free;
      targetBitmap.Free
    end; { try }

  except
    // error handler code
  end; { try }
end; { GenerateJPEGfromBrowser }

procedure TForm1.Button2Click(Sender: TObject);
var
  IDoc1: IHTMLDocument2;
  Web  : iWebBrowser2;
  tmpX,
  tmpY : integer;
begin { TForm1.Button2Click }
  with WebBrowser1 do
  begin
    Document.QueryInterface(IHTMLDocument2, IDoc1);
    Web := ControlInterface;
    tmpX := Height;
    tmpY := Width;
    Height := OleObject.Document.ParentWindow.Screen.Height;
    Width := OleObject.Document.ParentWindow.Screen.Width;
    GenerateJPEGfromBrowser(Web, './test.jpg',
                            Height, Width,
                            Height, Width);
    Height := tmpX;
    Width := tmpY;

    Image1.Picture.LoadFromFile('./test.jpg')
  end; { with WebBrowser1 }
end; { TForm1.Button2Click }

end.

fMain.dfm

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  ActiveControl = Edit1
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object Image1: TImage
    Left = 416
    Top = 40
    Width = 257
    Height = 217
    Stretch = True
  end
  object Edit1: TEdit
    Left = 8
    Top = 8
    Width = 141
    Height = 21
    TabOrder = 0
    Text = 'http://www.yahoo.com/'
  end
  object Button1: TButton
    Left = 183
    Top = 8
    Width = 75
    Height = 25
    Caption = '&Open URL'
    TabOrder = 1
    OnClick = Button1Click
  end
  object Button2: TButton
    Left = 268
    Top = 8
    Width = 75
    Height = 25
    Caption = '&Save as JPG'
    TabOrder = 2
    OnClick = Button2Click
  end
  object WebBrowser1: TWebBrowser
    Left = 8
    Top = 40
    Width = 400
    Height = 400
    TabOrder = 3
    ControlData = {
      4C00000057290000572900000000000000000000000000000000000000000000
      000000004C000000000000000000000001000000E0D057007335CF11AE690800
      2B2E126208000000000000004C0000000114020000000000C000000000000046
      8000000000000000000000000000000000000000000000000000000000000000
      00000000000000000100000000000000000000000000000000000000}
  end
end