unit UnitFrmHotKey;
{
    Purpose:
        Dialog to enter a Hotkey.
        The user sees his keystrokes as he types them.
    Notes:
        If the keystroke is already taken, the user won't
        be able to use it (since the system intercepts it
        before sending to this dialog).


}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type THotkeyData = record
    alt : boolean;
    ctrl : boolean;
    shft : boolean;
    win : boolean;
    key : word;
    name : string;
end;

type
  TFrmHotkey = class(TForm)
    bSet: TButton;
    bCancel: TButton;
    txtHotkey: TEdit;
    Label1: TLabel;
    btnClear: TButton;
    procedure txtHotkeyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure txtHotkeyKeyPress(Sender: TObject; var Key: Char);
    procedure bSetClick(Sender: TObject);
    procedure bCancelClick(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnClearClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);

    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure CMDialogKey(Var Msg: TWMKey); message CM_DIALOGKEY;
  private
    { Private declarations }
    Hotkey_Ctrl : boolean;
    Hotkey_Alt : boolean;
    Hotkey_Winkey : boolean;
    Hotkey_Shift : boolean;
    Hotkey_Key : word;
    ClearPressed : boolean;
    SetPressed : boolean;
  public
    { Public declarations }
        function GetHotkey(var kAlt, kShift, kCtrl, kWinkey : boolean;
            var VKCode : word;
            var ReadableName : string; ShowClearButton : boolean = false ) : boolean;  overload;
        function GetHumanReadable( kAlt, kShift, kCtrl, kWinkey : boolean;
                    VKCode : word; var Valid : boolean) : string;
        function GetHotKey(var hkd : THotkeyData) : boolean; overload;
        function FromString(s: string): ThotKeydata;
        function ToHKString(hkd: THotkeyData): string;
  end;

var
  FrmHotkey: TFrmHotkey;

implementation

uses UnitKeyboardQuery;

const INVALID_KEYS : string = 'INVALID';
const EMPTY_HOTKEY_NAME = 'none';
{$R *.dfm}

procedure TFrmHotkey.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
    Message.Result := DLGC_WANTARROWS or DLGC_WANTTAB;
end;

procedure TFrmHotkey.CMDialogKey(Var Msg: TWMKEY) ;
var ss : TShiftState;
begin
    if (ActiveControl is TEdit) and
        (Msg.Charcode = VK_TAB) then begin
        ss := KeyDataToShiftState(Msg.KeyData);

        txtHotkeyKeyDown(Self, Msg.CharCode, ss);
    end;
end;

function TFrmHotkey.ToHKString(hkd: THotkeyData): string;
begin
    result :=
        IntToStr(Integer(hkd.alt)) +
        IntToStr(Integer(hkd.ctrl)) +
        IntToStr(Integer(hkd.shft)) +
        IntToStr(Integer(hkd.win)) +
        IntToHex(hkd.key,2) +
        hkd.name;

end;



function TFrmHotkey.FromString(s: string): THotkeyData;
begin
    result.alt := false;
    result.ctrl := false;
    result.shft := false;
    result.win := false;
    result.key := 0;
    result.name := EMPTY_HOTKEY_NAME;
    if length(s) < 6 then begin
        EXIT;
    end;

    result.alt := Boolean(StrToInt(s[1]));
    result.ctrl  := Boolean(StrToInt(s[2]));
    result.shft  := Boolean(StrToInt(s[3]));
    result.win  := Boolean(StrToInt(s[4]));
    result.key := StrToInt('$' +  copy(s,5,2));
    delete(s,1,6);
    result.name := s;
end;

//
// Returns: MOD+KEYNAME when valid
// Returns: "INVALID" on illegal combination
//
function TFrmHotkey.GetHumanReadable( kAlt, kShift, kCtrl, kWinkey : boolean;
    VKCode : word; var Valid : boolean) : string;
    function GetCharFromVirtualKey(Key: Word): string;
     begin
        result := char(lo(MapVirtualKey(key, MAPVK_VK_TO_CHAR)));
        result := UpperCase(result);
     end;
var s : string;
    HasMod, HasKey : boolean;
    const punc1 : string = ';=,-./`';
    const punc2 : string = '[\]''';

