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

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

View File

@@ -0,0 +1,91 @@
{ 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;
interface
uses
Classes, SysUtils, Types, windows, messages, 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); overload;
procedure Press(StringValue : String); overload;
procedure Apply(Shift: TShiftState);
procedure Unapply(Shift: TShiftState);
end;
implementation
{ 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.

View File

@@ -0,0 +1,50 @@
{ 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,
WinMouseInput,
WinKeyInput,
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.

View File

@@ -0,0 +1,283 @@
{ 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;
interface
uses
Classes, SysUtils, Types, windows, 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); overload;
procedure Down(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure Down(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure Move(Shift: TShiftState; Control: TControl; X, Y: Integer; Duration: Integer = 0); overload;
procedure MoveBy(Shift: TShiftState; DX, DY: Integer; Duration: Integer = 0); overload;
procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer; Duration: Integer); overload;
procedure Move(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure ScrollUp(Shift: TShiftState); overload;
procedure ScrollUp(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure ScrollUp(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure ScrollDown(Shift: TShiftState); overload;
procedure ScrollDown(Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure ScrollDown(Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure Up(Button: TMouseButton; Shift: TShiftState); overload;
procedure Up(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure Up(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure Click(Button: TMouseButton; Shift: TShiftState); overload;
procedure Click(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure Click(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
procedure DblClick(Button: TMouseButton; Shift: TShiftState); overload;
procedure DblClick(Button: TMouseButton; Shift: TShiftState; Control: TControl; X, Y: Integer); overload;
procedure DblClick(Button: TMouseButton; Shift: TShiftState; ScreenX, ScreenY: Integer); overload;
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-}Windows.GetTickCount;
while {%H-}Windows.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.

View File

@@ -0,0 +1,71 @@
{ 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;
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.Itype := 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.

View File

@@ -0,0 +1,126 @@
{ 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;
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); overload;
var
Input: TInput;
begin
{$IFDEF VER2_6}
FillChar(Input, SizeOf(Input), 0);
{$ELSE}
Input := Default(TInput);
{$ENDIF}
Input.mi.mouseData := MouseData;
Input.Itype := INPUT_MOUSE;
Input.mi.dwFlags := Flag;
SendInput(1, Input, SizeOf(Input));
end;
procedure SendMouseInput(Flag: DWORD; X, Y: Integer); overload;
var
Input: TInput;
begin
{$IFDEF VER2_6}
FillChar(Input, SizeOf(Input), 0);
{$ELSE}
Input := Default(TInput);
{$ENDIF}
Input.Itype := 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.