babaev-an/lasarus_compotents
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Стартовый пул

Browse Source
This commit is contained in:
Александр Бабаев
2024-04-02 08:46:59 +03:00
parent fd57fffd3a
commit 3bb34d000b
5591 changed files with 3291734 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

80
bgracontrols/mouseandkeyinput/carbonkeyinput.pas Normal file
View File

@@ -0,0 +1,80 @@
{ CarbonKeyInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit CarbonKeyInput;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms,
MacOSAll, CarbonProc,
KeyInputIntf;
type
{ TCarbonKeyInput }
TCarbonKeyInput = class(TKeyInput)
protected
procedure DoDown(Key: Word); override;
procedure DoUp(Key: Word); override;
end;
function InitializeKeyInput: TKeyInput;
implementation
uses
LCLType;
function InitializeKeyInput: TKeyInput;
begin
Result := TCarbonKeyInput.Create;
end;
procedure SendKeyInput(Key: Word; Down: Boolean);
var
Char: Word;
begin
Char := 0;
if Key in [VK_A .. VK_Z] then
begin
Char := Ord('A') + Key - VK_A;
Key := 0;
end;
if Key in [VK_0 .. VK_9] then
begin
Key := VK_NUMPAD0 + Key - VK_0;
end;
CGPostKeyboardEvent(Char, VirtualKeyCodeToMac(Key), Integer(Down));
end;
{ TCarbonKeyInput }
procedure TCarbonKeyInput.DoDown(Key: Word);
begin
SendKeyInput(Key, True);
end;
procedure TCarbonKeyInput.DoUp(Key: Word);
begin
SendKeyInput(Key, False);
end;
end.

72
bgracontrols/mouseandkeyinput/carbonmouseinput.pas Normal file
View File

@@ -0,0 +1,72 @@
{ CarbonMouseInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit CarbonMouseInput;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms,
MacOSAll, CarbonProc,
MouseInputIntf;
type
{ TCarbonMouseInput }
TCarbonMouseInput = class(TMouseInput)
protected
procedure DoDown(Button: TMouseButton); override;
procedure DoMove(ScreenX, ScreenY: Integer); override;
procedure DoUp(Button: TMouseButton); override;
end;
function InitializeMouseInput: TMouseInput;
implementation
function InitializeMouseInput: TMouseInput;
begin
Result := TCarbonMouseInput.Create;
end;
const
MouseButtonToCarbonButton: array [TMouseButton] of Integer =
(kCGMouseButtonLeft, kCGMouseButtonRight, kCGMouseButtonCenter,kCGMouseButtonLeft,kCGMouseButtonLeft);
{ TCarbonMouseInput }
procedure TCarbonMouseInput.DoDown(Button: TMouseButton);
begin
CGPostMouseEvent(PointToHIPoint(Mouse.CursorPos), 0, 1, 1, MouseButtonToCarbonButton[Button]);
end;
procedure TCarbonMouseInput.DoMove(ScreenX, ScreenY: Integer);
begin
CGPostMouseEvent(GetHIPoint(ScreenX, ScreenY), 1, 1, 0, 0);
end;
procedure TCarbonMouseInput.DoUp(Button: TMouseButton);
begin
CGPostMouseEvent(PointToHIPoint(Mouse.CursorPos), 0, 1, 0, MouseButtonToCarbonButton[Button]);
end;
end.

94
bgracontrols/mouseandkeyinput/keyinputintf.pas Normal file
View File

@@ -0,0 +1,94 @@
{ KeyInputIntf
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit KeyInputIntf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms;
type
{ TKeyInput }
TKeyInput = class
protected
procedure DoDown(Key: Word); dynamic; abstract;
procedure DoUp(Key: Word); dynamic; abstract;
public
procedure Down(Key: Word);
procedure Up(Key: Word);
procedure Press(Key: Word);
procedure Press(StringValue : String);
procedure Apply(Shift: TShiftState);
procedure Unapply(Shift: TShiftState);
end;
implementation
uses LCLType;
{ TKeyInput }
procedure TKeyInput.Down(Key: Word);
begin DoDown(Key);
Application.ProcessMessages;
end;
procedure TKeyInput.Up(Key: Word);
begin
DoUp(Key);
Application.ProcessMessages;
end;
procedure TKeyInput.Press(Key: Word);
begin
Down(Key);
Up(Key);
end;
procedure TKeyInput.Press(StringValue: String);
var
i : Integer;
begin
i :=1;
while (i <= Length(StringValue)) do
begin
Press(Ord(StringValue[i]));
Inc(i);
end;
end;
procedure TKeyInput.Apply(Shift: TShiftState);
begin
if ssCtrl in Shift then Down(VK_CONTROL);
if ssAlt in Shift then Down(VK_MENU);
if ssShift in Shift then Down(VK_SHIFT);
end;
procedure TKeyInput.Unapply(Shift: TShiftState);
begin
if ssShift in Shift then Up(VK_SHIFT);
if ssCtrl in Shift then Up(VK_CONTROL);
if ssAlt in Shift then Up(VK_MENU);
end;
end.

88
bgracontrols/mouseandkeyinput/lazmouseandkeyinput.lpk Normal file
View File

@@ -0,0 +1,88 @@
<?xml version="1.0"?>
<CONFIG>
<Package Version="3">
<PathDelim Value="\"/>
<Name Value="LazMouseAndKeyInput"/>
<Author Value="Tom Gregorovic"/>
<CompilerOptions>
<Version Value="5"/>
<PathDelim Value="\"/>
<SearchPaths>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<CodeGeneration>
<Generate Value="Faster"/>
</CodeGeneration>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Description Value="Tool for cross-platform manipulation with mouse and key input.
"/>
<License Value="GPL
"/>
<Version Minor="1"/>
<Files Count="9">
<Item1>
<Filename Value="carbonkeyinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="CarbonKeyInput"/>
</Item1>
<Item2>
<Filename Value="carbonmouseinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="CarbonMouseInput"/>
</Item2>
<Item3>
<Filename Value="keyinputintf.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="KeyInputIntf"/>
</Item3>
<Item4>
<Filename Value="mouseandkeyinput.pas"/>
<UnitName Value="MouseAndKeyInput"/>
</Item4>
<Item5>
<Filename Value="mouseinputintf.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="MouseInputIntf"/>
</Item5>
<Item6>
<Filename Value="winkeyinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="WinKeyInput"/>
</Item6>
<Item7>
<Filename Value="winmouseinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="WinMouseInput"/>
</Item7>
<Item8>
<Filename Value="xkeyinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="XKeyInput"/>
</Item8>
<Item9>
<Filename Value="xmouseinput.pas"/>
<AddToUsesPkgSection Value="False"/>
<UnitName Value="XMouseInput"/>
</Item9>
</Files>
<RequiredPkgs Count="2">
<Item1>
<PackageName Value="LCL"/>
</Item1>
<Item2>
<PackageName Value="FCL"/>
<MinVersion Major="1" Valid="True"/>
</Item2>
</RequiredPkgs>
<UsageOptions>
<UnitPath Value="$(PkgOutDir)\"/>
</UsageOptions>
<PublishOptions>
<Version Value="2"/>
<IgnoreBinaries Value="False"/>
</PublishOptions>
</Package>
</CONFIG>

15
bgracontrols/mouseandkeyinput/lazmouseandkeyinput.pas Normal file
View File

@@ -0,0 +1,15 @@
{ This file was automatically created by Lazarus. Do not edit!
This source is only used to compile and install the package.
}
unit LazMouseAndKeyInput;
{$warn 5023 off : no warning about unused units}
interface
uses
MouseAndKeyInput;
implementation
end.

61
bgracontrols/mouseandkeyinput/mouseandkeyinput.pas Normal file
View File

@@ -0,0 +1,61 @@
{ MouseAndKeyInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit MouseAndKeyInput;
interface
uses
MouseInputIntf,
KeyInputIntf,
{$IFDEF WINDOWS}
WinMouseInput,
WinKeyInput,
{$ENDIF}
{$IFDEF UNIX}
{$IFDEF LCLcarbon}
CarbonMouseInput,
CarbonKeyInput,
{$ELSE}
XMouseInput,
XKeyInput,
{$ENDIF}
{$ENDIF}
Classes, SysUtils;
var
MouseInput: TMouseInput;
KeyInput: TKeyInput;
implementation
initialization
// Create platform specific object for mouse input
MouseInput := InitializeMouseInput;
// Create platform specific object for key input
KeyInput := InitializeKeyInput;
finalization
FreeAndNil(MouseInput);
FreeAndNil(KeyInput);
end.

285
bgracontrols/mouseandkeyinput/mouseinputintf.pas Normal file
View File

@@ -0,0 +1,285 @@
{ MouseInputIntf
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit MouseInputIntf;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms;
type
{ TMouseInput }
TMouseInput = class
protected
procedure DoDown(Button: TMouseButton); dynamic; abstract;
procedure DoMove(ScreenX, ScreenY: Integer); dynamic; abstract;
procedure DoUp(Button: TMouseButton); dynamic; abstract;
procedure DoScrollUp; dynamic; abstract;
procedure DoScrollDown; dynamic; abstract;
public
procedure Down(Button: TMouseButton; Shift: TShiftState);
procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure ScrollUp(Shift: TShiftState);
procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure ScrollDown(Shift: TShiftState);
procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure Up(Button: TMouseButton; Shift: TShiftState);
procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure Click(Button: TMouseButton; Shift: TShiftState);
procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
procedure DblClick(Button: TMouseButton; Shift: TShiftState);
procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer);
procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer);
end;
implementation
uses
Math, MouseAndKeyInput;
{ TMouseInput }
procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState);
begin
KeyInput.Apply(Shift);
try
DoDown(Button);
finally
KeyInput.Unapply(Shift);
end;
Application.ProcessMessages;
end;
procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
Control: TControl; X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
Down(Button, Shift, P.X, P.Y);
end;
procedure TMouseInput.Down(Button: TMouseButton; Shift: TShiftState;
ScreenX, ScreenY: Integer);
begin
KeyInput.Apply(Shift);
try
DoMove(ScreenX, ScreenY);
DoDown(Button);
finally
KeyInput.Unapply(Shift);
end;
end;
procedure TMouseInput.Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
Move(Shift, P.X, P.Y, Duration);
end;
procedure TMouseInput.MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0);
var
P: TPoint;
begin
P := Mouse.CursorPos;
Move(Shift, P.X + DX, P.Y + DY, Duration);
end;
procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer);
const
Interval = 20; //ms
var
TimeStep: Integer;
X, Y: Integer;
Start: TPoint;
S: LongWord;
begin
Start := Mouse.CursorPos;
while Duration > 0 do
begin
TimeStep := Min(Interval, Duration);
S := {%H-}GetTickCount;
while {%H-}GetTickCount - S < TimeStep do Application.ProcessMessages;
X := Start.X + ((ScreenX - Start.X) * TimeStep) div Duration;
Y := Start.Y + ((ScreenY - Start.Y) * TimeStep) div Duration;
Move(Shift, X, Y);
Duration := Duration - TimeStep;
Start := Point(X, Y);
end;
Move(Shift, ScreenX, ScreenY);
end;
procedure TMouseInput.Move(Shift: TShiftState; ScreenX, ScreenY: Integer);
begin
KeyInput.Apply(Shift);
try
DoMove(ScreenX, ScreenY);
finally
KeyInput.Unapply(Shift);
end;
Application.ProcessMessages;
end;
procedure TMouseInput.ScrollUp(Shift: TShiftState);
begin
KeyInput.Apply(Shift);
try
DoScrollUp;
finally
KeyInput.Unapply(Shift);
end;
Application.ProcessMessages;
end;
procedure TMouseInput.ScrollUp(Shift: TShiftState; Control: TControl;
X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
ScrollUp(Shift, P.X, P.Y);
end;
procedure TMouseInput.ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer);
begin
Move(Shift, ScreenX, ScreenY);
ScrollUp(Shift);
end;
procedure TMouseInput.ScrollDown(Shift: TShiftState);
begin
KeyInput.Apply(Shift);
try
DoScrollDown;
finally
KeyInput.Unapply(Shift);
end;
Application.ProcessMessages;
end;
procedure TMouseInput.ScrollDown(Shift: TShiftState; Control: TControl;
X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
ScrollDown(Shift, P.X, P.Y);
end;
procedure TMouseInput.ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer);
begin
Move(Shift, ScreenX, ScreenY);
ScrollDown(Shift);
end;
procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState);
begin
KeyInput.Apply(Shift);
try
DoUp(Button);
finally
KeyInput.Unapply(Shift);
end;
Application.ProcessMessages;
end;
procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
Control: TControl; X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
Up(Button, Shift, P.X, P.Y);
end;
procedure TMouseInput.Up(Button: TMouseButton; Shift: TShiftState;
ScreenX, ScreenY: Integer);
begin
Move(Shift, ScreenX, ScreenY);
Up(Button, Shift);
end;
procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState);
begin
Down(Button, Shift);
Up(Button, Shift);
end;
procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
Control: TControl; X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
Click(Button, Shift, P.X, P.Y);
end;
procedure TMouseInput.Click(Button: TMouseButton; Shift: TShiftState;
ScreenX, ScreenY: Integer);
begin
Move(Shift, ScreenX, ScreenY);
Click(Button, Shift);
end;
procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState);
begin
Click(Button, Shift);
Click(Button, Shift);
end;
procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
Control: TControl; X, Y: Integer);
var
P: TPoint;
begin
P := Control.ClientToScreen(Point(X, Y));
DblClick(Button, Shift, P.X, P.Y);
end;
procedure TMouseInput.DblClick(Button: TMouseButton; Shift: TShiftState;
ScreenX, ScreenY: Integer);
begin
Move(Shift, ScreenX, ScreenY);
DblClick(Button, Shift);
end;
end.

