// Способ первый
procedure TForm1.Button1Click(Sender: TObject);
var
  AklName: PWideChar;
begin
  GetMem(AklName, SizeOf(Char) * 3);
  GetLocaleInfo(LoWord(GetKeyboardLayout(0)),
                LOCALE_SABBREVLANGNAME, AklName,
                SizeOf(AklName));
  ShowMessage(AklName);
  FreeMem(AklName);
end;

// Способ второй
procedure TForm1.Button1Click(Sender: TObject);
var
  AklName: PWideChar;
begin
  GetMem(AklName, SizeOf(Char) * 3);
  GetLocaleInfo(LoWord(GetKeyboardLayout(0)),
                LOCALE_SISO639LANGNAME, AklName,
                SizeOf(AklName));
  ShowMessage(AklName);
  FreeMem(AklName);
end;

// Способ третий
function GetCurrentInputLanguage: string;
var
  LocaleID: cardinal;
  Size: Integer;
  Success: Boolean;
  Layout: HKL;
  SubLanguage, PrimaryLanguage: string;
begin
  Success := False;

  Layout := GetKeyboardLayout(0);
  LocaleID := LoWord(Layout);

  Size := GetLocaleInfo(LocaleID, LOCALE_SISO639LANGNAME, nil, 0);
  SetLength(PrimaryLanguage, Size);
  if GetLocaleInfo(LocaleID, LOCALE_SISO639LANGNAME, @PrimaryLanguage[1], Size) <> 0 then
  begin
    SetLength(PrimaryLanguage, Size - 1);
    Size := GetLocaleInfo(LocaleID, LOCALE_SISO3166CTRYNAME, nil, 0);
    SetLength(SubLanguage, Size);
    if GetLocaleInfo(LocaleID, LOCALE_SISO3166CTRYNAME, @SubLanguage[1], Size) <> 0 then
    begin
      SetLength(SubLanguage, Size - 1);
      Result := Format('%s-%s', [PrimaryLanguage, SubLanguage]);
      Success := True;
    end;
  end;

  if not Success then
    raise Exception.Create('Error retrieving locale information');
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ShowMessage(GetCurrentInputLanguage);
end;

// Способ четвертый
procedure TForm1.Button2Click(Sender: TObject);

  function GetKBLayoutName: string;
  begin
    SetLength(Result, KL_NAMELENGTH);
    GetKeyboardLayoutName(@Result[1]);
    SetLength(Result, lstrlen(@Result[1]));
  end;

begin
  ShowMessage(GetKBLayoutName);
end;

// Способ пятый
procedure TForm1.Button1Click(Sender: TObject);
var
  Buffer: PWideChar;
begin
  GetMem(Buffer, SizeOf(Char) * KL_NAMELENGTH);
  GetKeyboardLayoutName(Buffer);
  case ((StrToInt('$' + Buffer)) and $03FF) of
    LANG_ENGLISH: Caption := 'Eng';
    LANG_RUSSIAN: Caption := 'Rus';
  end;
  FreeMem(Buffer);
end;

// Способ шестой
procedure TForm1.Button1Click(Sender: TObject);
var
  KeyboardLayout: HKL;
begin
  //KeyboardLayout := GetKeyboardLayout(GetWindowThreadProcessId(GetForegroundWindow, nil));
  KeyboardLayout := GetKeyboardLayout(0);
  if KeyboardLayout = 67699721 then
    Caption := 'Eng'
  else if KeyboardLayout = 68748313 then
    Caption := 'Rus';
end;

// Работает под Win NT/2000, но не работает под Win9x
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if (Word(GetKeyState(VK_LSHIFT)) and $8000) <> 0 then
    Caption := 'Левый Shift';
  if (Word(GetKeyState(VK_RSHIFT)) and $8000) <> 0 then
    Caption := 'Правый Shift';

  if (Word(GetKeyState(VK_LWIN)) and $8000) <> 0 then
    Caption := 'Левый Win';
  if (Word(GetKeyState(VK_RWIN)) and $8000) <> 0 then
    Caption := 'Правый Win';

  if (Word(GetKeyState(VK_LCONTROL)) and $8000) <> 0 then
    Caption := 'Левый Control';
  if (Word(GetKeyState(VK_RCONTROL)) and $8000) <> 0 then
    Caption := 'Правый Control';

  if (Word(GetKeyState(VK_LMENU)) and $8000) <> 0 then
    Caption := 'Левый Alt';
  if (Word(GetKeyState(VK_RMENU)) and $8000) <> 0 then
    Caption := 'Правый Alt';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppOnMessage;
