source: trunk/Forms/FormMain.pas

Last change on this file was 414, checked in by chronos, 10 months ago
  • Modified: Lowered idle CPU consumption.
File size: 9.7 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 PopupMenuOpenRecent: TPopupMenu;
67 PopupMenuToolbar: TPopupMenu;
68 Separator1: TMenuItem;
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 ToolButton6: TToolButton;
79 ToolButton7: TToolButton;
80 ToolButton8: TToolButton;
81 ToolButton9: TToolButton;
82 procedure AMapGridVisibleExecute(Sender: TObject);
83 procedure AStatusBarVisibleExecute(Sender: TObject);
84 procedure AToolBarBigIconsExecute(Sender: TObject);
85 procedure AToolBarVisibleExecute(Sender: TObject);
86 procedure AUnitShapeVisibleExecute(Sender: TObject);
87 procedure FormActivate(Sender: TObject);
88 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
89 procedure FormResize(Sender: TObject);
90 procedure FormShow(Sender: TObject);
91 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
92 procedure FormCreate(Sender: TObject);
93 procedure FormDestroy(Sender: TObject);
94 procedure EraseBackground(DC: HDC); override;
95 private
96 FormActivated: Boolean;
97 FormShown: Boolean;
98 procedure ApplicationStart(Ptr: IntPtr);
99 procedure UpdateClientForms;
100 public
101 FormClient: TFormClient;
102 FormKeyShortcuts: TFormKeyShortcuts;
103 FormPlayersStats: TFormPlayersStats;
104 FormUnitMoves: TFormUnitMoves;
105 FormCharts: TFormCharts;
106 procedure UpdateInterface;
107 procedure LoadConfig(Config: TXmlConfig; Path: string);
108 procedure SaveConfig(Config: TXmlConfig; Path: string);
109 procedure ReloadView;
110 procedure ToggleFullscreen;
111 end;
112
113
114implementation
115
116uses
117 Core;
118
119resourcestring
120 STurn = 'turn';
121
122{$R *.lfm}
123
124{ TFormMain }
125
126procedure TFormMain.EraseBackground(DC: HDC);
127begin
128 // Do nothing, all background space covered by controls
129end;
130
131procedure TFormMain.LoadConfig(Config: TXmlConfig; Path: string);
132begin
133 with Config do begin
134 AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
135 AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
136 AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
137 end;
138end;
139
140procedure TFormMain.SaveConfig(Config: TXmlConfig; Path: string);
141begin
142 with Config do begin
143 SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
144 SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
145 SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
146 end;
147end;
148
149procedure TFormMain.ReloadView;
150begin
151 if AToolBarBigIcons.Checked then begin
152 ToolBar1.Images := Core.Core.ImageListLarge;
153 ToolBar1.ButtonWidth := Core.Core.ImageListLarge.Width + 7;
154 ToolBar1.ButtonHeight := Core.Core.ImageListLarge.Height + 6;
155 ToolBar1.Width := Core.Core.ImageListLarge.Width + 10;
156 ToolBar1.Height := Core.Core.ImageListLarge.Height + 10;
157 end else begin
158 ToolBar1.Images := Core.Core.ImageListSmall;
159 ToolBar1.ButtonWidth := Core.Core.ImageListSmall.Width + 7;
160 ToolBar1.ButtonHeight := Core.Core.ImageListSmall.Height + 6;
161 ToolBar1.Width := Core.Core.ImageListSmall.Width + 10;
162 ToolBar1.Height := Core.Core.ImageListSmall.Height + 10;
163 end;
164 ToolBar1.Visible := AToolBarVisible.Checked;
165end;
166
167procedure TFormMain.ToggleFullscreen;
168begin
169 FullScreen := not FullScreen;
170 TFormEx.PersistentForm.Form := Self;
171 TFormEx.PersistentForm.SetFullScreen(FullScreen);
172end;
173
174procedure TFormMain.FormCreate(Sender: TObject);
175begin
176 FormClient := TFormClient.Create(nil);
177 FormClient.ManualDock(PanelMain, nil, alClient);
178 FormClient.Align := alClient;
179 {$IFDEF DEBUG}
180 MenuItemDebug.Visible := True;
181 MenuItemDebug.Enabled := True;
182 {$ELSE}
183 MenuItemDebug.Visible := False;
184 MenuItemDebug.Enabled := False;
185 {$ENDIF}
186end;
187
188procedure TFormMain.AStatusBarVisibleExecute(Sender: TObject);
189begin
190 AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
191 UpdateClientForms;
192end;
193
194procedure TFormMain.AMapGridVisibleExecute(Sender: TObject);
195begin
196 AMapGridVisible.Checked := not AMapGridVisible.Checked;
197 UpdateClientForms;
198end;
199
200procedure TFormMain.AToolBarBigIconsExecute(Sender: TObject);
201begin
202 AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
203 ReloadView;
204 UpdateClientForms;
205end;
206
207procedure TFormMain.AToolBarVisibleExecute(Sender: TObject);
208begin
209 AToolBarVisible.Checked := not AToolBarVisible.Checked;
210 ReloadView;
211 UpdateClientForms;
212end;
213
214procedure TFormMain.AUnitShapeVisibleExecute(Sender: TObject);
215begin
216 AUnitShapeVisible.Checked := not AUnitShapeVisible.Checked;
217 UpdateClientForms;
218end;
219
220procedure TFormMain.FormActivate(Sender: TObject);
221begin
222 if not FormActivated then begin
223 FormActivated := True;
224 end;
225end;
226
227procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
228 );
229begin
230 // Pass KeyUp event to docked form
231 FormClient.FormKeyUp(Sender, Key, Shift);
232end;
233
234procedure TFormMain.FormResize(Sender: TObject);
235begin
236 {$IFDEF WINDOWS}
237 // TODO: Workaround for smaller docked client form drawing area than expected
238 FormClient.Hide;
239 FormClient.Show;
240 {$ENDIF}
241end;
242
243procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
244begin
245 Core.Core.AutoSave;
246 Core.Core.Game.Running := False;
247 FormClient.Close;
248 SaveConfig(Core.Core.XMLConfig1, 'FormMain');
249 Core.Core.CellGridVisible := AMapGridVisible.Checked;
250 Core.Core.UnitShapeVisible := AUnitShapeVisible.Checked;
251 Core.Core.Done;
252 Application.Terminate;
253end;
254
255procedure TFormMain.FormDestroy(Sender: TObject);
256begin
257 if Assigned(FormPlayersStats) then FreeAndNil(FormPlayersStats);
258 if Assigned(FormUnitMoves) then FreeAndNil(FormUnitMoves);
259 if Assigned(FormCharts) then FreeAndNil(FormCharts);
260 if Assigned(FormKeyShortcuts) then FreeAndNil(FormKeyShortcuts);
261 FreeAndNil(FormClient);
262end;
263
264procedure TFormMain.ApplicationStart(Ptr: IntPtr);
265begin
266 Core.Core.ReopenGameOnInit;
267end;
268
269procedure TFormMain.UpdateClientForms;
270var
271 I: Integer;
272begin
273 FormClient.AToolBarBigIcons.Checked := AToolBarBigIcons.Checked;
274 FormClient.AToolBarBigIcons.Update;
275 FormClient.AToolBarVisible.Checked := AToolBarVisible.Checked;
276 FormClient.AToolBarVisible.Update;
277 FormClient.AStatusBarVisible.Checked := AStatusBarVisible.Checked;
278 FormClient.AStatusBarVisible.Update;
279 Core.Core.CellGridVisible := AMapGridVisible.Checked;
280 Core.Core.UnitShapeVisible := AUnitShapeVisible.Checked;
281 if Assigned(FormClient.Client) then begin
282 FormClient.Client.CellGridVisible := Core.Core.CellGridVisible;
283 FormClient.Client.UnitShapeVisible := Core.Core.UnitShapeVisible;
284 end;
285 FormClient.Redraw;
286 for I := 0 to Core.Core.FormClients.Count - 1 do begin
287 Core.Core.FormClients[I].AToolBarBigIcons.Checked := AToolBarBigIcons.Checked;
288 Core.Core.FormClients[I].AToolBarBigIcons.Update;
289 Core.Core.FormClients[I].AToolBarVisible.Checked := AToolBarVisible.Checked;
290 Core.Core.FormClients[I].AToolBarVisible.Update;
291 Core.Core.FormClients[I].AStatusBarVisible.Checked := AStatusBarVisible.Checked;
292 Core.Core.FormClients[I].AStatusBarVisible.Update;
293 if Assigned(Core.Core.FormClients[I].Client) then begin
294 Core.Core.FormClients[I].Client.CellGridVisible := Core.Core.CellGridVisible;
295 Core.Core.FormClients[I].Client.UnitShapeVisible := Core.Core.UnitShapeVisible;
296 end;
297 Core.Core.FormClients[I].Redraw;
298 end;
299end;
300
301procedure TFormMain.UpdateInterface;
302var
303 NewCaption: string;
304begin
305 NewCaption := 'xTactics';
306 if Assigned(Core.Core.Game.CurrentPlayer) then
307 NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' +
308 IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
309 Caption := NewCaption;
310end;
311
312procedure TFormMain.FormShow(Sender: TObject);
313begin
314 if not FormShown then begin
315 AMapGridVisible.Checked := Core.Core.CellGridVisible;
316 AUnitShapeVisible.Checked := Core.Core.UnitShapeVisible;
317 Core.Core.ScaleDPI;
318 FullScreen := Core.Core.PersistentForm1.FormFullScreen;
319 Core.Core.Init;
320 LoadConfig(Core.Core.XMLConfig1, 'FormMain');
321 ReloadView;
322 FormClient.Show;
323 UpdateClientForms;
324 Application.QueueAsyncCall(ApplicationStart, 0);
325 FormShown := True;
326 end;
327end;
328
329end.
330
Note: See TracBrowser for help on using the repository browser.