Delphi在Webbrowser上绘制图像
作者:admin 日期:2015-06-23
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, IEBrowser;
type
TForm1 = class(TForm)
Button1: TButton;
CppWebBrowser1: TCppWebBrowser;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
OldMessage: TWndMethod;
procedure OleMessage(var Msg: TMessage);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
CppWebBrowser1.Navigate('www.baidu.com');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//WebBrowser1.Navigate('www.baidu.com');
end;
procedure TForm1.FormShow(Sender: TObject);
begin
OldMessage := CppWebBrowser1.WindowProc;
CppWebBrowser1.WindowProc := OleMessage;
end;
procedure TForm1.OleMessage(var Msg: TMessage);
var
c: TCanvas;
bmpBG: TBitmap;
begin
OldMessage(Msg);
if Msg.Msg=WM_PAINT then
begin
bmpBG := TBitmap.Create;
bmpBG.Transparent := true;
bmpBG.LoadFromFile(ExtractFilePath(Application.ExeName) + 'back.bmp');
c := TControlCanvas.Create;
TControlCanvas(c).Control := CppWebBrowser1;
c.Brush.Style := bsClear;
c.StretchDraw(c.ClipRect, bmpBG);
end;
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, OleCtrls, IEBrowser;
type
TForm1 = class(TForm)
Button1: TButton;
CppWebBrowser1: TCppWebBrowser;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
OldMessage: TWndMethod;
procedure OleMessage(var Msg: TMessage);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
CppWebBrowser1.Navigate('www.baidu.com');
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
//WebBrowser1.Navigate('www.baidu.com');
end;
procedure TForm1.FormShow(Sender: TObject);
begin
OldMessage := CppWebBrowser1.WindowProc;
CppWebBrowser1.WindowProc := OleMessage;
end;
procedure TForm1.OleMessage(var Msg: TMessage);
var
c: TCanvas;
bmpBG: TBitmap;
begin
OldMessage(Msg);
if Msg.Msg=WM_PAINT then
begin
bmpBG := TBitmap.Create;
bmpBG.Transparent := true;
bmpBG.LoadFromFile(ExtractFilePath(Application.ExeName) + 'back.bmp');
c := TControlCanvas.Create;
TControlCanvas(c).Control := CppWebBrowser1;
c.Brush.Style := bsClear;
c.StretchDraw(c.ClipRect, bmpBG);
end;
end;
end.






评论: 0 | 引用: 0 | 查看次数: -
发表评论