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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
|
{
Proof of concept one handle per widget GUI.
Graeme Geldenhuys
}
unit gui2Base;
{$mode objfpc}{$H+}
{$Define DEBUG}
interface
uses
Classes
,fpgfx
,GFXBase
;
type
{ TWidget }
TWidget = class(TFWindow)
private
FOnClick: TNotifyEvent;
FOnPainting: TNotifyEvent;
procedure EvOnPaint(Sender: TObject; const Rect: TRect); virtual;
procedure EvOnMousePress(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
protected
procedure Paint; virtual;
property OnPainting: TNotifyEvent read FOnPainting write FOnPainting;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
public
constructor Create(AParent: TFCustomWindow);
end;
{ TForm }
TForm = class(TFWindow)
protected
procedure Paint(Sender: TObject; const Rect: TRect);
public
constructor Create; virtual;
end;
{ TButton }
TButton = class(TWidget)
private
FCaption: string;
procedure EvOnPaint(Sender: TObject; const Rect: TRect); override;
procedure SetCaption(const AValue: string);
protected
procedure Paint; override;
public
constructor Create(AParent: TFCustomWindow; APosition: TPoint);
property Caption: string read FCaption write SetCaption;
published
property OnClick;
end;
implementation
{ TWidget }
procedure TWidget.EvOnPaint(Sender: TObject; const Rect: TRect);
begin
{$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
if Assigned(OnPainting) then
OnPainting(self);
Paint;
end;
procedure TWidget.EvOnMousePress(Sender: TObject; AButton: TMouseButton;
AShift: TShiftState; const AMousePos: TPoint);
begin
if AButton = mbLeft then
begin
if Assigned(OnClick) then
OnClick(self);
end;
end;
procedure TWidget.Paint;
var
r: TRect;
begin
Canvas.SetColor(colLtGray);
r.Left := 0;
r.Top := 0;
r.Right := Width;
r.Bottom := Height;
Canvas.FillRect(r);
end;
constructor TWidget.Create(AParent: TFCustomWindow);
begin
inherited Create(AParent, []);
OnPaint := @EvOnPaint;
OnMouseReleased := @EvOnMousePress;
Show;
end;
{ TForm }
procedure TForm.Paint(Sender: TObject; const Rect: TRect);
var
r: TRect;
begin
{$IFDEF DEBUG} Writeln(ClassName + '.Paint'); {$ENDIF}
Canvas.SetColor(colWhite);
r.Left := 0;
r.Top := 0;
r.Right := Width;
r.Bottom := Height;
Canvas.FillRect(r);
end;
constructor TForm.Create;
begin
inherited Create(nil, [woWindow]);
OnPaint := @Paint;
end;
{ TButton }
procedure TButton.EvOnPaint(Sender: TObject; const Rect: TRect);
begin
inherited EvOnPaint(Sender, Rect);
{$IFDEF DEBUG} Writeln(' - Painting ' + Caption); {$ENDIF}
end;
procedure TButton.SetCaption(const AValue: string);
begin
if FCaption=AValue then exit;
FCaption:=AValue;
Paint;
end;
procedure TButton.Paint;
var
Pt: TPoint;
begin
inherited Paint;
Canvas.SetColor(colBlack);
Canvas.DrawRect(Rect(0, 0, Width, Height));
Pt.x := (Width - Canvas.TextWidth(FCaption)) div 2;
Pt.y := (Height - Canvas.FontCellHeight) div 2;
Canvas.TextOut(Pt, FCaption);
end;
constructor TButton.Create(AParent: TFCustomWindow; APosition: TPoint);
begin
inherited Create(AParent);
SetPosition(APosition);
SetClientSize(Size(75, 25));
SetMinMaxClientSize(Size(75, 25), Size(75, 25));
end;
end.
|
