XComponents/XCheckBox.pas at master · nickolasdeluca/XComponents · 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
61
62
63
64
65
66
unit XCheckBox;

interface

uses
  { Winapi }
  Winapi.Messages, Winapi.Windows,
  { System }
  System.SysUtils, System.Classes,
  { Vcl }
  Vcl.Controls, Vcl.StdCtrls, Vcl.Graphics;

type
  TXCheckBox = class(TCheckBox)
  private
    { Private declarations }
    FOriginalCaption: string;
    _MySetCap: Boolean;
    procedure WMPaint(var msg: TWMPaint); message WM_PAINT;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  protected
    { Protected declarations }
  public
    { Public declarations }
  published
    { Published declarations }
  end;

implementation

{ TXCheckBox }

procedure TXCheckBox.CMTextChanged(var Message: TMessage);
begin
  inherited;

  if _MySetCap then
    Exit;

  FOriginalCaption := Caption;
end;

procedure TXCheckBox.WMPaint(var msg: TWMPaint);
var
  ButtonWidth: Integer;
  Canvas: TControlCanvas;
begin
  ButtonWidth := GetSystemMetrics(SM_CXMENUCHECK);

  _MySetCap := True;
  if not (csDesigning in ComponentState) then
    Caption := '';
  _MySetCap := False;
  inherited;
  Canvas := TControlCanvas.Create;
  try
    Canvas.Control := Self;
    Canvas.Font := Font;
    SetBkMode(Canvas.Handle, Ord(TRANSPARENT));
    Canvas.TextOut(ButtonWidth + 1, 2, FOriginalCaption);
  finally
    Canvas.Free;
  end;
end;

end.