source: trunk/Forms/FormClient.pas

Last change on this file was 414, checked in by chronos, 10 months ago
  • Modified: Lowered idle CPU consumption.
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, View;
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 TempView: TView;
78 StartMousePoint: TPoint;
79 StartViewPoint: TPoint;
80 MoveActive: Boolean;
81 RedrawPending: Boolean;
82 Drawing: Boolean;
83 DrawDuration: TDateTime;
84 LastTimerTime: TDateTime;
85 TimerPeriod: TDateTime;
86 TurnActive: Boolean;
87 procedure SetClient(AValue: TClientGUI);
88 procedure DoClientChange(Sender: TObject);
89 procedure DoGameEnd(Sender: TObject);
90 procedure DoNextPlayer(Sender: TObject);
91 procedure DoTurnStart(Sender: TObject);
92 procedure DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
93 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
94 procedure SetToolbarHints;
95 procedure DoClientDestroy(Sender: TObject);
96 public
97 procedure LoadConfig(Config: TXmlConfig; Path: string);
98 procedure SaveConfig(Config: TXmlConfig; Path: string);
99 procedure UpdateInterface;
100 procedure Redraw;
101 property Client: TClientGUI read FClient write SetClient;
102 end;
103
104 TFormClients = class(TObjectList<TFormClient>)
105 end;
106
107const
108 MapBackgroundColor = $404040;
109
110
111implementation
112
113uses
114 Core, FormMove;
115
116resourcestring
117 STurn = 'turn';
118 SSurrender = 'Surrender';
119 SSurrenderQuestion = 'Do you want to surrender current game?';
120
121{$R *.lfm}
122
123{ TFormClient }
124
125procedure TFormClient.SetToolbarHints;
126var
127 I: Integer;
128begin
129 for I := 0 to ToolBar1.ButtonCount - 1 do begin
130 ToolBar1.Buttons[I].ShowHint := True;
131 ToolBar1.Buttons[I].Hint := ToolBar1.Buttons[I].Caption;
132 end;
133end;
134
135procedure TFormClient.DoClientDestroy(Sender: TObject);
136begin
137 Client := nil;
138end;
139
140procedure TFormClient.DoMove(CellFrom, CellTo: TPlayerCell; var CountOnce,
141 CountRepeat: Integer; Update: Boolean; var Confirm: Boolean);
142var
143 I: Integer;
144 FormMove: TFormMove;
145begin
146 FormMove := TFormMove.Create(nil);
147 try
148 // Set controls value maximum before value itself as the controls update their values mutually
149 if Update then FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower + CountOnce
150 else FormMove.SpinEditOnce.MaxValue := CellFrom.GetAvialPower;
151 FormMove.TrackBarOnce.Max := FormMove.SpinEditOnce.MaxValue;
152 FormMove.SpinEditOnce.Value := CountOnce;
153 FormMove.TrackBarOnce.Position := FormMove.SpinEditOnce.Value;
154 FormMove.SpinEditRepeat.MaxValue := Client.Game.Map.MaxPower;
155 FormMove.TrackBarRepeat.Max := FormMove.SpinEditRepeat.MaxValue;
156 FormMove.SpinEditRepeat.Value := CountRepeat;
157 FormMove.TrackBarRepeat.Position := FormMove.SpinEditRepeat.Value;
158
159 FormMove.AllowChangeOnce := Client.Game.GameSystem.UnitsSplitMerge;
160
161 if Assigned(CellTo.MapCell.OneUnit) then
162 FormMove.DefendCount := CellTo.MapCell.OneUnit.Power
163 else FormMove.DefendCount := 0;
164 // Attack count from other surrounding cells without current move if already exists
165 FormMove.AttackCount := 0;
166 for I := 0 to CellTo.MovesTo.Count - 1 do
167 if TUnitMove(CellTo.MovesTo[I]).CellFrom <> CellFrom then
168 FormMove.AttackCount := FormMove.AttackCount + TUnitMove(CellTo.MovesTo[I]).CountOnce;
169 FormMove.ShowWinProbability := CellTo.MapCell.Player <> CellFrom.MapCell.Player;
170
171 FormMove.Game := Client.Game;
172 if FormMove.ShowModal = mrOk then begin
173 CountOnce := FormMove.SpinEditOnce.Value;
174 CountRepeat := FormMove.SpinEditRepeat.Value;
175 Confirm := True;
176 end else Confirm := False;
177 finally
178 FormMove.Free;
179 end;
180end;
181
182procedure TFormClient.PaintBox1Paint(Sender: TObject);
183var
184 DrawStart: TDateTime;
185 R: TRect;
186 StartP: TPoint;
187 CountP: TPoint;
188 X, Y: Integer;
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.Game := Game;
208 //R := View.CellToCanvasRect(TRect.Create(Game.Map.Cells.First.PosPx,
209 // Game.Map.Cells.Last.PosPx));
210 R := View.CellToCanvasRect(Game.Map.PixelRect);
211 StartP := TPoint.Create(Ceil(R.P1.X / R.Size.X) * R.Size.X,
212 Ceil(R.P1.Y / R.Size.Y) * R.Size.Y);
213 CountP := TPoint.Create(Ceil(View.DestRect.Size.X / R.Size.X),
214 Ceil(View.DestRect.Size.X / R.Size.Y));
215 for Y := 0 to CountP.Y do begin
216 for X := 0 to CountP.X do begin
217 TempView.Assign(View);
218 TempView.DestRect := TRect.Create(
219 TPoint.Create(
220 -StartP.X + R.Size.X * X,
221 -StartP.Y + R.Size.Y * Y
222 ),
223 TPoint.Create(
224 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
225 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
226 )
227 );
228 Client.DrawCellLinks(PaintBox1.Canvas, TempView);
229 end;
230 end;
231 for Y := 0 to CountP.Y do begin
232 for X := 0 to CountP.X do begin
233 TempView.Assign(View);
234 TempView.DestRect := TRect.Create(
235 TPoint.Create(
236 -StartP.X + R.Size.X * X,
237 -StartP.Y + R.Size.Y * Y
238 ),
239 TPoint.Create(
240 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
241 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
242 )
243 );
244 Client.DrawCells(PaintBox1.Canvas, TempView);
245 end;
246 end;
247 for Y := 0 to CountP.Y do begin
248 for X := 0 to CountP.X do begin
249 TempView.Assign(View);
250 TempView.DestRect := TRect.Create(
251 TPoint.Create(
252 -StartP.X + R.Size.X * X,
253 -StartP.Y + R.Size.Y * Y
254 ),
255 TPoint.Create(
256 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
257 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
258 )
259 );
260 Client.DrawCities(PaintBox1.Canvas, TempView);
261 end;
262 end;
263 for Y := 0 to CountP.Y do begin
264 for X := 0 to CountP.X do begin
265 TempView.Assign(View);
266 TempView.DestRect := TRect.Create(
267 TPoint.Create(
268 -StartP.X + R.Size.X * X,
269 -StartP.Y + R.Size.Y * Y
270 ),
271 TPoint.Create(
272 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
273 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
274 )
275 );
276 Client.DrawSelection(PaintBox1.Canvas, TempView);
277 end;
278 end;
279 for Y := 0 to CountP.Y do begin
280 for X := 0 to CountP.X do begin
281 TempView.Assign(View);
282 TempView.DestRect := TRect.Create(
283 TPoint.Create(
284 -StartP.X + R.Size.X * X,
285 -StartP.Y + R.Size.Y * Y
286 ),
287 TPoint.Create(
288 -StartP.X + R.Size.X * X + View.DestRect.Size.X,
289 -StartP.Y + R.Size.Y * Y + View.DestRect.Size.Y
290 )
291 );
292 Client.DrawArrows(PaintBox1.Canvas, TempView);
293 end;
294 end;
295 end else begin
296 Client.Paint(PaintBox1.Canvas, View);
297 end;
298 end;
299 end;
300 DrawDuration := (9 * DrawDuration + (Now - DrawStart)) / 10;
301end;
302
303procedure TFormClient.EraseBackground(DC: HDC);
304begin
305 // Do nothing, all background space covered by controls
306end;
307
308procedure TFormClient.PaintBox1Resize(Sender: TObject);
309begin
310 if Assigned(Client) then
311 with Client do
312 View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
313 Redraw;
314end;
315
316procedure TFormClient.Timer1Timer(Sender: TObject);
317var
318 NewCaption: string;
319begin
320 if RedrawPending and not Drawing then begin
321 Drawing := True;
322 RedrawPending := False;
323 Timer1.Enabled := False;
324 TimerPeriod := (9 * TimerPeriod + (Now - LastTimerTime)) / 10;
325 LastTimerTime := Now;
326 PaintBox1.Repaint;
327 StatusBar1.Panels[1].Text := IntToStr(Trunc(DrawDuration / OneMillisecond)) + ' / ' +
328 IntToStr(Trunc(TimerPeriod / OneMillisecond)) + ' ms' +
329 ' ' + IntToStr(Core.Core.Game.Map.CellLinks.Count);
330 NewCaption := 'xTactics';
331 if Assigned(Core.Core.Game.CurrentPlayer) then
332 NewCaption := Core.Core.Game.CurrentPlayer.Name + ' - ' + STurn + ' ' + IntToStr(Core.Core.Game.TurnCounter) + ' - ' + NewCaption;
333 Caption := NewCaption;
334 Drawing := False;
335 end;
336end;
337
338procedure TFormClient.SetClient(AValue: TClientGUI);
339begin
340 if FClient = AValue then Exit;
341 if Assigned(FClient) then FClient.Form := nil;
342 FClient := AValue;
343 if Assigned(FClient) then begin
344 FClient.Form := Self;
345 FClient.OnChange := DoClientChange;
346 FClient.OnMove := DoMove;
347 FClient.OnTurnStart := DoTurnStart;
348 FClient.OnDestroy := DoClientDestroy;
349 FClient.OnGameEnd := DoGameEnd;
350 FClient.OnNextPlayer := DoNextPlayer;
351 FClient.View.DestRect := TRect.CreateBounds(TPoint.Create(0, 0), TPoint.Create(PaintBox1.Width, PaintBox1.Height));
352 FClient.CellGridVisible := Core.Core.CellGridVisible;
353 FClient.UnitShapeVisible := Core.Core.UnitShapeVisible;
354 end;
355 Redraw;
356end;
357
358procedure TFormClient.DoClientChange(Sender: TObject);
359begin
360 Redraw;
361 Core.Core.FormMain.UpdateInterface;
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;
425 Timer1.Enabled := True;
426end;
427
428procedure TFormClient.FormCreate(Sender: TObject);
429begin
430 {$IFDEF UNIX}
431 //PaintBox1.ControlStyle := PaintBox1.ControlStyle + [csOpaque];
432 {$ENDIF}
433 //DoubleBuffered := True;
434 TempBitmap := TBitmap.Create;
435 TempView := TView.Create;
436 TimerPeriod := 0;
437 LastTimerTime := Now;
438end;
439
440procedure TFormClient.AZoomAllExecute(Sender: TObject);
441begin
442 with Core.Core, Game, Client, View do begin
443 ZoomAll;
444 end;
445 Redraw;
446end;
447
448procedure TFormClient.AToolBarBigIconsExecute(Sender: TObject);
449begin
450 AToolBarBigIcons.Checked := not AToolBarBigIcons.Checked;
451end;
452
453procedure TFormClient.AToolBarBigIconsUpdate(Sender: TObject);
454begin
455 UpdateInterface;
456end;
457
458procedure TFormClient.AStatusBarVisibleExecute(Sender: TObject);
459begin
460 AStatusBarVisible.Checked := not AStatusBarVisible.Checked;
461 UpdateInterface;
462end;
463
464procedure TFormClient.AStatusBarVisibleUpdate(Sender: TObject);
465begin
466 UpdateInterface;
467end;
468
469procedure TFormClient.ASurrenderExecute(Sender: TObject);
470begin
471 if MessageDlg(SSurrender, SSurrenderQuestion, mtConfirmation, mbYesNo, 0) =
472 mrYes then begin
473 Client.Protocol.Surrender;
474 UpdateInterface;
475 end;
476end;
477
478procedure TFormClient.AGameEndTurnExecute(Sender: TObject);
479begin
480 TurnActive := False;
481 Client.Protocol.TurnEnd;
482 UpdateInterface;
483end;
484
485procedure TFormClient.AToolBarVisibleExecute(Sender: TObject);
486begin
487 AToolBarVisible.Checked := not AToolBarVisible.Checked;
488 UpdateInterface;
489end;
490
491procedure TFormClient.AToolBarVisibleUpdate(Sender: TObject);
492begin
493 UpdateInterface;
494end;
495
496procedure TFormClient.AZoomInExecute(Sender: TObject);
497begin
498 with Client do begin
499 if View.Zoom * ZoomFactor < MaxZoom then
500 View.Zoom := View.Zoom * ZoomFactor;
501 end;
502 Redraw;
503end;
504
505procedure TFormClient.AZoomOutExecute(Sender: TObject);
506begin
507 with Client do begin
508 if View.Zoom / ZoomFactor > MinZoom then
509 View.Zoom := View.Zoom / ZoomFactor;
510 end;
511 Redraw;
512end;
513
514procedure TFormClient.FormClose(Sender: TObject; var CloseAction: TCloseAction);
515begin
516 SaveConfig(Core.Core.XMLConfig1, 'FormClient');
517end;
518
519procedure TFormClient.FormDestroy(Sender: TObject);
520begin
521 Client := nil;
522 FreeAndNil(TempBitmap);
523 FreeAndNil(TempView);
524end;
525
526procedure TFormClient.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState
527 );
528const
529 ControlKey = 17;
530 EscapeKey = 27;
531begin
532 if (Key = EscapeKey) or (Key = ControlKey) then
533 if Assigned(Core.Core.Game.CurrentPlayer) then begin
534 Client.View.SelectedCell := nil;
535 Redraw;
536 end;
537end;
538
539procedure TFormClient.FormShow(Sender: TObject);
540begin
541 SetToolbarHints;
542 LoadConfig(Core.Core.XMLConfig1, 'FormClient');
543 UpdateInterface;
544 Redraw;
545end;
546
547procedure TFormClient.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton;
548 Shift: TShiftState; X, Y: Integer);
549begin
550 if Button = mbLeft then begin
551 if Assigned(Client) then begin
552 StartMousePoint := TPoint.Create(X, Y);
553 StartViewPoint := Client.View.SourceRect.P1;
554 MoveActive := True;
555 end;
556 end;
557end;
558
559procedure TFormClient.PaintBox1MouseLeave(Sender: TObject);
560begin
561 MoveActive := False;
562end;
563
564procedure TFormClient.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; X,
565 Y: Integer);
566var
567 Cell: TPlayerCell;
568 OldCell: TPlayerCell;
569 CellPos: TPoint;
570 P: TPoint;
571 R: TRect;
572begin
573 if Assigned(Client) then begin
574 P := TPoint.Create(X, Y);
575 if MoveActive then
576 if (Abs(StartMousePoint.X - X) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) or
577 (Abs(StartMousePoint.Y - Y) > Trunc(Screen.PixelsPerInch * MouseMinDiff)) then
578 with Client do begin
579 View.SourceRect := TRect.CreateBounds(TPoint.Create(
580 Trunc(StartViewPoint.X + (StartMousePoint.X - X) / View.Zoom),
581 Trunc(StartViewPoint.Y + (StartMousePoint.Y - Y) / View.Zoom)),
582 View.SourceRect.Size);
583 Redraw;
584 end;
585 Cell := nil;
586 OldCell := Client.View.FocusedCell;
587 with Core.Core.Game do
588 if Assigned(Client.ControlPlayer) then begin
589 if Map.Cyclic then begin
590 R := Client.View.CellToCanvasRect(Map.PixelRect);
591 CellPos := TPoint.Create(
592 ModNeg(P.X - R.P1.X, R.Size.X) + R.P1.X,
593 ModNeg(P.Y - R.P1.Y, R.Size.Y) + R.P1.Y
594 );
595 Cell := Client.ControlPlayer.PlayerMap.PosToCell(
596 Client.View.CanvasToCellPos(CellPos));
597 end else begin
598 Cell := Client.ControlPlayer.PlayerMap.PosToCell(
599 Client.View.CanvasToCellPos(P));
600 end;
601 end;
602 if Assigned(Cell) then begin
603 Client.View.FocusedCell := Cell;
604 StatusBar1.Panels[0].Text := '[' + IntToStr(Cell.MapCell.PosPx.X) + ', ' + IntToStr(Cell.MapCell.PosPx.Y) +
605 '] (' + IntToStr(Cell.MovesFrom.Count) + ', ' + IntToStr(Cell.MovesTo.Count) + ') ' + IntToStr(Cell.MapCell.Id);
606 end else begin
607 Client.View.FocusedCell := nil;
608 StatusBar1.Panels[0].Text := '';
609 end;
610 CellPos := Client.View.CanvasToCellPos(TPoint.Create(X, Y));
611 StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
612 if Cell <> OldCell then Redraw;
613 end else StatusBar1.Panels[0].Text := '';
614end;
615
616procedure TFormClient.PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
617 Shift: TShiftState; X, Y: Integer);
618begin
619 if (Abs(StartMousePoint.X - X) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) and
620 (Abs(StartMousePoint.Y - Y) < Trunc(Screen.PixelsPerInch * MouseMinDiff)) then begin
621 if Core.Core.Game.Running and (Core.Core.Game.CurrentPlayer.Mode = pmHuman) and
622 (Core.Core.Game.CurrentPlayer = Client.ControlPlayer) then begin
623 Client.View.SelectCell(TPoint.Create(X, Y), Client.ControlPlayer, Shift);
624 Redraw;
625 end;
626 end;
627 MoveActive := False;
628end;
629
630procedure TFormClient.PaintBox1MouseWheelDown(Sender: TObject;
631 Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
632begin
633 AZoomOut.Execute;
634end;
635
636procedure TFormClient.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
637 MousePos: TPoint; var Handled: Boolean);
638begin
639 AZoomIn.Execute;
640end;
641
642end.
643
Note: See TracBrowser for help on using the repository browser.