// Способ первый
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;