source: trunk/Packages/CevoComponents/ButtonA.pas

Last change on this file was 568, checked in by chronos, 4 days ago
  • Fixed: Custom draw ListBox items to keep consistent style on Linux.
  • Fixed: Last game name index error if no saved games.
File size: 1.6 KB
Line 
1unit ButtonA;
2
3interface
4
5uses
6 ButtonBase, Classes, LCLIntf, LCLType, ScreenTools, Types,
7 {$IFDEF DPI}Dpi.Graphics{$ELSE}Graphics{$ENDIF};
8
9type
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
26procedure Register;
27
28
29implementation
30
31procedure Register;
32begin
33 RegisterComponents('C-evo', [TButtonA]);
34end;
35
36constructor TButtonA.Create(AOwner: TComponent);
37begin
38 inherited;
39 FCaption := '';
40 SetBounds(0, 0, 100, 25);
41end;
42
43procedure TButtonA.Paint;
44var
45 TextSize: TSize;
46begin
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;
59end;
60
61procedure TButtonA.SetCaption(Text: string);
62begin
63 if Text <> FCaption then begin
64 FCaption := Text;
65 Invalidate;
66 end;
67end;
68
69procedure TButtonA.SetFont(const Font: TFont);
70begin
71 Canvas.Font.Assign(Font);
72 Canvas.Font.Color := $000000;
73end;
74
75end.
Note: See TracBrowser for help on using the repository browser.