21
bgracontrols/mouseandkeyinput/readme.txt Normal file
View File

@@ -0,0 +1,21 @@
MouseAndKeyInput package is a tool for cross-platform manipulation with mouse and key input. You can move mouse cursor to specified location, send clicks and do key presses. It is suitable for GUI testing or program control demonstration.
Author
Tom Gregorovic
License
GPL
Change Log
* Version 0.1
Restrictions
* it is not recommended calling mouse and key input directly from events like OnClick, use Application.QueueAsyncCall instead
* do not forget to set back mouse button and key state after Down method with Up method
Carbon
* pressing alpha chars is not supported
Gtk1/2
* needs Xtst library
* ALT key pressing is not supported

73
bgracontrols/mouseandkeyinput/winkeyinput.pas Normal file
View File

@@ -0,0 +1,73 @@
{ WinKeyInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit WinKeyInput;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms,
Windows, JwaWinUser,
KeyInputIntf;
type
{ TWinKeyInput }
TWinKeyInput = class(TKeyInput)
protected
procedure DoDown(Key: Word); override;
procedure DoUp(Key: Word); override;
end;
function InitializeKeyInput: TKeyInput;
implementation
function InitializeKeyInput: TKeyInput;
begin
Result := TWinKeyInput.Create;
end;
procedure SendKeyInput(Flag: DWORD; Key: Word);
var
Input: TInput;
begin
FillChar({%H-}Input, SizeOf(Input), 0);
Input.type_ := INPUT_KEYBOARD;
Input.ki.dwFlags := Flag;
Input.ki.wVk := Key;
SendInput(1, @Input, SizeOf(Input));
end;
{ TWinKeyInput }
procedure TWinKeyInput.DoDown(Key: Word);
begin
SendKeyInput(0, Key);
end;
procedure TWinKeyInput.DoUp(Key: Word);
begin
SendKeyInput(KEYEVENTF_KEYUP, Key);
end;
end.

127
bgracontrols/mouseandkeyinput/winmouseinput.pas Normal file
View File

@@ -0,0 +1,127 @@
{ WinMouseInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit WinMouseInput;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Controls, Forms,
Windows, JwaWinUser,
MouseInputIntf;
type
{ TWinMouseInput }
TWinMouseInput = class(TMouseInput)
protected
procedure DoDown(Button: TMouseButton); override;
procedure DoMove(ScreenX, ScreenY: Integer); override;
procedure DoUp(Button: TMouseButton); override;
procedure DoScrollUp; override;
procedure DoScrollDown; override;
end;
function InitializeMouseInput: TMouseInput;
implementation
function InitializeMouseInput: TMouseInput;
begin
Result := TWinMouseInput.Create;
end;
procedure SendMouseInput(Flag: DWORD; MouseData: DWORD = 0);
var
Input: TInput;
begin
{$IFDEF VER2_6}
FillChar(Input, SizeOf(Input), 0);
{$ELSE}
Input := Default(TInput);
{$ENDIF}
Input.mi.mouseData := MouseData;
Input.type_ := INPUT_MOUSE;
Input.mi.dwFlags := Flag;
SendInput(1, @Input, SizeOf(Input));
end;
procedure SendMouseInput(Flag: DWORD; X, Y: Integer);
var
Input: TInput;
begin
{$IFDEF VER2_6}
FillChar(Input, SizeOf(Input), 0);
{$ELSE}
Input := Default(TInput);
{$ENDIF}
Input.type_ := INPUT_MOUSE;
Input.mi.dx := MulDiv(X, 65535, Screen.Width - 1); // screen horizontal coordinates: 0 - 65535
Input.mi.dy := MulDiv(Y, 65535, Screen.Height - 1); // screen vertical coordinates: 0 - 65535
Input.mi.dwFlags := Flag or MOUSEEVENTF_ABSOLUTE;
SendInput(1, @Input, SizeOf(Input));
end;
{ TWinMouseInput }
procedure TWinMouseInput.DoDown(Button: TMouseButton);
var
Flag: DWORD;
begin
case Button of
mbRight: Flag := MOUSEEVENTF_RIGHTDOWN;
mbMiddle: Flag := MOUSEEVENTF_MIDDLEDOWN;
else
Flag := MOUSEEVENTF_LEFTDOWN;
end;
SendMouseInput(Flag);
end;
procedure TWinMouseInput.DoMove(ScreenX, ScreenY: Integer);
begin
SendMouseInput(MOUSEEVENTF_MOVE, ScreenX, ScreenY);
end;
procedure TWinMouseInput.DoUp(Button: TMouseButton);
var
Flag: DWORD;
begin
case Button of
mbRight: Flag := MOUSEEVENTF_RIGHTUP;
mbMiddle: Flag := MOUSEEVENTF_MIDDLEUP;
else
Flag := MOUSEEVENTF_LEFTUP;
end;
SendMouseInput(Flag);
end;
procedure TWinMouseInput.DoScrollUp;
begin
SendMouseInput(MOUSEEVENTF_WHEEL, WHEEL_DELTA);
end;
procedure TWinMouseInput.DoScrollDown;
begin
SendMouseInput(MOUSEEVENTF_WHEEL, DWORD(-WHEEL_DELTA));
end;
end.

198
bgracontrols/mouseandkeyinput/xkeyinput.pas Normal file
View File

@@ -0,0 +1,198 @@
{ XKeyInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit XKeyInput;
{$mode objfpc}{$H+}
{$linklib Xtst}
interface
uses
Classes, SysUtils, Controls, Forms,
X, XLib, KeySym,
KeyInputIntf;
type
{ TXKeyInput }
TXKeyInput = class(TKeyInput)
protected
procedure DoDown(Key: Word); override;
procedure DoUp(Key: Word); override;
end;
function InitializeKeyInput: TKeyInput;
function XTestFakeKeyEvent(dpy: PDisplay; keycode: dword; is_press: Boolean32;
delay: dword): longint; cdecl; external;
implementation
uses LCLType;
function InitializeKeyInput: TKeyInput;
begin
Result := TXKeyInput.Create;
end;
function VirtualKeyToXKeySym(Key: Word): TKeySym;
begin
case Key of
VK_BACK: Result := XK_BackSpace;
VK_TAB: Result := XK_Tab;
VK_CLEAR: Result := XK_Clear;
VK_RETURN: Result := XK_Return;
VK_SHIFT: Result := XK_Shift_L;
VK_CONTROL: Result := XK_Control_L;
VK_MENU: Result := XK_VoidSymbol; // alt key crashes app, XK_Alt_R;
VK_CAPITAL: Result := XK_Caps_Lock;
VK_ESCAPE: Result := XK_Escape;
VK_SPACE: Result := XK_space;
VK_PRIOR: Result := XK_Prior;
VK_NEXT: Result := XK_Next;
VK_END: Result := XK_End;
VK_HOME: Result := XK_Home;
VK_LEFT: Result := XK_Left;
VK_UP: Result := XK_Up;
VK_RIGHT: Result := XK_Right;
VK_DOWN: Result := XK_Down;
VK_SELECT: Result := XK_Select;
VK_PRINT: Result := XK_Print;
VK_EXECUTE: Result := XK_Execute;
VK_INSERT: Result := XK_Insert;
VK_DELETE: Result := XK_Delete;
VK_HELP: Result := XK_Help;
VK_0: Result := XK_0;
VK_1: Result := XK_1;
VK_2: Result := XK_2;
VK_3: Result := XK_3;
VK_4: Result := XK_4;
VK_5: Result := XK_5;
VK_6: Result := XK_6;
VK_7: Result := XK_7;
VK_8: Result := XK_8;
VK_9: Result := XK_9;
VK_A: Result := XK_a;
VK_B: Result := XK_b;
VK_C: Result := XK_c;
VK_D: Result := XK_d;
VK_E: Result := XK_e;
VK_F: Result := XK_f;
VK_G: Result := XK_g;
VK_H: Result := XK_h;
VK_I: Result := XK_i;
VK_J: Result := XK_j;
VK_K: Result := XK_k;
VK_L: Result := XK_l;
VK_M: Result := XK_m;
VK_N: Result := XK_n;
VK_O: Result := XK_o;
VK_P: Result := XK_p;
VK_Q: Result := XK_q;
VK_R: Result := XK_r;
VK_S: Result := XK_s;
VK_T: Result := XK_t;
VK_U: Result := XK_u;
VK_V: Result := XK_v;
VK_W: Result := XK_w;
VK_X: Result := XK_x;
VK_Y: Result := XK_y;
VK_Z: Result := XK_z;
VK_NUMPAD0: Result := XK_KP_0;
VK_NUMPAD1: Result := XK_KP_1;
VK_NUMPAD2: Result := XK_KP_2;
VK_NUMPAD3: Result := XK_KP_3;
VK_NUMPAD4: Result := XK_KP_4;
VK_NUMPAD5: Result := XK_KP_5;
VK_NUMPAD6: Result := XK_KP_6;
VK_NUMPAD7: Result := XK_KP_7;
VK_NUMPAD8: Result := XK_KP_8;
VK_NUMPAD9: Result := XK_KP_9;
VK_MULTIPLY: Result := XK_KP_Multiply;
VK_ADD: Result := XK_KP_Add;
VK_SEPARATOR: Result := XK_KP_Separator;
VK_SUBTRACT: Result := XK_KP_Subtract;
VK_DECIMAL: Result := XK_KP_Decimal;
VK_DIVIDE: Result := XK_KP_Divide;
VK_F1: Result := XK_F1;
VK_F2: Result := XK_F2;
VK_F3: Result := XK_F3;
VK_F4: Result := XK_F4;
VK_F5: Result := XK_F5;
VK_F6: Result := XK_F6;
VK_F7: Result := XK_F7;
VK_F8: Result := XK_F8;
VK_F9: Result := XK_F9;
VK_F10: Result := XK_F10;
VK_F11: Result := XK_F11;
VK_F12: Result := XK_F12;
VK_F13: Result := XK_F13;
VK_F14: Result := XK_F14;
VK_F15: Result := XK_F15;
VK_F16: Result := XK_F16;
VK_F17: Result := XK_F17;
VK_F18: Result := XK_F18;
VK_F19: Result := XK_F19;
VK_F20: Result := XK_F20;
VK_F21: Result := XK_F21;
VK_F22: Result := XK_F22;
VK_F23: Result := XK_F23;
VK_F24: Result := XK_F24;
VK_NUMLOCK: Result := XK_Num_Lock;
VK_SCROLL: Result := XK_Scroll_Lock;
else
Result := XK_VoidSymbol;
end;
end;
{ TXKeyInput }
procedure TXKeyInput.DoDown(Key: Word);
var
Display: PDisplay;
KeySym: TKeySym;
begin
KeySym := VirtualKeyToXKeySym(Key);
if KeySym = XK_VoidSymbol then Exit;
Display := XOpenDisplay(nil);
XTestFakeKeyEvent(Display, XKeysymToKeycode(Display, KeySym), True, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
procedure TXKeyInput.DoUp(Key: Word);
var
Display: PDisplay;
KeySym: TKeySym;
begin
KeySym := VirtualKeyToXKeySym(Key);
if KeySym = XK_VoidSymbol then Exit;
Display := XOpenDisplay(nil);
XTestFakeKeyEvent(Display, XKeysymToKeycode(Display, KeySym), False, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
end.

114
bgracontrols/mouseandkeyinput/xmouseinput.pas Normal file
View File

@@ -0,0 +1,114 @@
{ XMouseInput
Copyright (C) 2008 Tom Gregorovic
This source is free software; you can redistribute it and/or modify it under the terms of the
GNU General Public License as published by the Free Software Foundation; either version 2 of the
License, or (at your option) any later version.
This code is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without
even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
A copy of the GNU General Public License is available on the World Wide Web at
<http://www.gnu.org/copyleft/gpl.html>. You can also obtain it by writing to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}
unit XMouseInput;
{$mode objfpc}{$H+}
{$linklib Xtst}
interface
uses
Classes, SysUtils, Controls, Forms,
XLib, MouseInputIntf;
type
{ TXMouseInput }
TXMouseInput = class(TMouseInput)
protected
procedure DoDown(Button: TMouseButton); override;
procedure DoMove(ScreenX, ScreenY: Integer); override;
procedure DoUp(Button: TMouseButton); override;
procedure DoScrollUp; override;
procedure DoScrollDown; override;
end;
function InitializeMouseInput: TMouseInput;
function XTestFakeButtonEvent(dpy: PDisplay; button: dword; is_press: Boolean;
delay: dword): longint; cdecl; external;
function XTestFakeMotionEvent(dpy: PDisplay; screen: longint; x: longint; y: longint;
delay: dword): longint; cdecl; external;
implementation
function InitializeMouseInput: TMouseInput;
begin
Result := TXMouseInput.Create;
end;
const
MouseButtonToXButton: array [TMouseButton] of Integer = (1, 3, 2, 4, 5);
{ TXMouseInput }
procedure TXMouseInput.DoDown(Button: TMouseButton);
var
Display: PDisplay;
begin
Display := XOpenDisplay(nil);
XTestFakeButtonEvent(Display, MouseButtonToXButton[Button], True, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
procedure TXMouseInput.DoMove(ScreenX, ScreenY: Integer);
var
Display: PDisplay;
begin
Display := XOpenDisplay(nil);
XTestFakeMotionEvent(Display, 0, ScreenX, ScreenY, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
procedure TXMouseInput.DoUp(Button: TMouseButton);
var
Display: PDisplay;
begin
Display := XOpenDisplay(nil);
XTestFakeButtonEvent(Display, MouseButtonToXButton[Button], False, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
procedure TXMouseInput.DoScrollUp;
var
Display: PDisplay;
begin
Display := XOpenDisplay(nil);
XTestFakeButtonEvent(Display, 4, True, 0);
XTestFakeButtonEvent(Display, 4, False, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
procedure TXMouseInput.DoScrollDown;
var
Display: PDisplay;
begin
Display := XOpenDisplay(nil);
XTestFakeButtonEvent(Display, 5, True, 0);
XTestFakeButtonEvent(Display, 5, False, 0);
XFlush(Display);
XCloseDisplay(Display);
end;
end.