Programalama > DELPHI

Etiketler: event, ornek

Ort. 0
Puan ver:
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;
...



Yorumlar                 Yorum Yaz
Bu hazır kod'a ilk yorumu siz yapın!
KATEGORİLER
ASP - 240
ASP.NET - 24
C# - 75
C++ - 174
CGI - 8
DELPHI - 247
FLASH - 49
HTML - 536
PASCAL - 246
PERL - 11
PHP - 160
WML - 9
XML - 2
Copyright © 2002 - 2024 Hazır Kod - Tüm Hakları Saklıdır.
Siteden yararlanırken gizlilik ilkelerini okumanızı tavsiye ederiz.
hazirkod.com bir İSOBİL projesidir.