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