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;

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