delphi/uHotKeyStyleHook.pas at master · kryu2/delphi · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
unit uHotKeyStyleHook;

interface

uses
  Vcl.Graphics, Vcl.Controls, Vcl.StdCtrls;

type
  THotKeyStyleHook = class(TEditStyleHook)
  protected
    procedure Paint(Canvas: TCanvas); override;
  public
    constructor Create(AControl: TWinControl); override;
  end;

implementation

uses
  Winapi.Windows, System.Classes, Vcl.Themes, Vcl.ComCtrls, Vcl.Menus;

{ THotKeyStyleHook }

constructor THotKeyStyleHook.Create(AControl: TWinControl);
begin
  inherited;

  OverridePaint := True;
end;

procedure THotKeyStyleHook.Paint(Canvas: TCanvas);
var
  Text: String;
  Shift: TShiftState;
  Key: Word;
begin
  ShortCutToKey(THotKey(Control).HotKey, Key, Shift);

  if (ssAlt in Shift) then
    Text := Text + 'Alt + ';

  if (ssCtrl in Shift) then
    Text := Text + 'Ctrl + ';

  if (ssShift in Shift) then
    Text := Text + 'Shift + ';

  Text := Text + ShortCutToText(Key);

  SetBkMode(Canvas.Handle, TRANSPARENT);

  Canvas.Font.Color := StyleServices.GetStyleFontColor(sfEditBoxTextNormal);
  Canvas.TextOut(0, 0, Text);
end;

initialization
begin
  TCustomStyleEngine.RegisterStyleHook(THotKey, THotKeyStyleHook);
end;

end.