Работа с железом
Существует свойство "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; |
- Подробности
- Родительская категория: Мышка/клавиатура
- Категория: Мышка
Страница 12 из 17