source: trunk/Forms/FormMain.pas

Last change on this file was 337, checked in by chronos, 3 months ago
  • Added: Game systems action in Tools menu.
  • Modified: TurnStats moved to separate unit.
File size: 9.6 KB
Line 
1unit FormMain;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
7 Game, LCLType, Menus, ActnList, ComCtrls, DateUtils, XMLConf, DOM, FormClient,
8 FormKeyShortcuts, FormPlayersStats, FormUnitMoves, FormCharts, FormEx;
9
10const
11 ZoomFactor = 1.5;
12 MouseMinDiff = 0.1;
13
14type
15
16 { TFormMain }
17
18 TFormMain = class(TFormEx)
19 AUnitShapeVisible: TAction;
20 AMapGridVisible: TAction;
21 AStatusBarVisible: TAction;
22 AToolBarVisible: TAction;
23 AToolBarBigIcons: TAction;
24 ActionList1: TActionList;
25 MainMenu1: TMainMenu;
26 MenuItem1: TMenuItem;
27 MenuItem10: TMenuItem;
28 MenuItem11: TMenuItem;
29 MenuItem12: TMenuItem;
30 MenuItem13: TMenuItem;
31 MenuItem14: TMenuItem;
32 MenuItem15: TMenuItem;
33 MenuItem16: TMenuItem;
34 MenuItem17: TMenuItem;
35 MenuItem18: TMenuItem;
36 MenuItem19: TMenuItem;
37 MenuItem2: TMenuItem;
38 MenuItem20: TMenuItem;
39 MenuItem21: TMenuItem;
40 MenuItem22: TMenuItem;
41 MenuItem23: TMenuItem;
42 MenuItem24: TMenuItem;
43 MenuItem25: TMenuItem;
44 MenuItem26: TMenuItem;
45 MenuItem27: TMenuItem;
46 MenuItem28: TMenuItem;
47 MenuItem29: TMenuItem;
48 MenuItem30: TMenuItem;
49 MenuItem32: TMenuItem;
50 MenuItem33: TMenuItem;
51 MenuItem34: TMenuItem;
52 MenuItem35: TMenuItem;
53 MenuItem36: TMenuItem;
54 MenuItem37: TMenuItem;
55 MenuItemDebug: TMenuItem;
56 MenuItem31: TMenuItem;
57 MenuItem4: TMenuItem;
58 MenuItemLoadRecent: TMenuItem;
59 MenuItem3: TMenuItem;
60 MenuItem5: TMenuItem;
61 MenuItem6: TMenuItem;
62 MenuItem7: TMenuItem;
63 MenuItem8: TMenuItem;
64 MenuItem9: TMenuItem;
65 PanelMain: TPanel;
66 PopupMenuToolbar: TPopupMenu;
67 Separator1: TMenuItem;
68 Timer1: TTimer;
69 ToolBar1: TToolBar;
70 ToolButton1: TToolButton;
71 ToolButton11: TToolButton;
72 ToolButton12: TToolButton;
73 ToolButton13: TToolButton;
74 ToolButton2: TToolButton;
75 ToolButton3: TToolButton;
76 ToolButton4: TToolButton;
77 ToolButton5: TToolButton;
78 ToolButton9: TToolButton;
79 procedure AMapGridVisibleExecute(Sender: TObject);
80 procedure AStatusBarVisibleExecute(Sender: TObject);
81 procedure AToolBarBigIconsExecute(Sender: TObject);
82 procedure AToolBarVisibleExecute(Sender: TObject);
83 procedure AUnitShapeVisibleExecute(Sender: TObject);
84 procedure FormActivate(Sender: TObject);
85 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
86 procedure FormResize(Sender: TObject);
87 procedure FormShow(Sender: TObject);
88 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
89 procedure FormCreate(Sender: TObject);
90 procedure FormDestroy(Sender: TObject);
91 procedure EraseBackground(DC: HDC); override;
92 procedure Timer1Timer(Sender: TObject);
93 private
94 FormActivated: Boolean;
95 FormShown: Boolean;
96 procedure ApplicationStart(Ptr: IntPtr);
97 procedure UpdateClientForms;
98 public
99 FormClient: TFormClient;
100 FormKeyShortcuts: TFormKeyShortcuts;
101 FormPlayersStats: TFormPlayersStats;
102 FormUnitMoves: TFormUnitMoves;
103 FormCharts: TFormCharts;
104 procedure LoadConfig(Config: TXmlConfig; Path: string);
105 procedure SaveConfig(Config: TXmlConfig; Path: string);
106 procedure ReloadView;
107 procedure ToggleFullscreen;
108 end;
109
110
111implementation
112
113uses
114 Core;
115
116resourcestring
117 STurn = 'turn';
118
119{$R *.lfm}
120
121{ TFormMain }
122
123procedure TFormMain.EraseBackground(DC: HDC);
124begin
125 // Do nothing, all background space covered by controls
126end;
127
128procedure TFormMain.Timer1Timer(Sender: TObject);
129var
130 NewCaption: string;
131begin
132 NewCaption := 'xTactics';
133 if Assigned(Core.Core.Game.CurrentPlayer) then
134 NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' +
135 IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
136 Caption := NewCaption;
137end;
138
139procedure TFormMain.LoadConfig(Config: TXmlConfig; Path: string);
140begin
141 with Config do begin
142 AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
143 AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
144 AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
145 end;
146end;
147
148procedure TFormMain.SaveConfig(Config: TXmlConfig; Path: string);
149begin
150 with Config do begin
151 SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
152 SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
153 SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
154 end;
155end;
156
157procedure TFormMain.ReloadView;
158begin
159 if AToolBarBigIcons.Checked then begin
160 ToolBar1.Images := Core.Core.ImageListLarge;
161 ToolBar1.ButtonWidth := Core.Core.ImageListLarge.Width + 7;
162 ToolBar1.ButtonHeight := Core.Core.ImageListLarge.Height + 6;
163 ToolBar1.Width := Core.Core.ImageListLarge.Width + 10;
164 ToolBar1.Height := Core.Core.ImageListLarge.Height + 10;
165 end else begin
166 ToolBar1.Images := Core.Core.ImageListSmall;
167 ToolBar1.ButtonWidth := Core.Core.ImageListSmall.Width + 7;
168 ToolBar1.ButtonHeight := Core.Core.ImageListSmall.Height + 6;
169 ToolBar1.Width := Core.Core.ImageListSmall.Width + 10;
170 ToolBar1.Height := Core.Core.ImageListSmall.Height + 10;
171 end;
172 ToolBar1.Visible := AToolBarVisible.Checked;
173end;
174
175procedure TFormMain.ToggleFullscreen;
176begin
177 FullScreen := not FullScreen;
178 TFormEx.PersistentForm.Form := Self;
179 TFormEx.PersistentForm.SetFullScreen(FullScreen);
180end;
181
182procedure TFormMain.FormCreate(Sender: TObject);
183begin
184 FormClient := TFormClient.Create(nil);
185 FormClient.ManualDock(PanelMain, nil, alClient);
186 FormClient.Align := alClient;
187 {$IFDEF DEBUG}
188 MenuItemDebug.Visible := True;
189 MenuItemDebug.Enabled := True;
190 {$ELSE}
191 MenuItemDebug.Visible := False;
192 MenuItemDebug.Enabled := False;
193 {$ENDIF}
194end;
195
196procedure TFormMain.AStatusBarVisibleExecute(Sender: TObject);
197begin
198 AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
199 UpdateClientForms;
200end;
201
202procedure TFormMain.AMapGridVisibleExecute(Sender: TObject);
203begin
204 AMapGridVisible.Checked := not AMapGridVisible.Checked;
205 UpdateClientForms;
206end;
207
208procedure TFormMain.AToolBarBigIconsExecute(Sender: TObject);
209begin
210 AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
211 ReloadView;
212 UpdateClientForms;
213end;
214
215procedure TFormMain.AToolBarVisibleExecute(Sender: TObject);
216begin
217 AToolBarVisible.Checked := not AToolBarVisible.Checked;
218 ReloadView;
219 UpdateClientForms;
220end;
221
222procedure TFormMain.AUnitShapeVisibleExecute(Sender: TObject);
223begin
224 AUnitShapeVisible.Checked := not AUnitShapeVisible.Checked;
225 UpdateClientForms;
226end;
227
228procedure TFormMain.FormActivate(Sender: TObject);
229begin
230 if not FormActivated then begin
231 FormActivated := True;
232 end;
233end;
234
235procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
236 );
237begin
238 // Pass KeyUp event to docked form
239 FormClient.FormKeyUp(Sender, Key, Shift);
240end;
241
242procedure TFormMain.FormResize(Sender: TObject);
243begin
244 {$IFDEF WINDOWS}
245 // TODO: Workaround for smaller docked client form drawing area than expected
246 FormClient.Hide;
247 FormClient.Show;
248 {$ENDIF}
249end;
250
251procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
252begin
253 Core.Core.Game.Running := False;
254 FormClient.Close;
255 SaveConfig(Core.Core.XMLConfig1, 'FormMain');
256 Core.Core.CellGridVisible := AMapGridVisible.Checked;
257 Core.Core.UnitShapeVisible := AUnitShapeVisible.Checked;
258 Core.Core.Done;
259 Application.Terminate;
260end;
261
262procedure TFormMain.FormDestroy(Sender: TObject);
263begin
264 if Assigned(FormPlayersStats) then FreeAndNil(FormPlayersStats);
265 if Assigned(FormUnitMoves) then FreeAndNil(FormUnitMoves);
266 if Assigned(FormCharts) then FreeAndNil(FormCharts);
267 if Assigned(FormKeyShortcuts) then FreeAndNil(FormKeyShortcuts);
268 FreeAndNil(FormClient);
269end;
270
271procedure TFormMain.ApplicationStart(Ptr: IntPtr);
272begin
273 Core.Core.ReopenGameOnInit;
274end;
275
276procedure TFormMain.UpdateClientForms;
277var
278 I: Integer;
279begin
280 FormClient.AToolBarBigIcons.Checked := AToolBarBigIcons.Checked;
281 FormClient.AToolBarBigIcons.Update;
282 FormClient.AToolBarVisible.Checked := AToolBarVisible.Checked;
283 FormClient.AToolBarVisible.Update;
284 FormClient.AStatusBarVisible.Checked := AStatusBarVisible.Checked;
285 FormClient.AStatusBarVisible.Update;
286 Core.Core.CellGridVisible := AMapGridVisible.Checked;
287 Core.Core.UnitShapeVisible := AUnitShapeVisible.Checked;
288 if Assigned(FormClient.Client) then begin
289 FormClient.Client.CellGridVisible := Core.Core.CellGridVisible;
290 FormClient.Client.UnitShapeVisible := Core.Core.UnitShapeVisible;
291 end;
292 FormClient.Redraw;
293 for I := 0 to Core.Core.FormClients.Count - 1 do begin
294 Core.Core.FormClients[I].AToolBarBigIcons.Checked := AToolBarBigIcons.Checked;
295 Core.Core.FormClients[I].AToolBarBigIcons.Update;
296 Core.Core.FormClients[I].AToolBarVisible.Checked := AToolBarVisible.Checked;
297 Core.Core.FormClients[I].AToolBarVisible.Update;
298 Core.Core.FormClients[I].AStatusBarVisible.Checked := AStatusBarVisible.Checked;
299 Core.Core.FormClients[I].AStatusBarVisible.Update;
300 if Assigned(Core.Core.FormClients[I].Client) then begin
301 Core.Core.FormClients[I].Client.CellGridVisible := Core.Core.CellGridVisible;
302 Core.Core.FormClients[I].Client.UnitShapeVisible := Core.Core.UnitShapeVisible;
303 end;
304 Core.Core.FormClients[I].Redraw;
305 end;
306end;
307
308procedure TFormMain.FormShow(Sender: TObject);
309begin
310 if not FormShown then begin
311 AMapGridVisible.Checked := Core.Core.CellGridVisible;
312 AUnitShapeVisible.Checked := Core.Core.UnitShapeVisible;
313 Core.Core.ScaleDPI;
314 FullScreen := Core.Core.PersistentForm1.FormFullScreen;
315 Core.Core.Init;
316 LoadConfig(Core.Core.XMLConfig1, 'FormMain');
317 ReloadView;
318 FormClient.Show;
319 UpdateClientForms;
320 Application.QueueAsyncCall(ApplicationStart, 0);
321 FormShown := True;
322 end;
323end;
324
325end.
326
Note: See TracBrowser for help on using the repository browser.