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

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

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

:: MVP ::

:: RSS ::

Яндекс.Метрика

Как подавить реакцию Windows на Ctrl+Alt+Del, Alt+Tab, Ctrl+Esc?

// Отключить указанные комбинации
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 1, 0, 0);
// Включить их обратно
SystemParametersInfo(SPI_SCREENSAVERRUNNING, 0, 0, 0);


Как различить правый и левый Ctrl?

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure WMKEYDOWN(var msg: TMessage); message WM_KEYDOWN;
  public
    { Public declarations }
  end;

{...}

// Форма должна иметь фокус
procedure TForm1.WMKEYDOWN(var msg: TMessage);
begin
   if (msg.LParam and (255 shl 16)) shr 16 <> 29 then
      Exit;

   if msg.LParam and (1 shl 24) > 0 then 
      Form1.Caption := 'Right'
   else
      Form1.Caption := 'Left';
end;


Как изменить раскладку клавиатуры?

// Способ первый
// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
var
  Russian: HKL;
begin
  Russian := LoadKeyboardLayout('00000419', 0);
  ActivateKeyboardLayout(Russian, KLF_ACTIVATE);
end;

// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
var
  Latin: HKL;
begin
  Latin := LoadKeyboardLayout('00000409', 0);
  ActivateKeyboardLayout(Latin, KLF_ACTIVATE);
end;

// Способ второй
// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
begin
  LoadKeyboardLayout('00000419', KLF_ACTIVATE);
end;

// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
begin
  LoadKeyboardLayout('00000409', KLF_ACTIVATE);
end;

// Способ третий
function ChangeLayout(LANG: Integer): Boolean;
var
  Buf: array[0..255] of Char;
  Layouts: array [0..16] of HKL;
  i, Count: Integer;
const
  INPUTLANGCHANGE_SYSCHARSET = $0001;
begin
  Result := False;
  Count := GetKeyboardLayoutList(High(Layouts)+1, Layouts);
  for i := 0 to Count-1 do
    if LoWord(Layouts[i]) and $FF = LANG then
    begin
      Result := ActivateKeyboardLayout(Layouts[i], 0) <> 0;
      if Result then
      begin
        GetLocaleInfo(LoWord(Layouts[i]), LOCALE_ILANGUAGE, Buf, SizeOf(Buf));
        PostMessage(Application.Handle, WM_INPUTLANGCHANGEREQUEST,
                    INPUTLANGCHANGE_SYSCHARSET, LParam(@Buf));
      end;
    end;
end;

// Русский язык
procedure TForm1.Button1Click(Sender: TObject);
begin
  ChangeLayout(LANG_RUSSIAN);
end;

// Английский язык
procedure TForm1.Button2Click(Sender: TObject);
begin
  ChangeLayout(LANG_ENGLISH);
end;


Как определить тип клавиатуры?

function TForm1.GettingKeybType: string;
var
  Flag: integer;
begin
  Flag:=0;
  case GetKeyboardType( Flag ) of
    1: Result := 'IBM PC/XT or compatible (83-key) keyboard';
    2: Result := 'Olivetti "ICO" (102-key) keyboard';
    3: Result := 'IBM PC/AT (84-key) or similar keyboard';
    4: Result := 'IBM enhanced (101- or 102-key) keyboard';
    5: Result := 'Nokia 1050 and similar keyboards';
    6: Result := 'Nokia 9140 and similar keyboards';
    7: Result := 'Japanese keyboard';
  end;
end;


Как узнать состояние кнопок Caps Lock, Num Lock, Scroll Lock?

// Способ первый
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
var
  KS: TKeyboardState;
begin
  GetKeyboardState(KS);

  if KS[VK_CAPITAL] and 1 = 1 then
    LabelCapsLock.Enabled := True
  else
    LabelCapsLock.Enabled := False;

  if KS[VK_NUMLOCK] and 1 = 1 then
    LabelNumLock.Enabled := True
  else
    LabelNumLock.Enabled := False;

  if KS[VK_SCROLL] and 1 = 1 then
    LabelScrollLock.Enabled := True
  else
    LabelScrollLock.Enabled := False;
