source: trunk/Forms/FormClient.pas

Last change on this file was 333, checked in by chronos, 4 months ago
  • Fixed: Store client form settings on close.
File size: 20.2 KB
Line 
1unit FormClient;
2
3interface
4
5uses
6 Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
7 Game, LCLType, Menus, ActnList, ComCtrls, dateutils, XMLConf, DOM, Math,
8 Geometry, GameClient, GameProtocol, Threading, Player, ClientGUI, FormEx,
9 Generics.Collections;
10
11const
12 ZoomFactor = 1.5;
13 MinZoom = 0.1;
14 MaxZoom = 10;
15 MouseMinDiff = 0.1;
16
17type
18
19 { TFormClient }
20
21 TFormClient = class(TFormEx)
22 ASurrender: TAction;
23 AGameEndTurn: TAction;
24 AStatusBarVisible: TAction;
25 AToolBarVisible: TAction;
26 AToolBarBigIcons: TAction;
27 AZoomIn: TAction;
28 AZoomAll: TAction;
29 AZoomOut: TAction;
30 ActionList1: TActionList;
31 MenuItem18: TMenuItem;
32 PaintBox1: TPaintBox;
33 PopupMenuToolbar: TPopupMenu;
34 StatusBar1: TStatusBar;
35 Timer1: TTimer;
36 ToolBar1: TToolBar;
37 ToolButton1: TToolButton;
38 ToolButton2: TToolButton;
39 ToolButton6: TToolButton;
40 ToolButton7: TToolButton;
41 ToolButton8: TToolButton;
42 ToolButton9: TToolButton;
43 procedure AGameEndTurnExecute(Sender: TObject);
44 procedure AStatusBarVisibleExecute(Sender: TObject);
45 procedure AStatusBarVisibleUpdate(Sender: TObject);
46 procedure ASurrenderExecute(Sender: TObject);
47 procedure AToolBarBigIconsExecute(Sender: TObject);
48 procedure AToolBarBigIconsUpdate(Sender: TObject);
49 procedure AToolBarVisibleExecute(Sender: TObject);
50 procedure AToolBarVisibleUpdate(Sender: TObject);
51 procedure AZoomAllExecute(Sender: TObject);
52 procedure AZoomInExecute(Sender: TObject);
53 procedure AZoomOutExecute(Sender: TObject);
54 procedure FormShow(Sender: TObject);
55 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
56 procedure FormCreate(Sender: TObject);
57 procedure FormDestroy(Sender: TObject);
58 procedure FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
59 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
60 Shift: TShiftState; X, Y: Integer);
61 procedure PaintBox1MouseLeave(Sender: TObject);
62 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
63 Y: Integer);
64 procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
65 Shift: TShiftState; X, Y: Integer);
66 procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
67 MousePos: TPoint; var Handled: Boolean);
68 procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
69 MousePos: TPoint; var Handled: Boolean);
70 procedure PaintBox1Paint(Sender: TObject);
71 procedure EraseBackground(DC: HDC); override;
72 procedure PaintBox1Resize(Sender: TObject);
73 procedure Timer1Timer(Sender: TObject);
74 private
75 FClient: TClientGUI;
76 TempBitmap: TBitmap;
77 StartMousePoint: TPoint;
78 StartViewPoint: TPoint;
79 MoveActive: Boolean;
80 RedrawPending: Boolean;
81 Drawing: Boolean;
82 DrawDuration: TDateTime;
83 LastTimerTime: TDateTime;
84 TimerPeriod: TDateTime;
85 TurnActive: Boolean;
86 procedure SetClient(AValue: TClientGUI);
87 procedure DoClientChange(Sender: TObject);
88 procedure DoGameEnd(Sender: TObject);
89 procedure DoNextPlayer(Sender: TObject);
90 procedure DoTurnStart(Sender: TObject);
91 procedure DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
92 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
93 procedure SetToolbarHints;
94 procedure DoClientDestroy(Sender: TObject);
95 public
96 procedure LoadConfig(Config: TXmlConfig; Path: string);
97 procedure SaveConfig(Config: TXmlConfig; Path: string);
98 procedure UpdateInterface;
99 procedure Redraw;
100 property Client: TClientGUI read FClient write SetClient;
101 end;
102
103 TFormClients = class(TObjectList<TFormClient>)
104 end;
105
106const
107 MapBackgroundColor = $404040;
108
109
110implementation
111
112uses
113 Core, FormMove;
114
115resourcestring
116 STurn = 'turn';
117 SSurrender = 'Surrender';
118 SSurrenderQuestion = 'Do you want to surrender current game?';
119
120{$R *.lfm}
121
122{ TFormClient }
123
124procedure TFormClient.SetToolbarHints;
125var
126 I: Integer;
127begin
128 for I := 0 to ToolBar1.ButtonCount - 1 do begin
129 ToolBar1.Buttons[I].ShowHint := True;
130 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
131 end;
132end;
133
134procedure TFormClient.DoClientDestroy(Sender: TObject);
135begin
136 Client := nil;
137end;
138
139procedure TFormClient.DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
140 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
141var
142 I: Integer;
143 FormMove: TFormMove;
144begin
145 FormMove := TFormMove.Create(nil);
146 try
147 // Set controls value maximum before value itself as the controls update their values mutually
148 if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
149 else FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower;
150 FormMove.TrackBarOnce.Max := FormMove.SpinEditOnce.MaxValue;
151 FormMove.SpinEditOnce.Value := CountOnce;
152 FormMove.TrackBarOnce.Position := FormMove.SpinEditOnce.Value;
153 FormMove.SpinEditRepeat.MaxValue := Client.Game.Map.MaxPower;
154 FormMove.TrackBarRepeat.Max := FormMove.SpinEditRepeat.MaxValue;
155 FormMove.SpinEditRepeat.Value := CountRepeat;
156 FormMove.TrackBarRepeat.Position := FormMove.SpinEditRepeat.Value;
157
158 FormMove.AllowChangeOnce := Client.Game.GameSystem.UnitsSplitMerge;
159
160 if Assigned(CellTo.MapCell.OneUnit) then
161 FormMove.DefendCount := CellTo.MapCell.OneUnit.Power
162 else FormMove.DefendCount := 0;
163 // Attack count from other surrounding cells without current move if already exists
164 FormMove.AttackCount := 0;
165 for I := 0 to CellTo.MovesTo.Count - 1 do
166 if TUnitMove(CellTo.MovesTo[I]).CellFrom <> CellFrom then
167 FormMove.AttackCount := FormMove.AttackCount + TUnitMove(CellTo.MovesTo[I]).CountOnce;
168 FormMove.ShowWinProbability := CellTo.MapCell.Player <> CellFrom.MapCell.Player;
169
170 FormMove.Game := Client.Game;
171 if FormMove.ShowModal = mrOk then begin
172 CountOnce := FormMove.SpinEditOnce.Value;
173 CountRepeat := FormMove.SpinEditRepeat.Value;
174 Confirm := True;
175 end else Confirm := False;
176 finally
177 FormMove.Free;
178 end;
179end;
180
181procedure TFormClient.PaintBox1Paint(Sender: TObject);
182var
183 DrawStart: TDateTime;
184 R: TRect;
185 StartP: TPoint;
186 CountP: TPoint;
187 X, Y: Integer;
188 TempView: TView;
189begin
190 DrawStart := Now;
191 if Assigned(Client) then
192 with Client do begin
193 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
194 if csOpaque in PaintBox1.ControlStyle then begin
195 TempBitmap.SetSize(PaintBox1.Width, PaintBox1.Height);
196 TempBitmap.Canvas.Brush.Color := MapBackGroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
197 TempBitmap.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
198 Client.Paint(TempBitmap.Canvas, View);
199 PaintBox1.Canvas.Draw(0, 0, TempBitmap);
200 end else begin
201 {$ifdef WINDOWS}
202 PaintBox1.Canvas.Brush.Color := MapBackgroundColor; //clBackground; //PaintBox1.GetColorResolvingParent;
203 PaintBox1.Canvas.FillRect(0, 0, PaintBox1.Width, PaintBox1.Height);
204 {$endif}
205
206 if Game.CyclicMap then begin
207 TempView := TView.Create;
208 TempView.Game := Game;
209 //R := View.CellToCanvasRect(TRect.Create(Game.Map.Cells.First.PosPx,
210 // Game.Map.Cells.Last.PosPx));
211 R := View.CellToCanvasRect(Game.Map.PixelRect);
212 StartP := TPoint.Create(Ceil(R.P1.X / R.Size.X) * R.Size.X,
213 Ceil(R.P1.Y / R.Size.Y) * R.Size.Y);
214 CountP := TPoint.Create(Ceil(View.DestRect.Size.X / R.Size.X),
215 Ceil(View.DestRect.Size.X / R.Size.Y));
216 for Y := 0 to CountP.Y do begin
217 for X := 0 to CountP.X do begin
218 TempView.Assign(View);
219 TempView.DestRect := TRect.Create(
220 TPoint.Create(
221 -StartP.X + R.Size.X * X,
222 -StartP.Y + R.Size.Y * Y
223 ),
224 TPoint.Create(
225 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
226 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
227 )
228 );
229 Client.DrawCellLinks(PaintBox1.Canvas, TempView);
230 end;
231 end;
232 for Y := 0 to CountP.Y do begin
233 for X := 0 to CountP.X do begin
234 TempView.Assign(View);
235 TempView.DestRect := TRect.Create(
236 TPoint.Create(
237 -StartP.X + R.Size.X * X,
238 -StartP.Y + R.Size.Y * Y
239 ),
240 TPoint.Create(
241 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
242 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
243 )
244 );
245 Client.DrawCells(PaintBox1.Canvas, TempView);
246 end;
247 end;
248 for Y := 0 to CountP.Y do begin
249 for X := 0 to CountP.X do begin
250 TempView.Assign(View);
251 TempView.DestRect := TRect.Create(
252 TPoint.Create(
253 -StartP.X + R.Size.X * X,
254 -StartP.Y + R.Size.Y * Y
255 ),
256 TPoint.Create(
257 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
258 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
259 )
260 );
261 Client.DrawCities(PaintBox1.Canvas, TempView);
262 end;
263 end;
264 for Y := 0 to CountP.Y do begin
265 for X := 0 to CountP.X do begin
266 TempView.Assign(View);
267 TempView.DestRect := TRect.Create(
268 TPoint.Create(
269 -StartP.X + R.Size.X * X,
270 -StartP.Y + R.Size.Y * Y
271 ),
272 TPoint.Create(
273 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
274 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
275 )
276 );
277 Client.DrawSelection(PaintBox1.Canvas, TempView);
278 end;
279 end;
280 TempView.Free;
281 for Y := 0 to CountP.Y do begin
282 for X := 0 to CountP.X do begin
283 TempView.Assign(View);
284 TempView.DestRect := TRect.Create(
285 TPoint.Create(
286 -StartP.X + R.Size.X * X,
287 -StartP.Y + R.Size.Y * Y
288 ),
289 TPoint.Create(
290 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
291 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
292 )
293 );
294 Client.DrawArrows(PaintBox1.Canvas, TempView);
295 end;
296 end;
297 end else begin
298 Client.Paint(PaintBox1.Canvas, View);
299 end;
300 end;
301 end;
302 DrawDuration := (9 * DrawDuration + (Now - DrawStart)) / 10;
303end;
304
305procedure TFormClient.EraseBackground(DC: HDC);
306begin
307 // Do nothing, all background space covered by controls
308end;
309
310procedure TFormClient.PaintBox1Resize(Sender: TObject);
311begin
312 if Assigned(Client) then
313 with Client do
314 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
315 Redraw;
316end;
317
318procedure TFormClient.Timer1Timer(Sender: TObject);
319var
320 NewCaption: string;
321begin
322 if RedrawPending and not Drawing then begin
323 Drawing := True;
324 if not Core.Core.DevelMode then RedrawPending := False;
325 TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
326 LastTimerTime := Now;
327 PaintBox1.Repaint;
328 StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
329 IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
330 ' ' + IntToStr(Core.Core.Game.Map.CellLinks.Count);
331 NewCaption := 'xTactics';
332 if Assigned(Core.Core.Game.CurrentPlayer) then
333 NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
334 Caption := NewCaption;
335 Drawing := False;
336 end;
337end;
338
339procedure TFormClient.SetClient(AValue: TClientGUI);
340begin
341 if FClient = AValue then Exit;
342 if Assigned(FClient) then FClient.Form := nil;
343 FClient := AValue;
344 if Assigned(FClient) then begin
345 FClient.Form := Self;
346 FClient.OnChange := DoClientChange;
347 FClient.OnMove := DoMove;
348 FClient.OnTurnStart := DoTurnStart;
349 FClient.OnDestroy := DoClientDestroy;
350 FClient.OnGameEnd := DoGameEnd;
351 FClient.OnNextPlayer := DoNextPlayer;
352 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
353 FClient.CellGridVisible := Core.Core.CellGridVisible;
354 FClient.UnitShapeVisible := Core.Core.UnitShapeVisible;
355 end;
356 Redraw;
357end;
358
359procedure TFormClient.DoClientChange(Sender: TObject);
360begin
361 Redraw;
362end;
363
364procedure TFormClient.DoGameEnd(Sender: TObject);
365begin
366 Redraw;
367end;
368
369procedure TFormClient.DoNextPlayer(Sender: TObject);
370begin
371 Redraw;
372end;
373
374procedure TFormClient.DoTurnStart(Sender: TObject);
375begin
376 TurnActive := True;
377 UpdateInterface;
378 Redraw;
379end;
380
381procedure TFormClient.LoadConfig(Config: TXmlConfig; Path: string);
382begin
383 with Config do begin
384 AToolBarBigIcons.Checked := GetValue(DOMString(Path + '/LargeIcons'), False);
385 AToolBarVisible.Checked := GetValue(DOMString(Path + '/ToolBarVisible'), True);
386 AStatusBarVisible.Checked := GetValue(DOMString(Path + '/StatusBarVisible'), False);
387 end;
388end;
389
390procedure TFormClient.SaveConfig(Config: TXmlConfig; Path: string);
391begin
392 with Config do begin
393 SetValue(DOMString(Path + '/LargeIcons'), AToolBarBigIcons.Checked);
394 SetValue(DOMString(Path + '/ToolBarVisible'), AToolBarVisible.Checked);
395 SetValue(DOMString(Path + '/StatusBarVisible'), AStatusBarVisible.Checked);
396 end;
397end;
398
399procedure TFormClient.UpdateInterface;
400begin
401 if AToolBarBigIcons.Checked then begin
402 ToolBar1.Images := Core.Core.ImageListLarge;
403 ToolBar1.ButtonWidth := Core.Core.ImageListLarge.Width + 7;
404 ToolBar1.ButtonHeight := Core.Core.ImageListLarge.Height + 6;
405 ToolBar1.Width := Core.Core.ImageListLarge.Width + 10;
406 ToolBar1.Height := Core.Core.ImageListLarge.Height + 10;
407 end else begin
408 ToolBar1.Images := Core.Core.ImageListSmall;
409 ToolBar1.ButtonWidth := Core.Core.ImageListSmall.Width + 7;
410 ToolBar1.ButtonHeight := Core.Core.ImageListSmall.Height + 6;
411 ToolBar1.Width := Core.Core.ImageListSmall.Width + 10;
412 ToolBar1.Height := Core.Core.ImageListSmall.Height + 10;
413 end;
414 ToolBar1.Visible := AToolBarVisible.Checked;
415 StatusBar1.Visible := AStatusBarVisible.Checked;
416 AGameEndTurn.Enabled := Assigned(Client) and Assigned(Client.ControlPlayer) and
417 Client.ControlPlayer.IsAlive and TurnActive;
418 ASurrender.Enabled := Assigned(Client) and Assigned(Client.ControlPlayer) and
419 Client.ControlPlayer.IsAlive;
420end;
421
422procedure TFormClient.Redraw;
423begin
424 RedrawPending := True;
425end;
426
427procedure TFormClient.FormCreate(Sender: TObject);
428begin
429 {$IFDEF Linux}
430 //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
431 {$ENDIF}
432 //DoubleBuffered := True;
433 TempBitmap := TBitmap.Create;
434 TimerPeriod := 0;
435 LastTimerTime := Now;
436end;
437
438procedure TFormClient.AZoomAllExecute(Sender: TObject);
439begin
440 with Core.Core, Game, Client, View do begin
441 ZoomAll;
442 end;
443 Redraw;
444end;
445
446procedure TFormClient.AToolBarBigIconsExecute(Sender: TObject);
447begin
448 AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
449end;
450
451procedure TFormClient.AToolBarBigIconsUpdate(Sender: TObject);
452begin
453 UpdateInterface;
454end;
455
456procedure TFormClient.AStatusBarVisibleExecute(Sender: TObject);
457begin
458 AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
459 UpdateInterface;
460end;
461
462procedure TFormClient.AStatusBarVisibleUpdate(Sender: TObject);
463begin
464 UpdateInterface;
465end;
466
467procedure TFormClient.ASurrenderExecute(Sender: TObject);
468begin
469 if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) =
470 mrYes then begin
471 Client.Protocol.Surrender;
472 UpdateInterface;
473 end;
474end;
475
476procedure TFormClient.AGameEndTurnExecute(Sender: TObject);
477begin
478 TurnActive := False;
479 Client.Protocol.TurnEnd;
480 UpdateInterface;
481end;
482
483procedure TFormClient.AToolBarVisibleExecute(Sender: TObject);
484begin
485 AToolBarVisible.Checked := not AToolBarVisible.Checked;
486 UpdateInterface;
487end;
488
489procedure TFormClient.AToolBarVisibleUpdate(Sender: TObject);
490begin
491 UpdateInterface;
492end;
493
494procedure TFormClient.AZoomInExecute(Sender: TObject);
495begin
496 with Client do begin
497 if View.Zoom * ZoomFactor < MaxZoom then
498 View.Zoom := View.Zoom * ZoomFactor;
499 end;
500 Redraw;
501end;
502
503procedure TFormClient.AZoomOutExecute(Sender: TObject);
504begin
505 with Client do begin
506 if View.Zoom / ZoomFactor > MinZoom then
507 View.Zoom := View.Zoom / ZoomFactor;
508 end;
509 Redraw;
510end;
511
512procedure TFormClient.FormClose(Sender: TObject; var CloseAction: TCloseAction);
513begin
514 SaveConfig(Core.Core.XMLConfig1, 'FormClient');
515end;
516
517procedure TFormClient.FormDestroy(Sender: TObject);
518begin
519 Client := nil;
520 TempBitmap.Free;
521end;
522
523procedure TFormClient.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
524 );
525const
526 ControlKey = 17;
527 EscapeKey = 27;
528begin
529 if (Key = EscapeKey) or (Key = ControlKey) then
530 if Assigned(Core.Core.Game.CurrentPlayer) then begin
531 Client.View.SelectedCell := nil;
532 Redraw;
533 end;
534end;
535
536procedure TFormClient.FormShow(Sender: TObject);
537begin
538 SetToolbarHints;
539 LoadConfig(Core.Core.XMLConfig1, 'FormClient');
540 UpdateInterface;
541 Redraw;
542end;
543
544procedure TFormClient.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
545 Shift: TShiftState; X, Y: Integer);
546begin
547 if Button = mbLeft then begin
548 if Assigned(Client) then begin
549 StartMousePoint := TPoint.Create(X, Y);
550 StartViewPoint := Client.View.SourceRect.P1;
551 MoveActive := True;
552 end;
553 end;
554end;
555
556procedure TFormClient.PaintBox1MouseLeave(Sender: TObject);
557begin
558 MoveActive := False;
559end;
560
561procedure TFormClient.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
562 Y: Integer);
563var
564 Cell: TPlayerCell;
565 OldCell: TPlayerCell;
566 CellPos: TPoint;
567 P: TPoint;
568 R: TRect;
569begin
570 if Assigned(Client) then begin
571 P := TPoint.Create(X, Y);
572 if MoveActive then
573 if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
574 (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
575 with Client do begin
576 View.SourceRect := TRect.CreateBounds(TPoint.Create(
577 Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
578 Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom)),
579 View.SourceRect.Size);
580 Redraw;
581 end;
582 Cell := nil;
583 OldCell := Client.View.FocusedCell;
584 with Core.Core.Game do
585 if Assigned(Client.ControlPlayer) then begin
586 if Map.Cyclic then begin
587 R := Client.View.CellToCanvasRect(Map.PixelRect);
588 CellPos := TPoint.Create(
589 ModNeg(P.X - R.P1.X, R.Size.X) + R.P1.X,
590 ModNeg(P.Y - R.P1.Y, R.Size.Y) + R.P1.Y
591 );
592 Cell := Client.ControlPlayer.PlayerMap.PosToCell(
593 Client.View.CanvasToCellPos(CellPos));
594 end else begin
595 Cell := Client.ControlPlayer.PlayerMap.PosToCell(
596 Client.View.CanvasToCellPos(P));
597 end;
598 end;
599 if Assigned(Cell) then begin
600 Client.View.FocusedCell := Cell;
601 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.MapCell.PosPx.X) + ', ' + IntToStr(Cell.MapCell.PosPx.Y) +
602 '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ') ' + IntToStr(Cell.MapCell.Id);
603 end else begin
604 Client.View.FocusedCell := nil;
605 StatusBar1.Panels[0].Text := '';
606 end;
607 CellPos := Client.View.CanvasToCellPos(TPoint.Create(X, Y));
608 StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
609 if Cell <> OldCell then Redraw;
610 end else StatusBar1.Panels[0].Text := '';
611end;
612
613procedure TFormClient.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
614 Shift: TShiftState; X, Y: Integer);
615begin
616 if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and
617 (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
618 if Core.Core.Game.Running and (Core.Core.Game.CurrentPlayer.Mode = pmHuman) and
619 (Core.Core.Game.CurrentPlayer = Client.ControlPlayer) then begin
620 Client.View.SelectCell(TPoint.Create(X, Y), Client.ControlPlayer, Shift);
621 Redraw;
622 end;
623 end;
624 MoveActive := False;
625end;
626
627procedure TFormClient.PaintBox1MouseWheelDown(Sender: TObject;
628 Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
629begin
630 AZoomOut.Execute;
631end;
632
633procedure TFormClient.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
634 MousePos: TPoint; var Handled: Boolean);
635begin
636 AZoomIn.Execute;
637end;
638
639end.
640
Note: See TracBrowser for help on using the repository browser.