code_junkie

THotkey with win-key support?

Nov 12th, 2011
58
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.14 KB | None | 0 0
  1. TMyCustomHotKey = class(TWinControl)
  2. public
  3. WinKey: boolean;
  4. procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
  5. constructor Create(AOwner: TComponent); override;
  6. end;
  7.  
  8. TMyHotKey = class(TMyCustomHotKey)
  9.  
  10. procedure TMyCustomHotKey.KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  11. var
  12. a : integer;
  13. lbl : string;
  14. tmphot : tshortcut;
  15. begin
  16.  
  17. a:= 0;
  18. if GetAsyncKeyState(VK_LWIN) <> 0 then a:= 1;
  19. if GetAsyncKeyState(VK_RWIN) <> 0 then a:= 1;
  20.  
  21. if a=1 then begin
  22. winkey := true;
  23. end else
  24. begin
  25. winkey := false;
  26. end;
  27. rePaint();
  28. }
  29.  
  30.  
  31. procedure TMyCustomHotKey.WMPaint(var Message: TWMPaint);
  32. var
  33. PS: TPaintStruct;
  34. DC: HDC;
  35. Canvas: TCanvas;
  36. i: Integer;
  37. X, Y: Integer;
  38. OldColor: TColor;
  39. Size: TSize;
  40. Max: Integer;
  41. s, Palabra, PrevWord: string;
  42. OldPen, DrawPen: HPEN;
  43. tmphot : tshortcut;
  44. Key: Word;
  45. Shift: TShiftState;
  46.  
  47. lbl ,res: string;
  48. keyboardState: TKeyboardState;
  49. asciiResult: Integer;
  50.  
  51. begin
  52.  
  53. DC := Message.DC;
  54. if DC = 0 then DC := BeginPaint(Handle, PS);
  55.  
  56. Canvas := TCanvas.Create;
  57. try
  58.  
  59. OldColor := Font.Color;
  60. Canvas.Handle := DC;
  61. Canvas.Font.Name := Font.Name;
  62. Canvas.Font.Size := Font.Size;
  63. with Canvas do
  64. begin
  65.  
  66. Brush.Color := Self.Color;
  67. FillRect(Self.ClientRect);
  68. Font.Color := OldColor;
  69.  
  70. tmphot := gethotkey;
  71. ShortCutToKey(tmphot, Key, Shift);
  72.  
  73. res := GetCharFromVKey(key);
  74.  
  75.  
  76. if (winkey = false) and (key = 0 ) and (tmphot = 0)then
  77. BEGIN lbl := 'Enter hotkey [CTRL/ALT/WIN] + Key' ;
  78. TextOut(1 ,1,lbl) ;
  79. END
  80. else begin
  81.  
  82. if winkey then lbl := 'Win +' else lbl := '';
  83. if ssAlt in Shift then lbl := lbl+ 'Alt + ';
  84. if ssShift in Shift then lbl := lbl+ 'Shift + ';
  85. if (not winkey) and (ssCtrl in Shift) then lbl := lbl+ 'Ctrl + ';
  86. lbl := lbl+ res;
  87.  
  88. end;
  89.  
  90. TextOut(1 ,1,lbl);
  91.  
  92.  
  93.  
  94. end;
  95.  
  96. finally
  97. if Message.DC = 0 then EndPaint(Handle, PS);
  98. end;
  99. Canvas.Free;
  100. SETCARETPOS(1,1);
  101.  
  102. end;
Add Comment
Please, Sign In to add comment