Unit1.pas
新增2個按鈕，並在入事件
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, AppEvnts, StdCtrls, UnitTAA;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
ApplicationEvents1: TApplicationEvents;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
begin
AAInit;
g_AA.TestHD:=Self.Handle;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
g_AA.Destroy;
end;
procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
var Handled: Boolean);
begin
if Msg.message = WM_USER + 22 then
begin
Self.Caption:=IntToStr(Msg.wParam);
end;
end;
end.
UnitTAA.pas
unit UnitTAA;
interface
uses Windows, SysUtils, Classes, Graphics, ExtCtrls, Messages, UnitCommon;
const
TimerID_15 = 11111;
type
TAA = class(TObject)
private
{ Private declarations }
MyWinClass : TWndClass;
FMyHideHD : THandle;
FTestHd : THandle;
procedure Init;
public
{ Public declarations }
property MyHideHD : THandle read FMyHideHD;
property TestHD : THandle read FTestHD write FTestHd;
constructor Create;
destructor Destroy;
procedure OnTimer();
end;
procedure AAInit();
var
g_AA : TAA;
implementation
{ TAA }
function TAAWindowProc(hWnd:HWND; iMsg:Integer; wParam:WPARAM; lParam:LPARAM): Integer; stdcall;
var
uTimer : DWORD;
begin
Result:=0;
case iMsg of
WM_CREATE :
begin
uTimer:=SetTimer(hWnd,TimerID_15,1000,nil); //hWnd控制的把柄 TimerId_15標誌 nil指WM_TIMER將處理消息
//if(uTimer = 0) then
// Result:=-1;
exit;
end;
WM_DESTROY :
begin
KillTimer(hWnd, TimerID_15); //銷毀SetTimer建立的計時器
PostQuitMessage(0); //跟Windows說我要退出囉。
exit;
end;
WM_TIMER :
begin
g_AA.OnTimer();
exit;
end;
end;
Result := DefWindowProc(hWnd,iMsg,wParam,lParam); //不感興趣的消息，由windows去處理
end;
constructor TAA.Create;
var
uTimer : DWORD;
begin
DebugStr('TAA.Create');
inherited;
Init;
if IsWindow(FMyHideHD) then
begin
uTimer:=SetTimer(FMyHideHD,TimerID_15,1000,nil);
DebugStr('uTimer = ' + IntToStr(uTimer));
end;
end;
destructor TAA.Destroy;
begin
inherited;
if FMyHideHD <> 0 then
begin
KillTimer(FMyHideHD,TimerID_15);
DestroyWindow(FMyHideHD);
FMyHideHD:=0;
end;
end;
procedure TAA.Init;
var
TempClass : TWndClass;
ClassRegistered : Boolean;
begin
if IsWindow(FMyHideHD) then //檢查MyHD是否為有效的視窗代碼
exit;
try
MyWinClass.style := 0;
MyWinClass.lpfnWndProc := @TAAWindowProc;
MyWinClass.cbClsExtra := 0;
MyWinClass.cbWndExtra := SizeOf(Pointer);
MyWinClass.hInstance := 0;
MyWinClass.hIcon := 0;
MyWinClass.hCursor := 0;
MyWinClass.hbrBackground := 0;
MyWinClass.lpszMenuName := nil;
MyWinClass.lpszClassName := 'MyTAA';
MyWinClass.hInstance := HInstance;
ClassRegistered:=GetClassInfo( HInstance,
MyWinClass.lpszClassName,
TempClass);
//如果沒有存在此class 註冊一個
if not ClassRegistered then
begin
if Windows.RegisterClass(MyWinClass) = 0 then
Exit;
end;
FMyHideHD := CreateWindowEx( WS_EX_TOOLWINDOW,
MyWinClass.lpszClassName,
'', { Window name }
WS_POPUP, { Window Style }
0, 0, { X, Y }
0, 0, { Width, Height }
0, { hWndParent }
0, { hMenu }
HInstance, { hInstance }
nil); { CreateParam }
except
end;
end;
procedure TAA.OnTimer();
var
t : DWORD;
begin
DebugStr('TAA.OnTimer');
t := Random(1000);
PostMessage(g_AA.FTestHd, WM_USER + 22, t, 0);
end;
procedure AAInit();
begin
DebugStr('AAInit');
g_AA := TAA.Create();
end;
end.
RSS Feed (xml)
