:: MVP ::
|
|
:: RSS ::
|
|
|
Как перевести виртуальные коды клавиш в символы?
function GetCharFromVirtualKey(Key: Word): string;
var
KeybState: TKeyboardState;
AsciiResult: Integer;
begin
GetKeyboardState(KeybState);
SetLength(Result, 2);
AsciiResult := ToAscii(Key, MapVirtualKey(Key, 0), KeybState, @Result[1], 0);
case AsciiResult of
0: Result := '';
1: SetLength(Result, 1);
2: ;
else
Result := '';
end;
end;
procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Caption := GetCharFromVirtualKey( Key );
end;
|
Как изменить время задержки перед началом автоповтора ввода символа?
procedure TForm1.Button1Click(Sender: TObject);
const
SPEED = 2;
begin
// Второй аргумент указывает на время задержки.
// Поддерживаются 4 значения времени:
// • 0 - 250мс
// • 1 - 500мс
// • 2 - 750мс
// • 3 - 1000мс
SystemParametersInfo(SPI_SETKEYBOARDDELAY, SPEED, nil, SPIF_SENDWININICHANGE);
end;
|
Как изменить частоту автоповтора символа?
procedure TForm1.Button1Click(Sender: TObject);
const
FREQ = 31;
begin
// Второй аргумент принимает значения от 0 до 31, при этом
// 0 соответствует 2,5 символам в секунду, а 31 - 30 символам в секунду.
SystemParametersInfo(SPI_SETKEYBOARDSPEED, FREQ, nil,
SPIF_UPDATEINIFILE or SPIF_SENDCHANGE);
end;
|
Как циклично переключаться между раскладками клавиатуры, загруженными в систему?
// Способ первый
// Применяя этот способ раскладки будут переключаться нормально,
// но вот значек на панели управления, соответствующий текущей
// раскладке, может отображаться некорректно
// Предыдущая по списку раскладка
procedure TForm1.Button1Click(Sender: TObject);
begin
ActivateKeyboardLayout(0, HKL_PREV);
end;
// Следующая по списку раскладка
procedure TForm1.Button2Click(Sender: TObject);
begin
ActivateKeyboardLayout(0, HKL_NEXT);
end;
// Способ второй
// Применяя этот способ раскладки будут переключаться нормально,
// и значек на панели управления, соответствующий текущей
// раскладке, будет корректно отображаться
const
INPUTLANGCHANGE_SYSCHARSET = $0001;
INPUTLANGCHANGE_FORWARD = $0002;
INPUTLANGCHANGE_BACKWARD = $0004;
// Предыдущая по списку раскладка
procedure TForm1.Button1Click(Sender: TObject);
begin
PostMessage(Handle, WM_INPUTLANGCHANGEREQUEST, INPUTLANGCHANGE_BACKWARD, 0);
end;
// Следующая по списку раскладка
procedure TForm1.Button2Click(Sender: TObject);
begin
PostMessage(Handle, WM_INPUTLANGCHANGEREQUEST, INPUTLANGCHANGE_FORWARD, 0);
end;
|
Как получить список установленных раскладок клавиатуры?
procedure GetKLList(List: TStrings);
var
Null, Data: Pointer;
Count, Loaded, Locale: Cardinal;
AklName: array[0..255] of Char;
i: Integer;
begin
// Получаем количество установленных раскладок
GetMem(Null, 0);
Count := GetKeyboardLayoutList(0, Null^);
FreeMem(Null);
// Получачаем список установленных раскладок
GetMem(Data, SizeOf(HKL) * Count);
try
List.Clear;
Loaded := GetKeyboardLayoutList(SizeOf(Data), Data^);
if Loaded <> Count then
raise Exception.Create('Error loading keyboard layout list');
for i := 0 to Count-1 do
begin
Locale := NativeUInt(Pointer(HKL(Data) + i * SizeOf(HKL))^);
GetLocaleInfo(LoWord(Locale), LOCALE_SLANGUAGE, AklName, SizeOf(AklName));
List.AddObject(AklName, Pointer(Locale));
end;
finally
FreeMem(Data);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
GetKLList(ListBox1.Items);
end;
procedure TForm1.ListBox1Click(Sender: TObject);
begin
with Sender as TListBox do
ActivateKeyboardLayout(Hkl(Items.Objects[ItemIndex]), 0);
end;
|
Как эмулировать нажатия мультимедийных клавиш?
// Способ первый
// Virtual-Key Codes
// https://docs.microsoft.com/en-us/windows/win32/inputdev/virtual-key-codes
// Скан-коды
// https://ru.wikipedia.org/wiki/Скан-код
// Увеличиваем громкость
procedure TForm1.Button1Click(Sender: TObject);
var
i: TInput;
begin
i.Itype := INPUT_KEYBOARD;
i.ki.wVk := VK_VOLUME_UP;
i.ki.wScan := $30;
i.ki.dwFlags := KEYEVENTF_EXTENDEDKEY;
SendInput(1, i, SizeOf(i));
// Отпустить клавишу
i.ki.dwFlags := KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP;
SendInput(1, i, SizeOf(i));
end;
// Уменьшаем громкость
procedure TForm1.Button2Click(Sender: TObject);
var
i: TInput;
begin
i.Itype := INPUT_KEYBOARD;
i.ki.wVk := VK_VOLUME_DOWN;
i.ki.wScan := $2E;
i.ki.dwFlags := KEYEVENTF_EXTENDEDKEY;
SendInput(1, i, SizeOf(i));
// Отпустить клавишу
i.ki.dwFlags := KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP;
SendInput(1, i, SizeOf(i));
end;
// Способ второй
// Увеличиваем громкость
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(Handle, WM_APPCOMMAND, Handle, APPCOMMAND_VOLUME_UP shl 16);
end;
// Уменьшаем громкость
procedure TForm1.Button2Click(Sender: TObject);
begin
SendMessage(Handle, WM_APPCOMMAND, Handle, APPCOMMAND_VOLUME_DOWN shl 16);
end;
|
Как отловить нажатие сочетания клавиш Ctrl+ буква?
procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
function ShiftDown: Boolean;
begin
Result := (GetAsyncKeyState(VK_SHIFT) shr 16) and 1 = 1;
end;
begin
if Key = ^J then // Если удалить это условие, то можно отловить любое сочетания Ctrl+ буква
begin
if not ShiftDown then
ShowMessage('Нажато сочетание клавиш Ctrl+' + Chr(Ord(Key) + 64));
Key := #0;
end;
end;
|
При использовании материала - ссылка на сайт обязательна
|
|