Work with Keyboard

// ALT/F4 auschalten :

private
    procedure AppMessage(var msg: TMsg; var Handled: Boolean);

procedure TForm1.FormCreate(Sender: TObject);
begin
        (*
        OnMessage : Occurs when the application receives a Windows message.
        *)
        Application.OnMessage := AppMessage;
end; 

procedure TForm1.AppMessage(var msg: TMsg; var Handled: Boolean);
begin
        Handled := Boolean(0);
        case msg.Message of
                WM_SYSKEYDOWN:
                        if msg.wParam = VK_F4 then
                                { The key Alt-F4 do not permit }
                                Handled := Boolean(1);
        end;
end;

// Automatischer Tab wechsel :

PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);

// Ctrl+Alt+DEL verhindern :

uses
  Registry;

procedure EnableCTRLALTDEL(YesNo : boolean);
const
sRegPolicies = '\Software\Microsoft\Windows\CurrentVersion\Policies';
begin
  with TRegistry.Create do
  try
    RootKey:=HKEY_CURRENT_USER;
    if OpenKey(sRegPolicies+'\System\',True) then
    begin
      case YesNo of
        False:
          begin
            WriteInteger('DisableTaskMgr',1);
          end;
        True:
          begin
            WriteInteger('DisableTaskMgr',0);
          end;
      end;
    end;
    CloseKey;
    if OpenKey(sRegPolicies+'\Explorer\',True) then
    begin
      case YesNo of
        False:
          begin
            WriteInteger('NoChangeStartMenu',1);
            WriteInteger('NoClose',1);
            WriteInteger('NoLogOff',1);
          end;
        True:
          begin
            WriteInteger('NoChangeStartMenu',0);
            WriteInteger('NoClose',0);
            WriteInteger('NoLogOff',0);
          end;
      end;
    end;
    CloseKey;
  finally
    Free;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
    EnableCTRLALTDEL(true);
end;

// oder

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if ((ssAlt in Shift) and (Key = VK_F4)) then
     Key := 0;
end;


// DELETE deaktivieren :

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key in [#08]) then begin Key := #0; Exit; end;  // backspace
 if (Key in [#46]) then begin Key := #0; Exit; end; // del
end;

// Tasten Zahlen ausschalten

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key in ['0'..'9'] then Key := #0;
end;

// Cursor Blinkzeit einstellen :

procedure TForm1.Button2Click(Sender: TObject);
var i : integer;
begin
 i := StrToInt(Edit1.Text);
 SetCaretBlinkTime(i);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Label1.Caption := Format('Caret blink time is: %d ms', [GetCaretBlinkTime]);
end;

// Cursor verstecken


HideCaret(Memo1.Handle);  // Ausblenden


ShowCaret(Memo1.Handle);  // Anzeigen

// Tastendruck als String wiedergeben :

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
    VK_LEFT : Label2.Caption:='This is a LEFT';
    VK_RIGHT: Label2.Caption:='This is a RIGHT';
    VK_UP   : Label2.Caption:='This is a UP';
    VK_DOWN : Label2.Caption:='This is a DOWN';
  end;
end;

// Tastatur komplett sperren :

Function BlockInput(fBlock: boolean): boolean; stdcall;
             external 'user32.dll'


BlockInput(true);  // aus


BlockInput(false);  // an

// Enter Taste als Tabulator :

procedure TForm1.FormCreate(Sender: TObject);
begin
  Form1.KeyPreview := True
end;

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if Key = #13 then
  begin
    Key := #0;
    { check if SHIFT - Key is pressed }
    if GetKeyState(VK_Shift) and $8000 <> 0 then
      PostMessage(Handle, WM_NEXTDLGCTL, 1, 0)
    else
      PostMessage(Handle, WM_NEXTDLGCTL, 0, 0);
  end;
end;

// Info über die Tastatur Model :

procedure TForm1.Button1Click(Sender: TObject);
var
  Str: string;
begin
  case GetKeyboardType(0) of
    1: 	Str:='IBM PC/XT or compatible (83-key) keyboard';
    2:	Str:='Olivetti "ICO" (102-key) keyboard';
    3:	Str:='IBM PC/AT (84-key) or similar keyboard';
    4:  Str:='IBM enhanced (101- or 102-key) keyboard';
    5:  Str:='Nokia 1050 and similar keyboards';
    6:  Str:='Nokia 9140 and similar keyboards';
    7:	Str:='Japanese keyboard';
  end;
  Label1.Caption:='Keyboard type is '+Str;

  case GetKeyboardType(2) of
    1,3,5: Str:='10';
    2,4: Str:='12';
    6: Str:='24';
    7: Str:='Hardware dependent and specified by the OEM';
    else Str:='N/A';
  end;
  Label2.Caption:='Number of functional keys is '+Str;
end;

// LED Kontrolle :

procedure SetLED(Key: Byte; MakeOn: Boolean);
var
  KS: TKeyboardState;
  OnOrOff: Boolean;
begin
  GetKeyboardState(KS);
  OnOrOff:= KS[Key] <> 0;

  // Wenn Status vom gewünschten abweicht
  if (OnOrOff xor MakeOn) then
  begin
    // Je nach Plattform / Key unterschiedliche Strategien
    if (Win32Platform = VER_PLATFORM_WIN32_NT)
      or (Key <> VK_NUMLOCK) then
    begin
      // Tastendruck simulieren
      keybd_event(Key, $45, KEYEVENTF_EXTENDEDKEY, 0);
      keybd_event(Key, $45, KEYEVENTF_EXTENDEDKEY or
        KEYEVENTF_KEYUP, 0);
    end
    else
    begin
      // Gewünschten Status per Setkeyboardstate setzen
      KS[Key]:= Ord(MakeOn);
      SetKeyboardState(KS);
    end;
  end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
SetLED(vk_Capital,True);
SetLED(vk_NUMLOCK,True);
SetLED(vk_SCROLL,True);
Label1.Caption := 'On';
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
SetLED(vk_Capital,False);
SetLED(vk_NUMLOCK,False);
SetLED(vk_SCROLL,False);
Label1.Caption := 'Off';
end;

// LED ermitteln :

procedure TForm1.Button1Click(Sender: TObject);
var
  KeyboardState: TKeyboardState;
begin
  GetKeyboardState(KeyboardState);
  if KeyboardState[VK_CAPITAL]=1 then
    Label1.Caption:='CapsLock ist aktiviert'
    //Showmessage('CapsLock ist aktiviert')
  else
    Label1.Caption:='CapsLock ist deaktiviert';
    //Showmessage('CapsLock ist deaktiviert');
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  KeyboardState: TKeyboardState;
begin
  GetKeyboardState(KeyboardState);
  if KeyboardState[vk_NumLock]=1 then
    Label2.Caption:='NumLock ist aktiviert'
    //Showmessage('NumLock ist aktiviert')
  else
    Label2.Caption:='NumLock ist deaktiviert';
    //Showmessage('NumLock ist deaktiviert');
end;

procedure TForm1.Button3Click(Sender: TObject);

var
  KeyboardState: TKeyboardState;
begin
  GetKeyboardState(KeyboardState);
  if KeyboardState[vk_Scroll]=1 then
    Label3.Caption:='Scroll ist aktiviert'
    //Showmessage('Scroll ist aktiviert')
  else
    Label3.Caption:='Scroll ist deaktiviert';
    //Showmessage('Scroll ist deaktiviert');
end;

// Char der V Tasten ermitteln :

function GetCharFromVKey(vkey: Word): string;
var
  keystate: TKeyboardState;
  retcode: Integer;
begin
  Win32Check(GetKeyboardState(keystate));
  SetLength(Result, 2);
  retcode := ToAscii(vkey,
    MapVirtualKey(vkey, 0),
    keystate, @Result[1],
    0);
  case retcode of
    0: Result := ''; // no character
    1: SetLength(Result, 1);
    2:;
    else
      Result := ''; // retcode < 0 indicates a dead key
  end;
end;

procedure TForm1.Memo1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  label1.Caption := GetCharFromVKey(Key);
end;

// Focus mit Enter Taste wechseln

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if key = #13 then
  begin
    Perform(WM_NEXTDLGCTL, 0, 0);
    key := #0;
  end;
end;

// CAPS-TAB-ROLL Tasten Kontrolle

procedure TForm1.Button1Click(Sender: TObject);
var
  KeyboardState: TKeyboardState;
  i:Integer;
begin
  GetKeyboardState(KeyboardState);
  if KeyboardState[VK_CAPITAL]=1 then
  Edit1.Text :=' - CAPSLOCK ist aktiviert'
  else
  Edit1.Text := ' - CAPSLOCK ist deaktiviert';
  GetKeyboardState(KeyboardState);
  if KeyboardState[VK_SCROLL]=1 then
  Edit2.Text := ' - SCROLL ist aktiviert'
  else
  Edit2.Text := ' - SCROLL ist deaktiviert';
  GetKeyboardState(KeyboardState);
  if KeyboardState[VK_NUMLOCK]=1 then
  Edit3.Text := ' - NUMLOCK ist aktiviert'
  else
  Edit3.Text := ' - NUMLOCK ist deaktiviert';
end;

// SHIFT Taste nutzen

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if (key=$97) and (ssShift in Shift) then 
  begin 
    {do something} 
  end; 
end;

// Virtual Simulieren von Tastendrücke :

//Ctrl+C, Strg+C:

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(Ord('C'), MapVirtualKey(Ord('C'), 0), 0, 0);
keybd_event(Ord('C'), MapVirtualKey(Ord('C'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0)


//Ctrl+V, Strg+V:

keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), 0, 0);
keybd_event(Ord('V'), MapVirtualKey(Ord('V'), 0), KEYEVENTF_KEYUP, 0);
keybd_event(VK_CONTROL, MapVirtualKey(VK_CONTROL, 0), KEYEVENTF_KEYUP, 0)

// Überschreiben verhinder :

procedure TForm1.RichEdit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  with TRichEdit(Sender) do
    if Key = VK_RETURN then // Wechseln zwischen Überschreiben und Einfügen
      begin
      Key := VK_CANCEL;
      Tag := Tag xor 0;
      Exit;
      //StatusBar1.Panels.Items[8].Text := INS[Tag];
      end;

  with TRichEdit(Sender) do
    if Key = VK_INSERT then // Wechseln zwischen Überschreiben und Einfügen
      begin
      Tag := Tag xor 1;
      //StatusBar1.Panels.Items[8].Text := INS[Tag];
      end;
end;

// Form bestimmte Tasten absachlaten

procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  if (Key in [#08]) then begin Key := #0; Exit; end; // BACKSPACE Taste
  if (Key in [#46]) then begin Key := #0; Exit; end; // F Taste
  if (Key in [#13]) then begin Key := #0; Exit; end; // PAUSE Taste
end;

// Eine About Box mit einer Taste öffnen

private
    { Private declarations }
    procedure FormShortCut(var Msg: TWMKey; var Handled: Boolean);

procedure TForm1.FormShortCut(var Msg: TWMKey; var Handled: Boolean);
begin
 if Msg.CharCode = VK_F1 then
    MessageBoxA( Handle, PChar(Application.Title + #10 + #10 +
                               'Box mit Tastendrück ' +
                               'http://google.de' ),
                                PChar('About'),
                                MB_ICONINFORMATION );
end;