DELPHI / Event Ornek


Kod:
procedure TForm1.FormCreate(Sender: TObject);
begin
if GetSystemMetrics(SM_MOUSEPRESENT) <> 0 then
ShowMessage('Mouse present')
else
ShowMessage('Mouse NOT present');
end;

procedure TForm1.Button1Click(Sender: TObject);
const MyCursor = 1;
begin
Screen.Cursors[MyCursor] :=
LoadCursorFromFile
('c:\windows\cursors\globe.ani');
Form1.Cursor := MyCursor;
end

procedure SetMousePos(x, y: longint);
var pt: TPoint;
begin
pt := ClientToScreen(point(x, y));
SetCursorPos(pt.x, pt.y);
end;

//simulating mouse move
procedure TForm1.Button1Click(Sender: TObject);
var pt : TPoint;
begin
Application.ProcessMessages;
Screen.Cursor := crHourglass;
GetCursorPos(pt);
SetCursorPos(pt.x + 1, pt.y + 1);
Application.ProcessMessages;
SetCursorPos(pt.x - 1, pt.y - 1);
Screen.Cursor := crArrow
end;

//simulating mouse click
//we need 2 buttons on the form
procedure TForm1.Button1Click(Sender: TObject);
var
Pt : TPoint;
begin
Application.ProcessMessages;
{Get the point in the center of Button 2}
Pt.x := Button2.Left + (Button2.Width div 2);
Pt.y := Button2.Top + (Button2.Height div 2);
{Convert Pt to screen coordinates and Mickeys}
Pt := ClientToScreen(Pt);
Pt.x := Round(Pt.x * (65535 / Screen.Width));
Pt.y := Round(Pt.y * (65535 / Screen.Height));
{Simulate the mouse move}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or
MOUSEEVENTF_MOVE,
Pt.x, Pt.y, 0, 0);
{Simulate the left mouse button down}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or
MOUSEEVENTF_LEFTDOWN,
Pt.x, Pt.y, 0, 0);;
{Simulate the left mouse button up}
Mouse_Event(MOUSEEVENTF_ABSOLUTE or
MOUSEEVENTF_LEFTUP,
Pt.x, Pt.y, 0, 0);;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage('Button 2 clicked')
end;

//restrict the mouse mouvement to form and release
//this restriction after a click on the form
procedure TForm1.FormCreate(Sender: TObject);
var r : TRect;
begin
//it would be good idea to move the
//mouse inside the form before restriction
r := BoundsRect;
ClipCursor(@R);
end;

procedure TForm1.FormClick(Sender: TObject);
begin
//always be sure to release the cursor
ClipCursor(nil);
end;

//scratch for a new component
TMyComp = class(TComponent)
...
procedure CMMouseEnter(var msg: TMessage);
message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage);
message CM_MOUSELEAVE;
...
implementation

procedure TMyComp.CMMouseEnter(var msg: TMessage);
begin
//do what ever you want to do
//when mouse enters
end;

procedure TMyComp.CMMouseLeave(var msg: TMessage);
begin
//do what ever you want to do
//when mouse leaves
end;
...