1 | unit UFormMain;
|
---|
2 |
|
---|
3 | {$mode delphi}{$H+}
|
---|
4 |
|
---|
5 | interface
|
---|
6 |
|
---|
7 | uses
|
---|
8 | Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
|
---|
9 | UGame, LCLType, Menus, ActnList, ComCtrls, types, dateutils, XMLConf, DOM;
|
---|
10 |
|
---|
11 | const
|
---|
12 | ZoomFactor = 1.5;
|
---|
13 | MouseMinDiff = 0.1;
|
---|
14 |
|
---|
15 | type
|
---|
16 |
|
---|
17 | { TFormMain }
|
---|
18 |
|
---|
19 | TFormMain = class(TForm)
|
---|
20 | AStatusBarVisible: TAction;
|
---|
21 | AToolBarVisible: TAction;
|
---|
22 | AToolBarBigIcons: TAction;
|
---|
23 | AZoomIn: TAction;
|
---|
24 | AZoomAll: TAction;
|
---|
25 | AZoomOut: TAction;
|
---|
26 | ActionList1: TActionList;
|
---|
27 | MainMenu1: TMainMenu;
|
---|
28 | MenuItem1: TMenuItem;
|
---|
29 | MenuItem10: TMenuItem;
|
---|
30 | MenuItem11: TMenuItem;
|
---|
31 | MenuItem12: TMenuItem;
|
---|
32 | MenuItem13: TMenuItem;
|
---|
33 | MenuItem14: TMenuItem;
|
---|
34 | MenuItem15: TMenuItem;
|
---|
35 | MenuItem16: TMenuItem;
|
---|
36 | MenuItem17: TMenuItem;
|
---|
37 | MenuItem18: TMenuItem;
|
---|
38 | MenuItem19: TMenuItem;
|
---|
39 | MenuItem2: TMenuItem;
|
---|
40 | MenuItem20: TMenuItem;
|
---|
41 | MenuItem21: TMenuItem;
|
---|
42 | MenuItem22: TMenuItem;
|
---|
43 | MenuItem23: TMenuItem;
|
---|
44 | MenuItem24: TMenuItem;
|
---|
45 | MenuItem25: TMenuItem;
|
---|
46 | MenuItemLoadRecent: TMenuItem;
|
---|
47 | MenuItem3: TMenuItem;
|
---|
48 | MenuItem4: TMenuItem;
|
---|
49 | MenuItem5: TMenuItem;
|
---|
50 | MenuItem6: TMenuItem;
|
---|
51 | MenuItem7: TMenuItem;
|
---|
52 | MenuItem8: TMenuItem;
|
---|
53 | MenuItem9: TMenuItem;
|
---|
54 | PaintBox1: TPaintBox;
|
---|
55 | PopupMenuToolbar: TPopupMenu;
|
---|
56 | StatusBar1: TStatusBar;
|
---|
57 | Timer1: TTimer;
|
---|
58 | ToolBar1: TToolBar;
|
---|
59 | ToolButton1: TToolButton;
|
---|
60 | ToolButton10: TToolButton;
|
---|
61 | ToolButton11: TToolButton;
|
---|
62 | ToolButton12: TToolButton;
|
---|
63 | ToolButton13: TToolButton;
|
---|
64 | ToolButton2: TToolButton;
|
---|
65 | ToolButton3: TToolButton;
|
---|
66 | ToolButton4: TToolButton;
|
---|
67 | ToolButton5: TToolButton;
|
---|
68 | ToolButton6: TToolButton;
|
---|
69 | ToolButton7: TToolButton;
|
---|
70 | ToolButton8: TToolButton;
|
---|
71 | ToolButton9: TToolButton;
|
---|
72 | procedure AStatusBarVisibleExecute(Sender: TObject);
|
---|
73 | procedure AToolBarBigIconsExecute(Sender: TObject);
|
---|
74 | procedure AToolBarVisibleExecute(Sender: TObject);
|
---|
75 | procedure AZoomAllExecute(Sender: TObject);
|
---|
76 | procedure AZoomInExecute(Sender: TObject);
|
---|
77 | procedure AZoomOutExecute(Sender: TObject);
|
---|
78 | procedure FormShow(Sender: TObject);
|
---|
79 | procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
80 | procedure FormCreate(Sender: TObject);
|
---|
81 | procedure FormDestroy(Sender: TObject);
|
---|
82 | procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
|
---|
83 | procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
|
---|
84 | Shift: TShiftState; X, Y: Integer);
|
---|
85 | procedure PaintBox1MouseLeave(Sender: TObject);
|
---|
86 | procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
---|
87 | Y: Integer);
|
---|
88 | procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
|
---|
89 | Shift: TShiftState; X, Y: Integer);
|
---|
90 | procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
|
---|
91 | MousePos: TPoint; var Handled: Boolean);
|
---|
92 | procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
|
---|
93 | MousePos: TPoint; var Handled: Boolean);
|
---|
94 | procedure PaintBox1Paint(Sender: TObject);
|
---|
95 | procedure EraseBackground(DC: HDC); override;
|
---|
96 | procedure PaintBox1Resize(Sender: TObject);
|
---|
97 | procedure Timer1Timer(Sender: TObject);
|
---|
98 | private
|
---|
99 | TempBitmap: TBitmap;
|
---|
100 | StartMousePoint: TPoint;
|
---|
101 | StartViewPoint: TPoint;
|
---|
102 | MoveActive: Boolean;
|
---|
103 | RedrawPending: Boolean;
|
---|
104 | Drawing: Boolean;
|
---|
105 | DrawDuration: TDateTime;
|
---|
106 | LastTimerTime: TDateTime;
|
---|
107 | TimerPeriod: TDateTime;
|
---|
108 | public
|
---|
109 | procedure LoadConfig(Config: TXmlConfig; Path: string);
|
---|
110 | procedure SaveConfig(Config: TXmlConfig; Path: string);
|
---|
111 | procedure ReloadView;
|
---|
112 | procedure Redraw;
|
---|
113 | end;
|
---|
114 |
|
---|
115 | var
|
---|
116 | FormMain: TFormMain;
|
---|
117 |
|
---|
118 | implementation
|
---|
119 |
|
---|
120 | uses
|
---|
121 | UCore;
|
---|
122 |
|
---|
123 | resourcestring
|
---|
124 | STurn = 'turn';
|
---|
125 |
|
---|
126 | {$R *.lfm}
|
---|
127 |
|
---|
128 | { TFormMain }
|
---|
129 |
|
---|
130 | procedure TFormMain.PaintBox1Paint(Sender: TObject);
|
---|
131 | var
|
---|
132 | DrawStart: TDateTime;
|
---|
133 | const
|
---|
134 | BackgroundColor = $404040;
|
---|
135 | begin
|
---|
136 | DrawStart := Now;
|
---|
137 | if Assigned(Core.CurrentClient) then
|
---|
138 | with Core.CurrentClient do begin
|
---|
139 | View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
|
---|
140 | if csOpaque in PaintBox1.ControlStyle then begin
|
---|
141 | TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
|
---|
142 | TempBitmap.Canvas.Brush.Color := BackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
|
---|
143 | TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
|
---|
144 | if Assigned(ControlPlayer) then ControlPlayer.Paint(TempBitmap.Canvas, View)
|
---|
145 | else Core.Game.Map.Paint(TempBitmap.Canvas, View);
|
---|
146 | PaintBox1.Canvas.Draw(0, 0, TempBitmap);
|
---|
147 | end else begin
|
---|
148 | {$ifdef WINDOWS}
|
---|
149 | PaintBox1.Canvas.Brush.Color := BackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
|
---|
150 | PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
|
---|
151 | {$endif}
|
---|
152 | if Assigned(ControlPlayer) then ControlPlayer.Paint(PaintBox1.Canvas, View)
|
---|
153 | else Core.Game.Map.Paint(PaintBox1.Canvas, View);
|
---|
154 | end;
|
---|
155 | end;
|
---|
156 | DrawDuration := (9 * DrawDuration + (Now - DrawStart)) / 10;
|
---|
157 | end;
|
---|
158 |
|
---|
159 | procedure TFormMain.EraseBackground(DC: HDC);
|
---|
160 | begin
|
---|
161 | // Do nothing, all background space covered by controls
|
---|
162 | end;
|
---|
163 |
|
---|
164 | procedure TFormMain.PaintBox1Resize(Sender: TObject);
|
---|
165 | begin
|
---|
166 | if Assigned(Core.CurrentClient) then
|
---|
167 | with Core.CurrentClient do
|
---|
168 | View.DestRect := Bounds(0, 0, PaintBox1.Width, PaintBox1.Height);
|
---|
169 | Redraw;
|
---|
170 | end;
|
---|
171 |
|
---|
172 | procedure TFormMain.Timer1Timer(Sender: TObject);
|
---|
173 | var
|
---|
174 | NewCaption: string;
|
---|
175 | begin
|
---|
176 | if RedrawPending and not Drawing then begin
|
---|
177 | Drawing := True;
|
---|
178 | if not Core.DevelMode then RedrawPending := False;
|
---|
179 | TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
|
---|
180 | LastTimerTime := Now;
|
---|
181 | PaintBox1.Repaint;
|
---|
182 | StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
|
---|
183 | IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
|
---|
184 | ' ' + IntToStr(Core.Game.Map.CellLinks.Count);
|
---|
185 | NewCaption := 'xTactics';
|
---|
186 | if Assigned(Core.Game.CurrentPlayer) then
|
---|
187 | NewCaption := Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Game.TurnCounter) + ' - ' + NewCaption;
|
---|
188 | Caption := NewCaption;
|
---|
189 | Drawing := False;
|
---|
190 | end;
|
---|
191 | end;
|
---|
192 |
|
---|
193 | procedure TFormMain.LoadConfig(Config: TXmlConfig; Path: string);
|
---|
194 | begin
|
---|
195 | with Config do begin
|
---|
196 | AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
|
---|
197 | AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
|
---|
198 | AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
|
---|
199 | end;
|
---|
200 | end;
|
---|
201 |
|
---|
202 | procedure TFormMain.SaveConfig(Config: TXmlConfig; Path: string);
|
---|
203 | begin
|
---|
204 | with Config do begin
|
---|
205 | SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
|
---|
206 | SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
|
---|
207 | SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
|
---|
208 | end;
|
---|
209 | end;
|
---|
210 |
|
---|
211 | procedure TFormMain.ReloadView;
|
---|
212 | begin
|
---|
213 | if AToolBarBigIcons.Checked then begin
|
---|
214 | ToolBar1.Images := Core.ImageListLarge;
|
---|
215 | ToolBar1.ButtonWidth := Core.ImageListLarge.Width + 7;
|
---|
216 | ToolBar1.ButtonHeight := Core.ImageListLarge.Height + 6;
|
---|
217 | ToolBar1.Width := Core.ImageListLarge.Width + 10;
|
---|
218 | ToolBar1.Height := Core.ImageListLarge.Height + 10;
|
---|
219 | end else begin
|
---|
220 | ToolBar1.Images := Core.ImageListSmall;
|
---|
221 | ToolBar1.ButtonWidth := Core.ImageListSmall.Width + 7;
|
---|
222 | ToolBar1.ButtonHeight := Core.ImageListSmall.Height + 6;
|
---|
223 | ToolBar1.Width := Core.ImageListSmall.Width + 10;
|
---|
224 | ToolBar1.Height := Core.ImageListSmall.Height + 10;
|
---|
225 | end;
|
---|
226 | ToolBar1.Visible := AToolBarVisible.Checked;
|
---|
227 | StatusBar1.Visible := AStatusBarVisible.Checked;
|
---|
228 | end;
|
---|
229 |
|
---|
230 | procedure TFormMain.Redraw;
|
---|
231 | begin
|
---|
232 | RedrawPending := True;
|
---|
233 | end;
|
---|
234 |
|
---|
235 | procedure TFormMain.FormCreate(Sender: TObject);
|
---|
236 | begin
|
---|
237 | {$IFDEF Linux}
|
---|
238 | //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
|
---|
239 | {$ENDIF}
|
---|
240 | //DoubleBuffered := True;
|
---|
241 | TempBitmap := TBitmap.Create;
|
---|
242 | TimerPeriod := 0;
|
---|
243 | LastTimerTime := Now;
|
---|
244 | end;
|
---|
245 |
|
---|
246 | procedure TFormMain.AZoomAllExecute(Sender: TObject);
|
---|
247 | var
|
---|
248 | Factor: TFloatPoint;
|
---|
249 | MapRect: TRect;
|
---|
250 | NewZoom: Single;
|
---|
251 | begin
|
---|
252 | with Core, Game, CurrentClient, View do begin
|
---|
253 | MapRect := Map.CalculatePixelRect;
|
---|
254 | Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
|
---|
255 | (DestRect.Bottom - DestRect.Top) / (MapRect.Bottom - MapRect.Top));
|
---|
256 | if Factor.X < Factor.Y then NewZoom := Factor.X
|
---|
257 | else NewZoom := Factor.Y;
|
---|
258 | if NewZoom = 0 then NewZoom := 1;
|
---|
259 | Zoom := NewZoom;
|
---|
260 | CenterMap;
|
---|
261 | end;
|
---|
262 | Redraw;
|
---|
263 | end;
|
---|
264 |
|
---|
265 | procedure TFormMain.AToolBarBigIconsExecute(Sender: TObject);
|
---|
266 | begin
|
---|
267 | AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
|
---|
268 | ReloadView;
|
---|
269 | end;
|
---|
270 |
|
---|
271 | procedure TFormMain.AStatusBarVisibleExecute(Sender: TObject);
|
---|
272 | begin
|
---|
273 | AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
|
---|
274 | ReloadView;
|
---|
275 | end;
|
---|
276 |
|
---|
277 | procedure TFormMain.AToolBarVisibleExecute(Sender: TObject);
|
---|
278 | begin
|
---|
279 | AToolBarVisible.Checked := not AToolBarVisible.Checked;
|
---|
280 | ReloadView;
|
---|
281 | end;
|
---|
282 |
|
---|
283 | procedure TFormMain.AZoomInExecute(Sender: TObject);
|
---|
284 | begin
|
---|
285 | with Core.CurrentClient do begin
|
---|
286 | View.Zoom := View.Zoom * ZoomFactor;
|
---|
287 | end;
|
---|
288 | Redraw;
|
---|
289 | end;
|
---|
290 |
|
---|
291 | procedure TFormMain.AZoomOutExecute(Sender: TObject);
|
---|
292 | //var
|
---|
293 | // D: TPoint;
|
---|
294 | begin
|
---|
295 | with Core.CurrentClient do begin
|
---|
296 | //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
|
---|
297 | // Trunc(MousePos.Y - View.Top / ViewZoom));
|
---|
298 | View.Zoom := View.Zoom / ZoomFactor;
|
---|
299 | //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
|
---|
300 | // Trunc((D.Y - MousePos.Y) * ViewZoom),
|
---|
301 | // View.Right - View.Left,
|
---|
302 | // View.Bottom - View.Top);
|
---|
303 | end;
|
---|
304 | Redraw;
|
---|
305 | end;
|
---|
306 |
|
---|
307 | procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
|
---|
308 | begin
|
---|
309 | Core.Game.Running := False;
|
---|
310 | Core.PersistentForm.Save(Self);
|
---|
311 | SaveConfig(Core.XMLConfig1, 'FormMain');
|
---|
312 | Core.XMLConfig1.Flush;
|
---|
313 | end;
|
---|
314 |
|
---|
315 | procedure TFormMain.FormDestroy(Sender: TObject);
|
---|
316 | begin
|
---|
317 | TempBitmap.Free;
|
---|
318 | end;
|
---|
319 |
|
---|
320 | procedure TFormMain.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
|
---|
321 | );
|
---|
322 | begin
|
---|
323 | if (Key = 27) or (Key = 17) then
|
---|
324 | if Assigned(Core.Game.CurrentPlayer) then begin
|
---|
325 | Core.CurrentClient.View.SelectedCell := nil;
|
---|
326 | Redraw;
|
---|
327 | end;
|
---|
328 | end;
|
---|
329 |
|
---|
330 | procedure TFormMain.FormShow(Sender: TObject);
|
---|
331 | begin
|
---|
332 | Core.Init;
|
---|
333 | LoadConfig(Core.XMLConfig1, 'FormMain');
|
---|
334 | Core.PersistentForm.Load(Self, wsMaximized);
|
---|
335 | ReloadView;
|
---|
336 | Redraw;
|
---|
337 | end;
|
---|
338 |
|
---|
339 | procedure TFormMain.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
|
---|
340 | Shift: TShiftState; X, Y: Integer);
|
---|
341 | begin
|
---|
342 | if Button = mbLeft then begin
|
---|
343 | if Assigned(Core.CurrentClient) then begin
|
---|
344 | StartMousePoint := Point(X, Y);
|
---|
345 | StartViewPoint := Core.CurrentClient.View.SourceRect.TopLeft;
|
---|
346 | MoveActive := True;
|
---|
347 | end;
|
---|
348 | end;
|
---|
349 | end;
|
---|
350 |
|
---|
351 | procedure TFormMain.PaintBox1MouseLeave(Sender: TObject);
|
---|
352 | begin
|
---|
353 | MoveActive := False;
|
---|
354 | end;
|
---|
355 |
|
---|
356 | procedure TFormMain.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
|
---|
357 | Y: Integer);
|
---|
358 | var
|
---|
359 | Cell: TCell;
|
---|
360 | OldCell: TCell;
|
---|
361 | CellPos: TPoint;
|
---|
362 | begin
|
---|
363 | if Assigned(Core.CurrentClient) then begin
|
---|
364 | if MoveActive then
|
---|
365 | if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
|
---|
366 | (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
|
---|
367 | with Core.Game.CurrentPlayer, Core.CurrentClient do begin
|
---|
368 | View.SourceRect := Bounds(Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
|
---|
369 | Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom),
|
---|
370 | View.SourceRect.Right - View.SourceRect.Left,
|
---|
371 | View.SourceRect.Bottom - View.SourceRect.Top);
|
---|
372 | Redraw;
|
---|
373 | end;
|
---|
374 | Cell := nil;
|
---|
375 | OldCell := Core.CurrentClient.View.FocusedCell;
|
---|
376 | with Core.Game do
|
---|
377 | Cell := Map.PosToCell(Core.CurrentClient.View.CanvasToCellPos(Point(X, Y)), Core.CurrentClient.View );
|
---|
378 | if Assigned(Cell) then begin
|
---|
379 | Core.CurrentClient.View.FocusedCell := Cell;
|
---|
380 | StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.PosPx.X) + ', ' + IntToStr(Cell.PosPx.Y) +
|
---|
381 | '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ')';
|
---|
382 | end else begin
|
---|
383 | Core.CurrentClient.View.FocusedCell := nil;
|
---|
384 | StatusBar1.Panels[0].Text := '';
|
---|
385 | end;
|
---|
386 | CellPos := Core.CurrentClient.View.CanvasToCellPos(Point(X, Y));
|
---|
387 | StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
|
---|
388 | if Cell <> OldCell then Redraw;
|
---|
389 | end else StatusBar1.Panels[0].Text := '';
|
---|
390 | end;
|
---|
391 |
|
---|
392 | procedure TFormMain.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
|
---|
393 | Shift: TShiftState; X, Y: Integer);
|
---|
394 | begin
|
---|
395 | if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and
|
---|
396 | (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
|
---|
397 | if Core.Game.Running and (Core.Game.CurrentPlayer.Mode = pmHuman) then begin
|
---|
398 | Core.CurrentClient.View.SelectCell(Point(X, Y), Core.Game.CurrentPlayer, Shift);
|
---|
399 | Redraw;
|
---|
400 | end;
|
---|
401 | end;
|
---|
402 | MoveActive := False;
|
---|
403 | end;
|
---|
404 |
|
---|
405 | procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
|
---|
406 | Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
|
---|
407 | begin
|
---|
408 | AZoomOut.Execute;
|
---|
409 | end;
|
---|
410 |
|
---|
411 | procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
|
---|
412 | MousePos: TPoint; var Handled: Boolean);
|
---|
413 | begin
|
---|
414 | AZoomIn.Execute;
|
---|
415 | end;
|
---|
416 |
|
---|
417 | end.
|
---|
418 |
|
---|