end;

// Способ второй
// Timer1.Interval = 1
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if (GetKeyState(VK_CAPITAL) and $01) <> 0 then
    LabelCapsLock.Enabled := True
  else
    LabelCapsLock.Enabled := False;

  if (GetKeyState(VK_NUMLOCK) and $01) <> 0 then
    LabelNumLock.Enabled := True
  else
    LabelNumLock.Enabled := False;

  if (GetKeyState(VK_SCROLL) and $01) <> 0 then
    LabelScrollLock.Enabled := True
  else
    LabelScrollLock.Enabled := False;
end;


Как изменить состояние кнопок Caps Lock, Num Lock, Scroll Lock и подобных?

// Коды некоторых клавиш:
// Caps Lock - 020
// Shift - 016
// Insert - 045
// NumLock - 144
// Contrl - 017
// Delete - 046
// Scroll Lock - 145
// Alt - 018
// Tab - 009

// Следующий пример меняет состояние клавиш Caps Lock, 
// Num Lock и Scroll Lock на противоположное:
procedure TForm1.Button1Click(Sender: TObject);
var
  KS: TKeyboardState;
begin
  GetKeyboardState(KS);
  KS[VK_CAPITAL] := KS[VK_CAPITAL] xor 1;
  KS[VK_NUMLOCK] := KS[VK_NUMLOCK] xor 1;
  KS[VK_SCROLL] := KS[VK_SCROLL] xor 1;
  SetKeyboardState(KS);
end;


Как отловить правый Enter (NumPad)?

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  public
    { Public declarations }
  end;

procedure TForm1.WMKeyDown(var Message: TWMKeyDown);
begin
  inherited;

  case Message.CharCode of
    VK_RETURN:
    begin
      if (Message.KeyData and $1000000 <> 0) then 
        Form1.Caption := 'Правый Enter'
      else
        Form1.Caption := 'Нормальный Enter';
    end;
  end;
end;


Как определить состояние кнопки insert (Insert/Overwrite)?

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case GetKeyState(VK_INSERT) of
    -127: Form1.Caption := 'Insert';
    -128: Form1.Caption := 'Overwrite';
  end;
end;


Как определить, нажал ли пользователь клавишу PrintScreen?

// Способ первый
// Форма должна иметь фокус
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure AppIdle(Sender: TObject; var Done: Boolean);
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnIdle := AppIdle;
end;

procedure TForm1.AppIdle(Sender: TObject; var Done: Boolean);
begin
  if GetAsyncKeyState(VK_SNAPSHOT) <> 0 then
    Form1.Caption := 'PrintScreen нажата!';
  Done := True;
end;

// Способ второй
type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure WMHotKey( var Msg: TWMHotKey ); message WM_HOTKEY;
  end;

{...}

implementation

const
  ID_SNAPSHOT = 101;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  if Msg.HotKey = ID_SNAPSHOT then
    ShowMessage('GotIt');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RegisterHotKey(Form1.Handle, ID_SNAPSHOT, 0, VK_SNAPSHOT);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  UnRegisterHotKey(Form1.Handle, ID_SNAPSHOT);
end;


Как определить, что была нажата клавиша Tab?

type
  TForm1 = class(TForm)
  private
    { Private declarations }
    procedure CMDialogKey( var msg: TCMDialogKey ); message CM_DIALOGKEY;
  public
    { Public declarations }
  end;

procedure TForm1.CMDialogKey(var msg: TCMDialogKey);
begin
  if msg.Charcode <> VK_TAB then
    inherited;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Key = VK_TAB then
    Form1.Caption := 'Клавиша Tab нажата!';
end;

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