home *** CD-ROM | disk | FTP | other *** search
/ Softwarová Záchrana 3 / Softwarova-zachrana-3.bin / ArsClip / source.zip / UnitFrmHotKey.pas < prev    next >
Pascal/Delphi Source File  |  2002-10-18  |  6KB  |  250 lines
  1. unit UnitFrmHotKey;
  2. {
  3.     Purpose:
  4.         Dialog to enter a Hotkey.
  5.         The user sees his keystrokes as he types them.
  6.     Notes:
  7.         If the keystroke is already taken, the user won't
  8.         be able to use it (since the system intercepts it
  9.         before sending to this dialog).
  10.  
  11.  
  12. }
  13.  
  14. interface
  15.  
  16. uses
  17.   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  18.   Dialogs, StdCtrls;
  19.  
  20. type
  21.   TFrmHotkey = class(TForm)
  22.     bSet: TButton;
  23.     bCancel: TButton;
  24.     txtHotkey: TEdit;
  25.     Label1: TLabel;
  26.     procedure txtHotkeyKeyDown(Sender: TObject; var Key: Word;
  27.       Shift: TShiftState);
  28.     procedure txtHotkeyKeyPress(Sender: TObject; var Key: Char);
  29.     procedure bSetClick(Sender: TObject);
  30.     procedure bCancelClick(Sender: TObject);
  31.     procedure FormActivate(Sender: TObject);
  32.   private
  33.     { Private declarations }
  34.     Hotkey_Ctrl : boolean;
  35.     Hotkey_Alt : boolean;
  36.     Hotkey_Winkey : boolean;
  37.     Hotkey_Shift : boolean;
  38.     Hotkey_Key : word;
  39.  
  40.     SetPressed : boolean;
  41.   public
  42.     { Public declarations }
  43.         function GetHotkey(var kAlt, kShift, kCtrl, kWinkey : boolean;
  44.             var VKCode : word;
  45.             var ReadableName : string) : boolean;
  46.         function GetHumanReadable( kAlt, kShift, kCtrl, kWinkey : boolean;
  47.                     VKCode : word; var Valid : boolean) : string;
  48.   end;
  49.  
  50. var
  51.   FrmHotkey: TFrmHotkey;
  52.  
  53. implementation
  54.  
  55. const INVALID_KEYS : string = 'INVALID';
  56. {$R *.dfm}
  57.  
  58.  
  59. //
  60. // Returns: MOD+KEYNAME when valid
  61. // Returns: "INVALID" on illegal combination
  62. //
  63. function TFrmHotkey.GetHumanReadable( kAlt, kShift, kCtrl, kWinkey : boolean;
  64.     VKCode : word; var Valid : boolean) : string;
  65. var s : string;
  66.     HasMod, HasKey : boolean;
  67.     const punc1 : string = ';=,-./`';
  68.     const punc2 : string = '[\]''';
  69.  
  70. begin
  71.     HasMod := false;
  72.     if kWinkey = true then begin
  73.         s := s + 'WINKEY+';
  74.         HasMod := true;
  75.     end;
  76.  
  77.     if kCtrl = true then begin
  78.         s := s + 'CTRL+';
  79.         HasMod := true;
  80.     end;
  81.  
  82.     if kShift = true then begin
  83.         s := s + 'SHIFT+';
  84.         HasMod := true;
  85.     end;
  86.  
  87.  
  88.     if kAlt = true then begin
  89.         s := s + 'ALT+';
  90.         HasMod := true;
  91.     end;
  92.  
  93.     //
  94.     // Determine the non-modifier key pressed
  95.     //
  96.  
  97.     HasKey := true;
  98.     case VKCode of
  99.     VK_BACK:    begin s := s + 'BACKSPACE';  end;
  100.     VK_ESCAPE:  begin s := s + 'ESCAPE';  end;
  101.     VK_TAB:     begin s := s + 'TAB';  end;
  102.     VK_RETURN:  begin s := s + 'ENTER'; end;
  103.     VK_PRINT:   begin s := s + 'PRINT';  end;
  104.     VK_PAUSE:   begin s := s + 'PAUSE';  end;
  105.     VK_SPACE:   begin s := s + 'SPACE';  end;
  106.     VK_HOME:    begin s := s + 'HOME';  end;
  107.     VK_END:     begin s := s + 'END'; end;
  108.     VK_DECIMAL: begin s := s + 'DECIMAL';  end;
  109.     VK_INSERT:  begin s := s + 'INSERT';  end;
  110.     VK_DELETE:  begin s := s + 'DELETE';  end;
  111.     VK_PRIOR:   begin s := s + 'PAGEUP';  end;
  112.     VK_NEXT:    begin s := s + 'PAGEDOWN';  end;
  113.     VK_DOWN:    begin s := s + 'DOWN';  end;
  114.     VK_UP:      begin s := s + 'UP';  end;
  115.     VK_LEFT:    begin s := s + 'LEFT';  end;
  116.     VK_RIGHT:   begin s := s + 'RIGHT';  end;
  117.  
  118.     VK_SUBTRACT:begin s := s + 'SUBTRACT';  end;
  119.     VK_ADD:     begin s := s + 'ADD';  end;
  120.     VK_MULTIPLY:begin s := s + 'MULTIPLY';  end;
  121.     VK_DIVIDE:  begin s := s + 'DIVIDE';  end;
  122.     VK_NUMLOCK: begin s := s + 'NUMLOCK';  end;
  123.  
  124.     // 0 .. 9
  125.     48..57:     begin s := s + chr(VKCode);
  126.                 end;
  127.     // A .. Z
  128.     65..90:     begin s := s + chr(VKCode);
  129.                 end;
  130.     // numpad #
  131.     96..105:    begin s := s + 'NUMPAD ' + IntToStr(VKCode - 95);
  132.                 end;
  133.     // F1 .. F12
  134.     112..123:   begin s := s + 'F' + IntToStr(VKCode-111);
  135.                 end;
  136.     // punctuation VKCodes
  137.     186..192:   begin
  138.                     s := s + punc1[VKCode-185];
  139.                 end;
  140.     // []\` VKCodes
  141.     219..222:   begin
  142.                     s := s + punc2[VKCode-218];
  143.                 end;
  144.     else
  145.         HasKey := false;
  146.     end;
  147.  
  148.     result := s;
  149.     valid := (HasMod and HasKey);
  150. end;
  151.  
  152. //
  153. // Return true if new hotkey was selected
  154. //
  155. function TFrmHotkey.GetHotkey(var kAlt, kShift, kCtrl, kWinkey : boolean;
  156.     var VKCode : word;
  157.     var ReadableName : string) : boolean;
  158. var b : boolean;
  159. begin
  160.     SetPressed := false;
  161.     self.ShowModal;
  162.  
  163.     if SetPressed then begin
  164.         kAlt := Hotkey_Alt;
  165.         kShift := Hotkey_Shift;
  166.         kCtrl := Hotkey_Ctrl;
  167.         kWinkey := Hotkey_Winkey;
  168.         VKCode := Hotkey_key;
  169.         ReadableName := self.GetHumanReadable(kAlt, kShift, kCtrl, kWinkey, VKCode, b);
  170.     end;
  171.  
  172.     result := SetPressed;
  173. end;
  174.  
  175.  
  176. procedure TFrmHotkey.txtHotkeyKeyDown(Sender: TObject; var Key: Word;
  177.   Shift: TShiftState);
  178. var State : TKeyboardState;
  179.     s : string;
  180.     valid : boolean;
  181. begin
  182.     bSet.Enabled := false;
  183.     Hotkey_alt := false;
  184.     Hotkey_Ctrl := false;
  185.     Hotkey_Shift := false;
  186.     Hotkey_Winkey := false;
  187.     
  188.     //
  189.     // check modifier keys
  190.     //
  191.     Windows.GetKeyboardState(State);
  192.  
  193.     if ((State[vk_rwin] and 128) <> 0) or ((State[vk_lwin] and 128) <> 0)then begin
  194.         Hotkey_Winkey := true;
  195.         s := s + 'WINKEY+';
  196.     end;
  197.  
  198.     if ((State[vk_control] and 128) <> 0) then begin
  199.         Hotkey_Ctrl := true;
  200.         s := s + 'CTRL+';
  201.     end;
  202.  
  203.     if ((State[vk_shift] and 128) <> 0) then begin
  204.         Hotkey_Shift := true;
  205.         s := s + 'SHIFT+';
  206.     end;
  207.  
  208.  
  209.     if ((State[vk_menu] and 128) <> 0) then begin
  210.         Hotkey_Alt := true;
  211.         s := s + 'ALT+';
  212.     end;
  213.  
  214.  
  215.  
  216.     s := Self.GetHumanReadable(hotkey_alt, hotkey_shift, hotkey_ctrl, hotkey_winkey, key, valid);
  217.     //
  218.     // Final results
  219.     // Only allow button to be pressed when we have a modifier and
  220.     // a key selected
  221.     //
  222.     txtHotkey.text := s;
  223.     bSet.Enabled := Valid;
  224.     Hotkey_Key := key;
  225.     key := 0;
  226. end;
  227.  
  228. procedure TFrmHotkey.txtHotkeyKeyPress(Sender: TObject; var Key: Char);
  229. begin
  230.     key := #0;
  231. end;
  232.  
  233. procedure TFrmHotkey.bSetClick(Sender: TObject);
  234. begin
  235.     SetPressed := true;
  236.     self.Close;
  237. end;
  238.  
  239. procedure TFrmHotkey.bCancelClick(Sender: TObject);
  240. begin
  241.     self.Close;
  242. end;
  243.  
  244. procedure TFrmHotkey.FormActivate(Sender: TObject);
  245. begin
  246.     self.ActiveControl := txtHotkey;
  247. end;
  248.  
  249. end.
  250.