cette exemple sera incompréhensible ici,
CRÉER un nouveau projet , "voir" unit projet1
et supprimer tout puis copiez collez ...(pas de fiche unit1)
je ne sais cependant comment réalisé un projet standard disons ,avec une fiche ordinaire, mais bon cette exemple fonctionne ...j'ai ajouter Mouse Mouve et Key down a cet exemple que j'ai trouvé mais y'en a tellement de message qui s'agit de voir !!!
pour l'interception je comprend mais pour la création de la classe qui régit les messages avec windows faudra demander de l'aide ailleurs car c'est dur pur API Windows !!!
program Project1;
uses
Windows, Messages, SysUtils;
{$R *.RES}
function WindowProc(TheWindow: HWnd; TheMessage, WParam,
LParam: Longint): Longint; stdcall;
begin
case TheMessage of
Messages.WM_NCMOUSEMOVE:begin
SetWindowText(TheWindow, PChar('Message Time: '+IntToStr(
GetMessageTime)+' Mouse Move sur caption: '+
IntToStr(LoWord(GetMessagePos))+', '+
IntToStr(HiWord(GetMessagePos))));
{indicate that the message was handled}
Result := 1;
end;
Messages.WM_MOUSEMOVE:begin
SetWindowText(TheWindow, PChar('Message Time: '+IntToStr(
GetMessageTime)+' MOUSE MOVE : '+
IntToStr(LoWord(GetMessagePos))+', '+
IntToStr(HiWord(GetMessagePos))));
{indicate that the message was handled}
Result := 1;
end;
Messages.WM_KEYDOWN:begin
SetWindowText(TheWindow, PChar('Message Time: '+IntToStr(
GetMessageTime)+' KeyDown : '+
Char(WParam)+', '+
IntToStr(HiWord(LParam))));
{indicate that the message was handled}
Result := 1;
end;
{etc... à vous de voir !!!}
2{WM_DESTROY}: begin
PostQuitMessage(0);
Exit;
end;
WM_LBUTTONDOWN: begin
SetWindowText(TheWindow, PChar('Message Time: '+IntToStr(
GetMessageTime)+' Mouse Coordinates: '+
IntToStr(LoWord(GetMessagePos))+', '+
IntToStr(HiWord(GetMessagePos))));
{indicate that the message was handled}
Result := 1;
end;
else
{call the default window procedure for all unhandled messages}
Result := DefWindowProc(TheWindow, TheMessage, WParam, LParam);
end;
end;
function RegisterClass: Boolean;
var
WindowClass: TWndClass;
begin
WindowClass.Style := CS_HREDRAW or CS_VREDRAW;
WindowClass.lpfnWndProc := @WindowProc;
WindowClass.cbClsExtra := 0;
WindowClass.cbWndExtra := 0;
WindowClass.hInstance := hInstance;
WindowClass.hIcon := LoadIcon(0, IDI_APPLICATION);
WindowClass.hCursor := LoadCursor(0, IDC_ARROW);
WindowClass.hbrBackground := COLOR_WINDOW;
WindowClass.lpszMenuName := nil;
WindowClass.lpszClassName := 'TestClass';
Result := Windows.RegisterClass(WindowClass) <> 0;
end;
var
TheMessage: TMsg;
OurWindow: HWND;
begin
if not RegisterClass then Exit;
OurWindow := CreateWindowEx(0,'TestClass','GetMessage Example',WS_OVERLAPPEDWINDOW or WS_VISIBLE,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,CW_USEDEFAULT,0,0,hInstance,nil);
if OurWindow=0 then Exit;
while GetMessage(TheMessage,0,0,0) do
begin
TranslateMessage(TheMessage);
DispatchMessage(TheMessage);
end;
end.
yve
|