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;

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