close Warning: Can't synchronize with repository "(default)" (No changeset 184 in the repository). Look in the Trac log for more information.

source: trunk/Forms/UFormClient.pas

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