//利用本示例可以在别的程序建立自己的图形及事件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
HaHaBtnProc: Pointer;
OtherWindow,BtnHaHa: HWND;
function ButtonProc(hwnd: HWND; Msg: UINT;wparam: WPARAM;lparam: LPARAM):LRESULT;Stdcall;
begin
if Msg = WM_LBUTTONDOWN then
begin
ShowMessage('哈哈');
Result:= 0;
end
else
Result:= CallWindowProc(HaHaBtnProc,hwnd,Msg,wparam,lparam);
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
OtherWindow:= FindWindow(nil,PChar(Edit1.Text));
if OtherWindow = 0 then exit;
BtnHaHa:= CreateWindow('Button','退出',WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON,10,10,80,50,
OtherWindow,1,GetWindowLong(OtherWindow,GWL_HINSTANCE),nil);
Windows.SetParent(BtnHaHa,OtherWindow);
HaHaBtnProc:= Pointer(SetWindowLong(BtnHaHa,GWL_WNDPROC,Longint(@ButtonProc)));
end;
end.
对应的Form文件
object Form1: TForm1
Left = 112
Top = 108
Width = 696
Height = 480
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 Edit1: TEdit
Left = 72
Top = 152
Width = 345
Height = 21
TabOrder = 0
Text = 'MSN Messenger'
end
object Button1: TButton
Left = 440
Top = 152
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
end
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
var
HaHaBtnProc: Pointer;
OtherWindow,BtnHaHa: HWND;
function ButtonProc(hwnd: HWND; Msg: UINT;wparam: WPARAM;lparam: LPARAM):LRESULT;Stdcall;
begin
if Msg = WM_LBUTTONDOWN then
begin
ShowMessage('哈哈');
Result:= 0;
end
else
Result:= CallWindowProc(HaHaBtnProc,hwnd,Msg,wparam,lparam);
end;
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
OtherWindow:= FindWindow(nil,PChar(Edit1.Text));
if OtherWindow = 0 then exit;
BtnHaHa:= CreateWindow('Button','退出',WS_VISIBLE or WS_CHILD or BS_PUSHBUTTON,10,10,80,50,
OtherWindow,1,GetWindowLong(OtherWindow,GWL_HINSTANCE),nil);
Windows.SetParent(BtnHaHa,OtherWindow);
HaHaBtnProc:= Pointer(SetWindowLong(BtnHaHa,GWL_WNDPROC,Longint(@ButtonProc)));
end;
end.
对应的Form文件
object Form1: TForm1
Left = 112
Top = 108
Width = 696
Height = 480
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 Edit1: TEdit
Left = 72
Top = 152
Width = 345
Height = 21
TabOrder = 0
Text = 'MSN Messenger'
end
object Button1: TButton
Left = 440
Top = 152
Width = 75
Height = 25
Caption = 'Button1'
TabOrder = 1
OnClick = Button1Click
end
end