1 | unit EOTButton;
|
---|
2 |
|
---|
3 | interface
|
---|
4 |
|
---|
5 | uses
|
---|
6 | ButtonBase, Classes, SysUtils, Graphics, LCLIntf, LCLType;
|
---|
7 |
|
---|
8 | const
|
---|
9 | eotBlinkOff = -1;
|
---|
10 | eotCancel = 0;
|
---|
11 | eotGray = 1;
|
---|
12 | eotBlinkOn = 2;
|
---|
13 | eotBackToNego = 3;
|
---|
14 |
|
---|
15 | type
|
---|
16 | // EndOfTurn button
|
---|
17 | TEOTButton = class(TButtonBase)
|
---|
18 | public
|
---|
19 | constructor Create(aOwner: TComponent); override;
|
---|
20 | destructor Destroy; override;
|
---|
21 | procedure SetButtonIndexFast(x: integer);
|
---|
22 | procedure SetBack(ca: TCanvas; x, y: integer);
|
---|
23 | private
|
---|
24 | FTemplate: TBitmap;
|
---|
25 | FIndex: integer;
|
---|
26 | procedure SetIndex(x: integer);
|
---|
27 | public
|
---|
28 | property Template: TBitmap read FTemplate write FTemplate;
|
---|
29 | published
|
---|
30 | property Visible;
|
---|
31 | property ButtonIndex: integer read FIndex write SetIndex;
|
---|
32 | property OnClick;
|
---|
33 | protected
|
---|
34 | Buffer, Back: TBitmap;
|
---|
35 | procedure Paint; override;
|
---|
36 | end;
|
---|
37 |
|
---|
38 | procedure Register;
|
---|
39 |
|
---|
40 |
|
---|
41 | implementation
|
---|
42 |
|
---|
43 | uses
|
---|
44 | ScreenTools;
|
---|
45 |
|
---|
46 | procedure Register;
|
---|
47 | begin
|
---|
48 | RegisterComponents('C-evo', [TEOTButton]);
|
---|
49 | end;
|
---|
50 |
|
---|
51 | constructor TEOTButton.Create;
|
---|
52 | begin
|
---|
53 | inherited;
|
---|
54 | Buffer := TBitmap.Create;
|
---|
55 | Buffer.PixelFormat := pf24bit;
|
---|
56 | Buffer.SetSize(48, 48);
|
---|
57 | Buffer.Canvas.FillRect(0, 0, Buffer.Width, Buffer.Height);
|
---|
58 | Back := TBitmap.Create;
|
---|
59 | Back.PixelFormat := pf24bit;
|
---|
60 | Back.SetSize(48, 48);
|
---|
61 | Back.Canvas.FillRect(0, 0, Back.Width, Back.Height);
|
---|
62 | ShowHint := true;
|
---|
63 | SetBounds(0, 0, 48, 48);
|
---|
64 | end;
|
---|
65 |
|
---|
66 | destructor TEOTButton.Destroy;
|
---|
67 | begin
|
---|
68 | FreeAndNil(Buffer);
|
---|
69 | FreeAndNil(Back);
|
---|
70 | inherited;
|
---|
71 | end;
|
---|
72 |
|
---|
73 | procedure TEOTButton.Paint;
|
---|
74 | begin
|
---|
75 | with Canvas do
|
---|
76 | if FGraphic <> nil then
|
---|
77 | begin
|
---|
78 | // TODO: For some reason BitBlt is not working with gray background here
|
---|
79 | //BitBltCanvas(Buffer.Canvas, 0, 0, 48, 48, Back.Canvas, 0, 0);
|
---|
80 | Buffer.Canvas.Draw(0, 0, Back);
|
---|
81 | ImageOp_CBC(Buffer, Template, 0, 0, 133, 149 + 48 * Byte(FDown), 48, 48,
|
---|
82 | $000000, $FFFFFF);
|
---|
83 | if FIndex >= 0 then
|
---|
84 | ImageOp_CBC(Buffer, Template, 8, 8, 1 + 32 * Byte(FIndex), 246, 32, 32,
|
---|
85 | $000000, $FFFFFF);
|
---|
86 | BitBltCanvas(Canvas, 0, 0, 48, 48, Buffer.Canvas, 0, 0);
|
---|
87 | end
|
---|
88 | else
|
---|
89 | begin
|
---|
90 | Brush.Color := $0000FF;
|
---|
91 | FrameRect(Rect(0, 0, 48, 48))
|
---|
92 | end;
|
---|
93 | end;
|
---|
94 |
|
---|
95 | procedure TEOTButton.SetIndex(x: integer);
|
---|
96 | begin
|
---|
97 | if x <> FIndex then
|
---|
98 | begin
|
---|
99 | FIndex := x;
|
---|
100 | Invalidate;
|
---|
101 | end;
|
---|
102 | end;
|
---|
103 |
|
---|
104 | procedure TEOTButton.SetButtonIndexFast(x: integer);
|
---|
105 | begin
|
---|
106 | if Visible and (x <> FIndex) then
|
---|
107 | begin
|
---|
108 | FIndex := x;
|
---|
109 | try
|
---|
110 | Paint
|
---|
111 | except
|
---|
112 | end;
|
---|
113 | end;
|
---|
114 | end;
|
---|
115 |
|
---|
116 | procedure TEOTButton.SetBack(ca: TCanvas; x, y: integer);
|
---|
117 | begin
|
---|
118 | BitBltCanvas(Back.Canvas, 0, 0, 48, 48, ca, x, y);
|
---|
119 | end;
|
---|
120 |
|
---|
121 | end.
|
---|