Мышка

Code:

type

TForm1 = class(TForm)

   Label1: TLabel;

   Label2: TLabel;

   Timer1: TTimer;

   procedure Timer1Timer(Sender: TObject);

   procedure FormCreate(Sender: TObject);

private

   procedure ShowHwndAndClassName(CrPos: TPoint);

public

end;

var

Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Timer1Timer(Sender: TObject);

var

rPos: TPoint;

begin

if Boolean(GetCursorPos(rPos)) then ShowHwndAndClassName(rPos);

end;

procedure TForm1.ShowHwndAndClassName(CrPos: TPoint);

var

hWnd: THandle;

aName: array [0..255] of Char;

begin

hWnd := WindowFromPoint(CrPos);

Label1.Caption := 'Handle :  ' + IntToStr(hWnd);

if Boolean(GetClassName(hWnd, aName, 256)) then

   Label2.Caption := 'ClassName :  ' + string(aName)

else

   Label2.Caption := 'ClassName :  not found';

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

Form1.FormStyle := fsStayOnTop;

Timer1.Interval := 50;

end;

Code:

{

Check if a Point(X,Y) (e.g a Cursor) is on a Linie (x1,y1) ; (x2,y2)

d = line width (min. 1)

}

function CursorOnLinie(X, Y, x1, y1, x2, y2, d: Integer): Boolean;

var

  sine, cosinus: Double;

  dx, dy, len: Integer;

begin

  if d = 0 then d := 1;

  asm

    fild(y2)

    fisub(y1) // Y-Difference

   fild(x2)

    fisub(x1) // X-Difference

   fpatan    // Angle of the line in st(0)

   fsincos   // Cosinus in st(0), Sinus in st(1)

   fstp cosinus

    fstp sine

  end;

  dx  := Round(cosinus * (x - x1) + sine * (y - y1));

  dy  := Round(cosinus * (y - y1) - sine * (x - x1));

  len := Round(cosinus * (x2 - x1) + sine * (y2 - y1)); // length of line

if (dy > -d) and (dy < d) and (dx > -d) and (dx < len + d) then Result := True

  else

     Result := False;

end;

procedure TForm1.FormPaint(Sender: TObject);

begin

  Canvas.Pen.Width := 1;

  Canvas.MoveTo(0, 0);

  Canvas.LineTo(Width, Weight);

end;

procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,

  Y: Integer);

var

  p: TPoint;

begin

  GetCursorPos(p);

  p := ScreenToClient(p);

  if CursorOnLinie(p.x, p.y, 0, 0, Width, Height, 1) then

    Caption := 'Mouse on line.'

  else

    Caption := 'Mouse not on line.'

end;

Code:

library Hookdemo;

uses

 Beeper in '\DELDEMOS\HOOKDEMO\BEEPER.PAS';

exports

SetHook index 1,

UnHookHook index 2,

HookProc index 3;

begin

 HookedAlready:=False;

end.

Code:

//Not supported on Windows 95

//result = -1: scroll whole page

function GetNumScrollLines: Integer;

begin

  SystemParametersInfo(SPI_GETWHEELSCROLLLINES, 0, @Result, 0);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  ShowMessage(IntToStr(GetNumScrollLines));

end;

Code:

Function SetMouseSpeed ( NewSpeed : Integer ) : Boolean;

{©Drkb v.3}

begin

Result := SystemParametersInfo(SPI_SETMOUSESPEED, 1, Pointer(NewSpeed), SPIF_SENDCHANGE );

End;

Function GetMouseSpeed : Integer;

Var

Int : Integer;

begin

SystemParametersInfo(SPI_GETMOUSESPEED, 0, @Int, SPIF_SENDCHANGE );

Result := Int;

End;

Code:

function GetCaptionAtPoint(CrPos: TPoint): string;

var

  textlength: Integer;

  Text: PChar;

  Handle: HWND;

begin

  Result := 'Empty';

  Handle := WindowFromPoint(CrPos);

  if Handle = 0 then Exit;

  textlength := SendMessage(Handle, WM_GETTEXTLENGTH, 0, 0);

  if textlength <> 0 then

  begin

    getmem(Text, textlength + 1);

    SendMessage(Handle, WM_GETTEXT, textlength + 1, Integer(Text));

    Result := Text;

    freemem(Text);

  end;

end;