1 | unit UMenu;
|
---|
2 |
|
---|
3 | {$mode delphi}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, Graphics, Controls, fgl;
|
---|
9 |
|
---|
10 | type
|
---|
11 | TMenuItemKind = (ikButton, ikComboBox, ikCheckBox);
|
---|
12 |
|
---|
13 | { TMenuItem }
|
---|
14 |
|
---|
15 | TMenuItem = class
|
---|
16 | BackgroundColor: TColor;
|
---|
17 | BackgroundSelectedColor: TColor;
|
---|
18 | Kind: TMenuItemKind;
|
---|
19 | Text: string;
|
---|
20 | Bounds: TRect;
|
---|
21 | Selected: Boolean;
|
---|
22 | FontSize: Integer;
|
---|
23 | FontColor: Integer;
|
---|
24 | Enabled: Boolean;
|
---|
25 | procedure Paint(Canvas: TCanvas; P: TPoint); virtual;
|
---|
26 | function GetOutputText: string; virtual;
|
---|
27 | constructor Create;
|
---|
28 | end;
|
---|
29 |
|
---|
30 | { TMenuItemCheckBox }
|
---|
31 |
|
---|
32 | TMenuItemCheckBox = class(TMenuItem)
|
---|
33 | private
|
---|
34 | FOnChanged: TNotifyEvent;
|
---|
35 | public
|
---|
36 | Checked: Boolean;
|
---|
37 | procedure Paint(Canvas: TCanvas; P: TPoint); override;
|
---|
38 | property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
---|
39 | end;
|
---|
40 |
|
---|
41 | { TMenuItemComboBox }
|
---|
42 |
|
---|
43 | TMenuItemComboBox = class(TMenuItem)
|
---|
44 | private
|
---|
45 | FOnChanged: TNotifyEvent;
|
---|
46 | public
|
---|
47 | Index: Integer;
|
---|
48 | States: TStringList;
|
---|
49 | constructor Create;
|
---|
50 | destructor Destroy; override;
|
---|
51 | procedure Paint(Canvas: TCanvas; P: TPoint); override;
|
---|
52 | function GetOutputText: string; override;
|
---|
53 | property OnChanged: TNotifyEvent read FOnChanged write FOnChanged;
|
---|
54 | end;
|
---|
55 |
|
---|
56 | { TMenuItemButton }
|
---|
57 |
|
---|
58 | TMenuItemButton = class(TMenuItem)
|
---|
59 | private
|
---|
60 | FOnClick: TNotifyEvent;
|
---|
61 | public
|
---|
62 | procedure Paint(Canvas: TCanvas; P: TPoint); override;
|
---|
63 | property OnClick: TNotifyEvent read FOnClick write FOnClick;
|
---|
64 | end;
|
---|
65 |
|
---|
66 | { TMenuItems }
|
---|
67 |
|
---|
68 | TMenuItems = class(TFPGObjectList<TMenuItem>)
|
---|
69 | function AddButton(Text: string; OnClick: TNotifyEvent): TMenuItemButton;
|
---|
70 | function AddCheckBox(Text: string; OnChanged: TNotifyEvent): TMenuItemCheckBox;
|
---|
71 | function AddComboBox(Text: string; States: array of string; OnChanged:
|
---|
72 | TNotifyEvent): TMenuItemComboBox;
|
---|
73 | end;
|
---|
74 |
|
---|
75 | TMenu = class
|
---|
76 | private
|
---|
77 | FOnExit: TNotifyEvent;
|
---|
78 | public
|
---|
79 | Items: TMenuItems;
|
---|
80 | Parent: TMenu;
|
---|
81 | procedure MouseMove(Position: TPoint);
|
---|
82 | procedure MouseUp(Button: TMouseButton; Position: TPoint);
|
---|
83 | procedure Paint(Canvas: TCanvas; CanvasSize: TPoint);
|
---|
84 | constructor Create;
|
---|
85 | destructor Destroy; override;
|
---|
86 | property OnExit: TNotifyEvent read FOnExit write FOnExit;
|
---|
87 | end;
|
---|
88 |
|
---|
89 | resourcestring
|
---|
90 | SPlay = 'Play';
|
---|
91 | SOptions = 'Options';
|
---|
92 | SExit = 'Exit';
|
---|
93 | SBigMetro = 'Big Metro';
|
---|
94 | SDarkMode = 'Dark mode';
|
---|
95 | SLanguage = 'Language';
|
---|
96 | SCzech = 'Czech';
|
---|
97 | SEnglish = 'English';
|
---|
98 | SBack = 'Back';
|
---|
99 | SAutomatic = 'Automatic';
|
---|
100 | SFullScreen = 'Full screen';
|
---|
101 | SContinue = 'Continue';
|
---|
102 | SRestart = 'Try again';
|
---|
103 |
|
---|
104 |
|
---|
105 | implementation
|
---|
106 |
|
---|
107 | { TMenuItemButton }
|
---|
108 |
|
---|
109 | procedure TMenuItemButton.Paint(Canvas: TCanvas; P: TPoint);
|
---|
110 | begin
|
---|
111 | if Selected then Canvas.Brush.Color := BackgroundSelectedColor
|
---|
112 | else Canvas.Brush.Color := BackgroundColor;
|
---|
113 | if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
|
---|
114 | else Canvas.Brush.Style := bsSolid;
|
---|
115 | Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(Text), Canvas.TextHeight(Text));
|
---|
116 | Canvas.TextOut(P.X, P.Y, Text);
|
---|
117 | end;
|
---|
118 |
|
---|
119 | { TMenuItemCheckBox }
|
---|
120 |
|
---|
121 | procedure TMenuItemCheckBox.Paint(Canvas: TCanvas; P: TPoint);
|
---|
122 | var
|
---|
123 | OutputText: string;
|
---|
124 | begin
|
---|
125 | OutputText := Text;
|
---|
126 | if Checked then OutputText := '✓' + OutputText;
|
---|
127 | if Selected then Canvas.Brush.Color := BackgroundSelectedColor
|
---|
128 | else Canvas.Brush.Color := BackgroundColor;
|
---|
129 | if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
|
---|
130 | else Canvas.Brush.Style := bsSolid;
|
---|
131 | Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(OutputText), Canvas.TextHeight(OutputText));
|
---|
132 | Canvas.TextOut(P.X, P.Y, OutputText);
|
---|
133 | end;
|
---|
134 |
|
---|
135 | { TMenuItem }
|
---|
136 |
|
---|
137 | procedure TMenuItem.Paint(Canvas: TCanvas; P: TPoint);
|
---|
138 | begin
|
---|
139 | end;
|
---|
140 |
|
---|
141 | function TMenuItem.GetOutputText: string;
|
---|
142 | begin
|
---|
143 | Result := Text;
|
---|
144 | end;
|
---|
145 |
|
---|
146 | constructor TMenuItem.Create;
|
---|
147 | begin
|
---|
148 | Enabled := True;
|
---|
149 | FontSize := 40;
|
---|
150 | FontColor := clWhite;
|
---|
151 | end;
|
---|
152 |
|
---|
153 | { TMenuItemComboBox }
|
---|
154 |
|
---|
155 | constructor TMenuItemComboBox.Create;
|
---|
156 | begin
|
---|
157 | States := TStringList.Create;
|
---|
158 | end;
|
---|
159 |
|
---|
160 | destructor TMenuItemComboBox.Destroy;
|
---|
161 | begin
|
---|
162 | States.Free;
|
---|
163 | inherited;
|
---|
164 | end;
|
---|
165 |
|
---|
166 | procedure TMenuItemComboBox.Paint(Canvas: TCanvas; P: TPoint);
|
---|
167 | begin
|
---|
168 | if Selected then Canvas.Brush.Color := BackgroundSelectedColor
|
---|
169 | else Canvas.Brush.Color := BackgroundColor;
|
---|
170 | if Canvas.Brush.Color = clNone then Canvas.Brush.Style := bsClear
|
---|
171 | else Canvas.Brush.Style := bsSolid;
|
---|
172 | Bounds := Classes.Bounds(P.X, P.Y, Canvas.TextWidth(GetOutputText), Canvas.TextHeight(GetOutputText));
|
---|
173 | Canvas.TextOut(P.X, P.Y, GetOutputText);
|
---|
174 | end;
|
---|
175 |
|
---|
176 | function TMenuItemComboBox.GetOutputText: string;
|
---|
177 | begin
|
---|
178 | Result := Text + ': ' + States[Index];
|
---|
179 | end;
|
---|
180 |
|
---|
181 | { TMenu }
|
---|
182 |
|
---|
183 | procedure TMenu.MouseMove(Position: TPoint);
|
---|
184 | var
|
---|
185 | I: Integer;
|
---|
186 | begin
|
---|
187 | for I := 0 to Items.Count - 1 do begin
|
---|
188 | if Items[I].Enabled then
|
---|
189 | Items[I].Selected := Items[I].Bounds.Contains(Position);
|
---|
190 | end;
|
---|
191 | end;
|
---|
192 |
|
---|
193 | procedure TMenu.MouseUp(Button: TMouseButton; Position: TPoint);
|
---|
194 | var
|
---|
195 | I: Integer;
|
---|
196 | begin
|
---|
197 | for I := 0 to Items.Count - 1 do begin
|
---|
198 | if Items[I].Bounds.Contains(Position) then begin
|
---|
199 | if (Items[I] is TMenuItemButton) then begin
|
---|
200 | if Assigned(TMenuItemButton(Items[I]).FOnClick) then
|
---|
201 | TMenuItemButton(Items[I]).FOnClick(Items[I]);
|
---|
202 | end else
|
---|
203 | if (Items[I] is TMenuItemCheckBox) then begin
|
---|
204 | (Items[I] as TMenuItemCheckBox).Checked := not (Items[I] as TMenuItemCheckBox).Checked;
|
---|
205 | if Assigned((Items[I] as TMenuItemCheckBox).FOnChanged) then
|
---|
206 | (Items[I] as TMenuItemCheckBox).FOnChanged(Items[I]);
|
---|
207 | end else
|
---|
208 | if (Items[I] is TMenuItemComboBox) then begin
|
---|
209 | (Items[I] as TMenuItemComboBox).Index := ((Items[I] as TMenuItemComboBox).Index + 1) mod
|
---|
210 | (Items[I] as TMenuItemComboBox).States.Count;
|
---|
211 | if Assigned((Items[I] as TMenuItemComboBox).FOnChanged) then
|
---|
212 | (Items[I] as TMenuItemComboBox).FOnChanged(Items[I]);
|
---|
213 | end;
|
---|
214 | end;
|
---|
215 | end;
|
---|
216 | end;
|
---|
217 |
|
---|
218 | procedure TMenu.Paint(Canvas: TCanvas; CanvasSize: TPoint);
|
---|
219 | var
|
---|
220 | I: Integer;
|
---|
221 | X: Integer;
|
---|
222 | Y: Integer;
|
---|
223 | LineHeight: Integer;
|
---|
224 | TotalWidth: Integer;
|
---|
225 | TotalHeight: Integer;
|
---|
226 | begin
|
---|
227 | with Canvas do begin
|
---|
228 | TotalWidth := 0;
|
---|
229 | TotalHeight := 0;
|
---|
230 |
|
---|
231 | // Calculate total dimensions for centering
|
---|
232 | Font.Style := [fsBold];
|
---|
233 | Brush.Style := bsSolid;
|
---|
234 | for I := 0 to Items.Count - 1 do begin
|
---|
235 | Font.Size := Items[I].FontSize;
|
---|
236 | if TotalWidth < TextWidth(Items[I].GetOutputText) then
|
---|
237 | TotalWidth := TextWidth(Items[I].GetOutputText);
|
---|
238 | LineHeight := Round(TextHeight('I') * 1.1);
|
---|
239 | TotalHeight := TotalHeight + LineHeight;
|
---|
240 | end;
|
---|
241 |
|
---|
242 | X := (CanvasSize.X - TotalWidth) div 2;
|
---|
243 | Y := (CanvasSize.Y - TotalHeight) div 2;
|
---|
244 |
|
---|
245 | // Menu items
|
---|
246 | Font.Style := [fsBold];
|
---|
247 | Brush.Style := bsSolid;
|
---|
248 | for I := 0 to Items.Count - 1 do begin
|
---|
249 | Font.Size := Items[I].FontSize;
|
---|
250 | Font.Color := Items[I].FontColor;
|
---|
251 | Items[I].Paint(Canvas, Point(X, Y));
|
---|
252 | LineHeight := Round(TextHeight('I') * 1.1);
|
---|
253 | Inc(Y, LineHeight);
|
---|
254 | end;
|
---|
255 | end;
|
---|
256 | end;
|
---|
257 |
|
---|
258 | constructor TMenu.Create;
|
---|
259 | begin
|
---|
260 | Items := TMenuItems.Create;
|
---|
261 | end;
|
---|
262 |
|
---|
263 | destructor TMenu.Destroy;
|
---|
264 | begin
|
---|
265 | FreeAndNil(Items);
|
---|
266 | inherited;
|
---|
267 | end;
|
---|
268 |
|
---|
269 | { TMenuItems }
|
---|
270 |
|
---|
271 | function TMenuItems.AddButton(Text: string; OnClick: TNotifyEvent
|
---|
272 | ): TMenuItemButton;
|
---|
273 | begin
|
---|
274 | Result := TMenuItemButton.Create;
|
---|
275 | Result.Text := Text;
|
---|
276 | Result.OnClick := OnClick;
|
---|
277 | Add(Result);
|
---|
278 | end;
|
---|
279 |
|
---|
280 | function TMenuItems.AddCheckBox(Text: string; OnChanged: TNotifyEvent): TMenuItemCheckBox;
|
---|
281 | begin
|
---|
282 | Result := TMenuItemCheckBox.Create;
|
---|
283 | Result.Text := Text;
|
---|
284 | Result.OnChanged := OnChanged;
|
---|
285 | Add(Result);
|
---|
286 | end;
|
---|
287 |
|
---|
288 | function TMenuItems.AddComboBox(Text: string; States: array of string
|
---|
289 | ; OnChanged: TNotifyEvent): TMenuItemComboBox;
|
---|
290 | var
|
---|
291 | I: Integer;
|
---|
292 | begin
|
---|
293 | Result := TMenuItemComboBox.Create;
|
---|
294 | Result.Text := Text;
|
---|
295 | Result.OnChanged := OnChanged;
|
---|
296 | for I := 0 to Length(States) - 1 do
|
---|
297 | Result.States.Add(States[I]);
|
---|
298 | Add(Result);
|
---|
299 | end;
|
---|
300 |
|
---|
301 |
|
---|
302 | end.
|
---|
303 |
|
---|