Существует свойство "WheelPresent" глобального обьекта "mouse".

 Для этого можно воспользоваться API функцией GetCapture().

 Пример:

Для этого необходимо перехватить событие OnMouseDown, запомнив координаты x и y и захватить мышку. После этого можно будет отслеживать движение мышки при помощи события OnMouseMove, перемещая контрол пока срабатывает событие OnMouseUp. Затем надо поместить контрол на своё окончательное место и снять захват мышки.

Следующий пример показывает как мышкой двигать компонент TButton по форме.

 

Code:

function MousePresent : Boolean;

begin

if GetSystemMetrics(SM_MOUSEPRESENT) <> 0 then

Result := true

else

Result := false;

end;

 

Вы должны обрабатывать сообщения CM_MOUSEENTER и CM_MOUSELEAVE примерно таким образом:

 

Code:

unit Unit1;

 

interface

 

uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  Dialogs, AppEvnts, StdCtrls;

 

type

  TForm1 = class(TForm)

    ApplicationEvents1: TApplicationEvents;

    Button_StartJour: TButton;

    Button_StopJour: TButton;

    ListBox1: TListBox;

    procedure ApplicationEvents1Message(var Msg: tagMSG;

      var Handled: Boolean);

    procedure Button_StartJourClick(Sender: TObject);

    procedure Button_StopJourClick(Sender: TObject);

    procedure FormClose(Sender: TObject; var Action: TCloseAction);

  private

    { Private declarations }

    FHookStarted : Boolean;

  public

    { Public declarations }

  end;

 

var

  Form1: TForm1;

 

 

implementation

 

{$R *.dfm}

 

var

  JHook: THandle;

 

// The JournalRecordProc hook procedure is an application-defined or library-defined callback

// function used with the SetWindowsHookEx function.

// The function records messages the system removes from the system message queue.

// A JournalRecordProc hook procedure does not need to live in a dynamic-link library.

// A JournalRecordProc hook procedure can live in the application itself.

 

// WH_JOURNALPLAYBACK Hook Function

 

//Syntax

 

// JournalPlaybackProc(

// nCode: Integer;  {a hook code}

// wParam: WPARAM;  {this parameter is not used}

// lParam: LPARAM  {a pointer to a TEventMsg structure}

// ): LRESULT;  {returns a wait time in clock ticks}

 

 

function JournalProc(Code, wParam: Integer; var EventStrut: TEventMsg): Integer; stdcall;

var

  Char1: PChar;

  s: string;

begin

  {this is the JournalRecordProc}

  Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));

  {the CallNextHookEX is not really needed for journal hook since it it not

really in a hook chain, but it's standard for a Hook}

  if Code < 0 then Exit;

 

  {you should cancel operation if you get HC_SYSMODALON}

  if Code = HC_SYSMODALON then Exit;

  if Code = HC_ACTION then

  begin

    {

   The lParam parameter contains a pointer to a TEventMsg

   structure containing information on

   the message removed from the system message queue.

   }

    s := '';

 

    if EventStrut.message = WM_LBUTTONUP then

      s := 'Left Mouse UP at X pos ' +

        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

 

    if EventStrut.message = WM_LBUTTONDOWN then

      s := 'Left Mouse Down at X pos ' +

        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

 

    if EventStrut.message = WM_RBUTTONDOWN then

      s := 'Right Mouse Down at X pos ' +

        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

 

    if (EventStrut.message = WM_RBUTTONUP) then

      s := 'Right Mouse Up at X pos ' +

        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

 

    if (EventStrut.message = WM_MOUSEWHEEL) then

      s := 'Mouse Wheel at X pos ' +

        IntToStr(EventStrut.paramL) + ' and Y pos ' + IntToStr(EventStrut.paramH);

 

    if (EventStrut.message = WM_MOUSEMOVE) then

      s := 'Mouse Position at X:' +

        IntToStr(EventStrut.paramL) + ' and Y: ' + IntToStr(EventStrut.paramH);

 

    if s <> '' then

       Form1.ListBox1.ItemIndex :=  Form1.ListBox1.Items.Add(s);

  end;

end;

 

procedure TForm1.Button_StartJourClick(Sender: TObject);

begin

  if FHookStarted then

  begin

    ShowMessage('Mouse is already being Journaled, can not restart');

    Exit;

  end;

  JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, hInstance, 0);

  {SetWindowsHookEx starts the Hook}

  if JHook > 0 then

  begin

    FHookStarted := True;

  end

  else

    ShowMessage('No Journal Hook availible');

end;

 

procedure TForm1.Button_StopJourClick(Sender: TObject);

begin

  FHookStarted := False;

  UnhookWindowsHookEx(JHook);

  JHook := 0;

end;

 

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

  var Handled: Boolean);

begin

  {the journal hook is automaticly camceled if the Task manager

(Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it

when the WM_CANCELJOURNAL is sent to the parent window, Application}

  Handled := False;

  if (Msg.message = WM_CANCELJOURNAL) and FHookStarted then

    JHook := SetWindowsHookEx(WH_JOURNALRECORD, @JournalProc, 0, 0);

end;

 

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  {make sure you unhook it if the app closes}

  if FHookStarted then

    UnhookWindowsHookEx(JHook);

end;

 

end.

 

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:

procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;

var Handled: Boolean);

begin

Handled := (msg.wParam = vk_lButton) or

            (msg.wParam = vk_rButton) or

            (msg.wParam = vk_mButton);

end;

 

 

В GetCursor() API есть ограничение в том, что этого нет по умолчанию, возвращение дескриптора текущего  курсор, когда курсор принадлежит другому потоку. В данной статье демонстрируется способ извлечения

 текущее курсора независимо от того, какой поток принадлежит.  Например, если вы хотите включить изображение курсора в захват экрана.

Следующий Unit -это визуальный компонент, унаследованный от TImage, который имеет  2 дополнительных события OnMouseEnter и OnMouseLeave.

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;