end;

procedure TForm1.AppOnMessage(var Msg: TMsg; var Handled: Boolean);
var
  ccode: Word;
begin
  case Msg.Message of
    WM_KEYDOWN, WM_KEYUP:
    begin
      if (GetKeyState(VK_NUMLOCK) >= 0) // NumLock не включен
         and ((Msg.lparam and  $1000000) = 0) then
      begin
        ccode := 0;
        case Msg.wparam of
          VK_HOME: ccode := VK_NUMPAD7;
          VK_UP: ccode := VK_NUMPAD8;
          VK_PRIOR: ccode := VK_NUMPAD9;
          VK_LEFT: ccode := VK_NUMPAD4;
          VK_CLEAR: ccode := VK_NUMPAD5;
          VK_RIGHT: ccode := VK_NUMPAD6;
          VK_END: ccode := VK_NUMPAD1;
          VK_DOWN: ccode := VK_NUMPAD2;
          VK_NEXT: ccode := VK_NUMPAD3;
          VK_INSERT: ccode := VK_NUMPAD0;
          VK_DELETE: ccode := VK_DECIMAL;
        end;
        if ccode <> 0 then
          Msg.Wparam := ccode;
      end;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  KeyboardDelay: Integer;
begin
  SystemParametersInfo(SPI_GETKEYBOARDDELAY, 0, @KeyboardDelay, 0);
  ShowMessage(IntToStr(KeyboardDelay));
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  KeyboardSpeed: Integer;
begin
  SystemParametersInfo(SPI_GETKEYBOARDSPEED, 0, @KeyboardSpeed, 0);
  ShowMessage(IntToStr(KeyboardSpeed));
end;

type
  TForm1 = class(TForm)
  private
    { Private declarations }
  public
    { Public declarations }
    procedure DoMessageEvent( var Msg: TMsg ); message WM_INPUTLANGCHANGEREQUEST {или WM_INPUTLANGCHANGE};
  end;

procedure TForm1.DoMessageEvent(var Msg: TMsg);
begin
  ShowMessage('Произошло изменение раскладки клавиатуры');
end;

// Примечание: чтобы перехватить это сообщение в MDI форме, придется использовать хук.

procedure TForm1.Button1Click(Sender: TObject);
begin
  Caption := Format('Время мерцания каретки: %d ms', [GetCaretBlinkTime]);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetCaretBlinkTime(2000);
end;

// Timer1.Interval = 100
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if GetAsyncKeyState(VK_RETURN) <> 0 then
    ShowMessage('Вы нажали на Enter');
  if GetAsyncKeyState(VK_SPACE) <> 0 then
    ShowMessage('Вы нажали на Space');
  if GetAsyncKeyState(VK_ESCAPE) <> 0 then
    ShowMessage('Вы нажали на Escape');
end;

// Способ первый
function CtrlDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[VK_CONTROL] and 128) <> 0);
end;

function ShiftDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[VK_SHIFT] and 128) <> 0);
end;

function AltDown: Boolean;
var
  State: TKeyboardState;
begin
  GetKeyboardState(State);
  Result := ((State[VK_MENU] and 128) <> 0);
end;

// Способ второй
function CtrlDown: Boolean;
begin
  Result := (GetAsyncKeyState(VK_CONTROL) shr 16) and 1 = 1;
end;

function ShiftDown: Boolean;
begin
  Result := (GetAsyncKeyState(VK_SHIFT) shr 16) and 1 = 1;
end;

function AltDown: Boolean;
begin
  Result := (GetAsyncKeyState(VK_MENU) shr 16) and 1 = 1;
end;