1 | unit ButtonA;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | ButtonBase, Classes, LCLIntf, LCLType, ScreenTools, Types,
|
---|
7 | {$IFDEF DPI}Dpi.Graphics{$ELSE}Graphics{$ENDIF};
|
---|
8 |
|
---|
9 | type
|
---|
10 | TButtonA = class(TButtonBase)
|
---|
11 | constructor Create(AOwner: TComponent); override;
|
---|
12 | private
|
---|
13 | FCaption: string;
|
---|
14 | procedure SetFont(const Font: TFont);
|
---|
15 | protected
|
---|
16 | procedure SetCaption(Text: string);
|
---|
17 | procedure Paint; override;
|
---|
18 | public
|
---|
19 | property Font: TFont write SetFont;
|
---|
20 | published
|
---|
21 | property Visible;
|
---|
22 | property Caption: string read FCaption write SetCaption;
|
---|
23 | property OnClick;
|
---|
24 | end;
|
---|
25 |
|
---|
26 | procedure Register;
|
---|
27 |
|
---|
28 |
|
---|
29 | implementation
|
---|
30 |
|
---|
31 | procedure Register;
|
---|
32 | begin
|
---|
33 | RegisterComponents('C-evo', [TButtonA]);
|
---|
34 | end;
|
---|
35 |
|
---|
36 | constructor TButtonA.Create(AOwner: TComponent);
|
---|
37 | begin
|
---|
38 | inherited;
|
---|
39 | FCaption := '';
|
---|
40 | SetBounds(0, 0, 100, 25);
|
---|
41 | end;
|
---|
42 |
|
---|
43 | procedure TButtonA.Paint;
|
---|
44 | var
|
---|
45 | TextSize: TSize;
|
---|
46 | begin
|
---|
47 | with Canvas do
|
---|
48 | if FGraphic <> nil then begin
|
---|
49 | BitBltCanvas(Canvas, 0, 0, 100, 25, Graphic.Canvas, 195,
|
---|
50 | 243 + 26 * Byte(Down));
|
---|
51 | Canvas.Brush.Style := TBrushStyle.bsClear;
|
---|
52 | TextSize := TextExtent(FCaption);
|
---|
53 | TextOut(50 - (TextSize.Width + 1) div 2,
|
---|
54 | 12 - TextSize.Height div 2, FCaption);
|
---|
55 | end else begin
|
---|
56 | Brush.Color := $0000FF;
|
---|
57 | FrameRect(Rect(0, 0, 100, 25));
|
---|
58 | end;
|
---|
59 | end;
|
---|
60 |
|
---|
61 | procedure TButtonA.SetCaption(Text: string);
|
---|
62 | begin
|
---|
63 | if Text <> FCaption then begin
|
---|
64 | FCaption := Text;
|
---|
65 | Invalidate;
|
---|
66 | end;
|
---|
67 | end;
|
---|
68 |
|
---|
69 | procedure TButtonA.SetFont(const Font: TFont);
|
---|
70 | begin
|
---|
71 | Canvas.Font.Assign(Font);
|
---|
72 | Canvas.Font.Color := $000000;
|
---|
73 | end;
|
---|
74 |
|
---|
75 | end.
|
---|