Как сделать калькулятор в Delphi?
Delphi - объектно-ориентированный язык программирования, разработанный компанией Borland в 1995 году. Он основан на языке программирования Pascal, но имеет более расширенные возможности и добавлены новые функции.
Как Delphi реализует многоплатформенную разработку?
Delphi является интегрированной средой разработки (IDE), которая позволяет разрабатывать программное обеспечение для различных платформ, включая Windows, macOS, Android и iOS. Delphi достигает многоплатформенности с помощью...
Эмуляция нажатия клавиши для любого активного приложения
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Эмуляция нажатия клавиши
Функция SendKeys этого юнита, эмулиреут нажатие клавиши для лююого активного приложения
Для активизации приложения ивпользуйте функцию AppActivate
Зависимости: SysUtils, Windows, messages
Автор: VID, vidsnap@mail.ru, ICQ:132234868, Махачкала
Copyright: Автор неизвестен
Дата: 19 июня 2002 г.
***************************************************** }
unit SKUnit;
interface
uses
SysUtils, Windows, messages;
function
SendKeys(SendKeysString: PChar; Wait: Boolean): Boolean;
function
AppActivate(WindowName: PChar): boolean;
const
WorkBufLen = 40;
var
WorkBuf: array
[0..WorkBufLen] of
Char;
implementation
type
THKeys = array
[0..pred(MaxLongInt)] of
byte;
var
AllocationSize: integer;
(*
Converts a string
of
characters and
key names to
keyboard events and
passes them to
Windows.
Example syntax:
SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);
*)
function
SendKeys(SendKeysString: PChar; Wait: Boolean): Boolean;
type
WBytes = array
[0..pred(SizeOf(Word))] of
Byte;
TSendKey = record
Name: ShortString;
VKey: Byte;
end
;
const
{Array of keys that SendKeys recognizes.
If you add to this list, you must be sure to keep it sorted alphabetically
by Name because a binary search routine is used to scan it.}
MaxSendKeyRecs = 41;
SendKeyRecs: array
[1..MaxSendKeyRecs] of
TSendKey =
(
(Name: 'BKSP'; VKey: VK_BACK),
(Name: 'BS'; VKey: VK_BACK),
(Name: 'BACKSPACE'; VKey: VK_BACK),
(Name: 'BREAK'; VKey: VK_CANCEL),
(Name: 'CAPSLOCK'; VKey: VK_CAPITAL),
(Name: 'CLEAR'; VKey: VK_CLEAR),
(Name: 'DEL'; VKey: VK_DELETE),
(Name: 'DELETE'; VKey: VK_DELETE),
(Name: 'DOWN'; VKey: VK_DOWN),
(Name: 'END'; VKey: VK_END),
(Name: 'ENTER'; VKey: VK_RETURN),
(Name: 'ESC'; VKey: VK_ESCAPE),
(Name: 'ESCAPE'; VKey: VK_ESCAPE),
(Name: 'F1'; VKey: VK_F1),
(Name: 'F10'; VKey: VK_F10),
(Name: 'F11'; VKey: VK_F11),
(Name: 'F12'; VKey: VK_F12),
(Name: 'F13'; VKey: VK_F13),
(Name: 'F14'; VKey: VK_F14),
(Name: 'F15'; VKey: VK_F15),
(Name: 'F16'; VKey: VK_F16),
(Name: 'F2'; VKey: VK_F2),
(Name: 'F3'; VKey: VK_F3),
(Name: 'F4'; VKey: VK_F4),
(Name: 'F5'; VKey: VK_F5),
(Name: 'F6'; VKey: VK_F6),
(Name: 'F7'; VKey: VK_F7),
(Name: 'F8'; VKey: VK_F8),
(Name: 'F9'; VKey: VK_F9),
(Name: 'HELP'; VKey: VK_HELP),
(Name: 'HOME'; VKey: VK_HOME),
(Name: 'INS'; VKey: VK_INSERT),
(Name: 'LEFT'; VKey: VK_LEFT),
(Name: 'NUMLOCK'; VKey: VK_NUMLOCK),
(Name: 'PGDN'; VKey: VK_NEXT),
(Name: 'PGUP'; VKey: VK_PRIOR),
(Name: 'PRTSC'; VKey: VK_PRINT),
(Name: 'RIGHT'; VKey: VK_RIGHT),
(Name: 'SCROLLLOCK'; VKey: VK_SCROLL),
(Name: 'TAB'; VKey: VK_TAB),
(Name: 'UP'; VKey: VK_UP)
);
{Extra VK constants missing from Delphi's Windows API interface}
VK_NULL = 0;
VK_SemiColon = 186;
VK_Equal = 187;
VK_Comma = 188;
VK_Minus = 189;
VK_Period = 190;
VK_Slash = 191;
VK_BackQuote = 192;
VK_LeftBracket = 219;
VK_BackSlash = 220;
VK_RightBracket = 221;
VK_Quote = 222;
VK_Last = VK_Quote;
ExtendedVKeys: set
of
byte =
[VK_Up,
VK_Down,
VK_Left,
VK_Right,
VK_Home,
VK_End,
VK_Prior, {PgUp}
VK_Next, {PgDn}
VK_Insert,
VK_Delete];
const
INVALIDKEY = $FFFF {Unsigned -1};
VKKEYSCANSHIFTON = $01;
VKKEYSCANCTRLON = $02;
VKKEYSCANALTON = $04;
UNITNAME = 'SendKeys';
var
UsingParens, ShiftDown, ControlDown, AltDown, FoundClose: Boolean;
PosSpace: Byte;
I, L: Integer;
NumTimes, MKey: Word;
KeyString: string
[20];
procedure
DisplayMessage(Message
: PChar);
begin
MessageBox(0, Message
, UNITNAME, 0);
end
;
function
BitSet(BitTable, BitMask: Byte): Boolean;
begin
Result := ByteBool(BitTable and
BitMask);
end
;
procedure
SetBit(var
BitTable: Byte; BitMask: Byte);
begin
BitTable := BitTable or
Bitmask;
end
;
procedure
KeyboardEvent(VKey, ScanCode: Byte; Flags: Longint);
var
KeyboardMsg: TMsg;
begin
keybd_event(VKey, ScanCode, Flags, 0);
if
(Wait) then
while
(PeekMessage(KeyboardMsg, 0, WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do
begin
TranslateMessage(KeyboardMsg);
DispatchMessage(KeyboardMsg);
end
;
end
;
procedure
SendKeyDown(VKey: Byte; NumTimes: Word; GenUpMsg: Boolean);
var
Cnt: Word;
ScanCode: Byte;
NumState: Boolean;
KeyBoardState: TKeyboardState;
begin
if
(VKey = VK_NUMLOCK) then
begin
NumState := ByteBool(GetKeyState(VK_NUMLOCK) and
1);
GetKeyBoardState(KeyBoardState);
if
NumState then
KeyBoardState[VK_NUMLOCK] := (KeyBoardState[VK_NUMLOCK] and
not
1)
else
KeyBoardState[VK_NUMLOCK] := (KeyBoardState[VK_NUMLOCK] or
1);
SetKeyBoardState(KeyBoardState);
exit;
end
;
ScanCode := Lo(MapVirtualKey(VKey, 0));
for
Cnt := 1 to
NumTimes do
if
(VKey in
ExtendedVKeys) then
begin
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
if
(GenUpMsg) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or
KEYEVENTF_KEYUP)
end
else
begin
KeyboardEvent(VKey, ScanCode, 0);
if
(GenUpMsg) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end
;
end
;
procedure
SendKeyUp(VKey: Byte);
var
ScanCode: Byte;
begin
ScanCode := Lo(MapVirtualKey(VKey, 0));
if
(VKey in
ExtendedVKeys) then
KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and
KEYEVENTF_KEYUP)
else
KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end
;
procedure
SendKey(MKey: Word; NumTimes: Word; GenDownMsg: Boolean);
begin
if
(BitSet(Hi(MKey), VKKEYSCANSHIFTON)) then
SendKeyDown(VK_SHIFT, 1, False);
if
(BitSet(Hi(MKey), VKKEYSCANCTRLON)) then
SendKeyDown(VK_CONTROL, 1, False);
if
(BitSet(Hi(MKey), VKKEYSCANALTON)) then
SendKeyDown(VK_MENU, 1, False);
SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
if
(BitSet(Hi(MKey), VKKEYSCANSHIFTON)) then
SendKeyUp(VK_SHIFT);
if
(BitSet(Hi(MKey), VKKEYSCANCTRLON)) then
SendKeyUp(VK_CONTROL);
if
(BitSet(Hi(MKey), VKKEYSCANALTON)) then
SendKeyUp(VK_MENU);
end
;
{Implements a simple binary search to locate special key name strings}
function
StringToVKey(KeyString: ShortString): Word;
var
Found, Collided: Boolean;
Bottom, Top, Middle: Byte;
begin
Result := INVALIDKEY;
Bottom := 1;
Top := MaxSendKeyRecs;
Found := false;
Middle := (Bottom + Top) div
2;
repeat
Collided := ((Bottom = Middle) or
(Top = Middle));
if
(KeyString = SendKeyRecs[Middle].Name) then
begin
Found := True;
Result := SendKeyRecs[Middle].VKey;
end
else
begin
if
(KeyString > SendKeyRecs[Middle].Name) then
Bottom := Middle
else
Top := Middle;
Middle := (Succ(Bottom + Top)) div
2;
end
;
until
(Found or
Collided);
if
(Result = INVALIDKEY) then
DisplayMessage('Invalid Key Name');
end
;
procedure
PopUpShiftKeys;
begin
if
(not
UsingParens) then
begin
if
ShiftDown then
SendKeyUp(VK_SHIFT);
if
ControlDown then
SendKeyUp(VK_CONTROL);
if
AltDown then
SendKeyUp(VK_MENU);
ShiftDown := false;
ControlDown := false;
AltDown := false;
end
;
end
;
begin
AllocationSize := MaxInt;
Result := false;
UsingParens := false;
ShiftDown := false;
ControlDown := false;
AltDown := false;
I := 0;
L := StrLen(SendKeysString);
if
(L > AllocationSize) then
L := AllocationSize;
if
(L = 0) then
Exit;
case
SendKeysString[I] of
'(':
begin
UsingParens := True;
Inc(I);
end
;
')':
begin
UsingParens := False;
PopUpShiftKeys;
Inc(I);
end
;
'%':
begin
AltDown := True;
SendKeyDown(VK_MENU, 1, False);
Inc(I);
end
;
'+':
begin
ShiftDown := True;
SendKeyDown(VK_SHIFT, 1, False);
Inc(I);
end
;
'^':
begin
ControlDown := True;
SendKeyDown(VK_CONTROL, 1, False);
Inc(I);
end
;
'{':
begin
NumTimes := 1;
if
(SendKeysString[Succ(I)] = '{') then
begin
MKey := VK_LEFTBRACKET;
SetBit(Wbytes(MKey)[1], VKKEYSCANSHIFTON);
SendKey(MKey, 1, True);
PopUpShiftKeys;
Inc(I, 3);
// Continue;
end
;
KeyString := '';
FoundClose := False;
while
(I <= L) do
begin
Inc(I);
if
(SendKeysString[I] = '}') then
begin
FoundClose := True;
Inc(I);
Break;
end
;
KeyString := KeyString + Upcase(SendKeysString[I]);
end
;
if
(not
FoundClose) then
begin
DisplayMessage('No Close');
Exit;
end
;
if
(SendKeysString[I] = '}') then
begin
MKey := VK_RIGHTBRACKET;
SetBit(Wbytes(MKey)[1], VKKEYSCANSHIFTON);
SendKey(MKey, 1, True);
PopUpShiftKeys;
Inc(I);
// Continue;
end
;
PosSpace := Pos(' ', KeyString);
if
(PosSpace <> 0) then
begin
NumTimes := StrToInt(Copy(KeyString, Succ(PosSpace), Length(KeyString)
- PosSpace));
KeyString := Copy(KeyString, 1, Pred(PosSpace));
end
;
if
(Length(KeyString) = 1) then
MKey := vkKeyScan(KeyString[1])
else
MKey := StringToVKey(KeyString);
if
(MKey <> INVALIDKEY) then
begin
SendKey(MKey, NumTimes, True);
PopUpShiftKeys;
// Continue;
end
;
end
;
'~':
begin
SendKeyDown(VK_RETURN, 1, True);
PopUpShiftKeys;
Inc(I);
end
;
else
begin
MKey := vkKeyScan(SendKeysString[I]);
if
(MKey <> INVALIDKEY) then
begin
SendKey(MKey, 1, True);
PopUpShiftKeys;
end
else
DisplayMessage('Invalid KeyName');
Inc(I);
end
;
end
;
Result := true;
PopUpShiftKeys;
end
;
{AppActivate
This is used to set the current input focus to a given window using its
name. This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function. You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.
}
var
WindowHandle: HWND;
function
EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall
;
const
MAX_WINDOW_NAME_LEN = 80;
var
WindowName: array
[0..MAX_WINDOW_NAME_LEN] of
char;
begin
{Can't test GetWindowText's return value since some windows don't have a title}
GetWindowText(WHandle, WindowName, MAX_WINDOW_NAME_LEN);
Result := (StrLIComp(WindowName, PChar(lParam), StrLen(PChar(lParam))) <> 0);
if
(not
Result) then
WindowHandle := WHandle;
end
;
function
AppActivate(WindowName: PChar): boolean;
begin
try
Result := true;
WindowHandle := FindWindow(nil
, WindowName);
if
(WindowHandle = 0) then
EnumWindows(@EnumWindowsProc, Integer(PChar(WindowName)));
if
(WindowHandle <> 0) then
begin
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
end
else
Result := false;
except
on
Exception do
Result := false;
end
;
end
;
end
.
Пример использования:
SendKeys('A', False);