FAQ VCL
Клавиатура и мышь\Клавиатура

:: Меню ::
:: На главную ::
:: FAQ ::
:: Заметки ::
:: Практика ::
:: Win API ::
:: Проекты ::
:: Скачать ::
:: Секреты ::
:: Ссылки ::

:: Сервис ::
:: Написать ::

:: 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;

При использовании материала - ссылка на сайт обязательна