begin
    HasMod := false;
    if kWinkey = true then begin
        s := s + 'WINKEY+';
        HasMod := true;
    end;

    if kCtrl = true then begin
        s := s + 'CTRL+';
        HasMod := true;
    end;

    if kShift = true then begin
        s := s + 'SHIFT+';
        HasMod := true;
    end;


    if kAlt = true then begin
        s := s + 'ALT+';
        HasMod := true;
    end;

    //
    // Determine the non-modifier key pressed
    //

    HasKey := true;
    case VKCode of
    VK_BACK:    begin s := s + 'BACKSPACE';  end;
    VK_ESCAPE:  begin s := s + 'ESCAPE';  end;
    VK_TAB:     begin s := s + 'TAB';  end;
    VK_RETURN:  begin s := s + 'ENTER'; end;
    VK_PRINT:   begin s := s + 'PRINT';  end;
    VK_PAUSE:   begin s := s + 'PAUSE';  end;
    VK_SPACE:   begin s := s + 'SPACE';  end;
    VK_HOME:    begin s := s + 'HOME';  end;
    VK_END:     begin s := s + 'END'; end;
    VK_DECIMAL: begin s := s + 'DECIMAL';  end;
    VK_INSERT:  begin s := s + 'INSERT';  end;
    VK_DELETE:  begin s := s + 'DELETE';  end;
    VK_PRIOR:   begin s := s + 'PAGEUP';  end;
    VK_NEXT:    begin s := s + 'PAGEDOWN';  end;
    VK_DOWN:    begin s := s + 'DOWN';  end;
    VK_UP:      begin s := s + 'UP';  end;
    VK_LEFT:    begin s := s + 'LEFT';  end;
    VK_RIGHT:   begin s := s + 'RIGHT';  end;

    VK_SUBTRACT:begin s := s + 'SUBTRACT';  end;
    VK_ADD:     begin s := s + 'ADD';  end;
    VK_MULTIPLY:begin s := s + 'MULTIPLY';  end;
    VK_DIVIDE:  begin s := s + 'DIVIDE';  end;
    VK_NUMLOCK: begin s := s + 'NUMLOCK';  end;

    // 0 .. 9
    48..57:     begin s := s + GetCharFromVirtualKey(VKCode);
                end;
    // A .. Z
    65..90:     begin s := s + GetCharFromVirtualKey(VKCode);
                end;
    // numpad #
    96..105:    begin
                    s := s + 'NUMPAD ' + IntToStr(VKCode - 96);
                end;
    // F1 .. F12
    112..123:   begin s := s + 'F' + IntToStr(VKCode-111);
                end;
    // punctuation VKCodes
    186..192:   begin
                    s := s + GetCharFromVirtualKey(VKCode);
                    //s := s + punc1[VKCode-185];
                end;
    // []\` VKCodes
    219..222:   begin
                s := s + GetCharFromVirtualKey(VKCode);
                //s := s + punc2[VKCode-218];
                end;
    else
        HasKey := false;
    end;

    result := s;
    valid := (HasMod and HasKey);
end;

function TFrmHotkey.GetHotKey(var hkd : THotkeyData) : boolean;
begin
    result := gethotkey(hkd.alt,hkd.shft,hkd.ctrl,hkd.win,hkd.key,hkd.name);
end;
//
// Return true if new hotkey was selected
//
function TFrmHotkey.GetHotkey(var kAlt, kShift, kCtrl, kWinkey : boolean;
    var VKCode : word;
    var ReadableName : string; ShowClearButton : boolean = false) : boolean;
var b : boolean;
begin
    SetPressed := false;
    ClearPressed := false;
    btnClear.Visible := ShowClearButton;
    self.ShowModal;

    if SetPressed then begin
        kAlt := Hotkey_Alt;
        kShift := Hotkey_Shift;
        kCtrl := Hotkey_Ctrl;
        kWinkey := Hotkey_Winkey;
        VKCode := Hotkey_key;
        ReadableName := self.GetHumanReadable(kAlt, kShift, kCtrl, kWinkey, VKCode, b);
    end;

    if ClearPressed then begin
        kAlt := false;
        kShift := false;
        kCtrl := false;
        kWinkey := false;
        VKCode := 0;
        ReadableName := '';
    end;
    result := SetPressed or ClearPressed;
end;


procedure TFrmHotkey.txtHotkeyKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
var State : TKeyboardState;
    s : string;
    valid : boolean;
begin
    bSet.Enabled := false;
    Hotkey_alt := false;
    Hotkey_Ctrl := false;
    Hotkey_Shift := false;
    Hotkey_Winkey := false;
    
    //
    // check modifier keys
    //
    Windows.GetKeyboardState(State);

    if ((State[vk_rwin] and 128) <> 0) or ((State[vk_lwin] and 128) <> 0)then begin
        Hotkey_Winkey := true;
        s := s + 'WINKEY+';
    end;

    if ((State[vk_control] and 128) <> 0) then begin
        Hotkey_Ctrl := true;
        s := s + 'CTRL+';
    end;

    if ((State[vk_shift] and 128) <> 0) then begin
        Hotkey_Shift := true;
        s := s + 'SHIFT+';
    end;


    if ((State[vk_menu] and 128) <> 0) then begin
        Hotkey_Alt := true;
        s := s + 'ALT+';
    end;



    s := Self.GetHumanReadable(hotkey_alt, hotkey_shift, hotkey_ctrl, hotkey_winkey, key, valid);
    //
    // Final results
    // Only allow button to be pressed when we have a modifier and
    // a key selected
    //
    txtHotkey.text := s;
    bSet.Enabled := Valid;
    btnClear.Enabled := valid;
    Hotkey_Key := key;
    key := 0;
end;

procedure TFrmHotkey.txtHotkeyKeyPress(Sender: TObject; var Key: Char);
begin
    key := #0;
end;

procedure TFrmHotkey.bSetClick(Sender: TObject);
begin
    SetPressed := true;
    self.Close;
end;

procedure TFrmHotkey.bCancelClick(Sender: TObject);
begin
    self.Close;
end;

procedure TFrmHotkey.FormActivate(Sender: TObject);
begin
    self.ActiveControl := txtHotkey;
end;

procedure TFrmHotkey.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if (Key = VK_TAB) then begin
        txtHotkeyKeyDown(Self, Key, shift);
    end;
end;

procedure TFrmHotkey.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
    if (KEY = VK_ESCAPE) then begin
        self.bCancel.Click;
     end;
end;

procedure TFrmHotkey.btnClearClick(Sender: TObject);
begin

    self.Close;
end;

end.
