Changeset 35 for trunk/Forms/UFormMain.pas

Timestamp:

Mar 7, 2014, 11:03:30 PM (11 years ago)

Author:

chronos

Message:

• Added: Zoom all action to show entire map.
• Added: Actions Zoom in and Zoom out which keep view center.
• Fixed: Form resize now keep view center.
• Modified: Attacking is now using mutiple dice rolls system.

File:

• trunk/Forms/UFormMain.pas (modified) (7 diffs)

trunk/Forms/UFormMain.pas

@@ -17 +17 @@
 
   TFormMain = class(TForm)
+    AZoomIn: TAction;
+    AZoomAll: TAction;
+    AZoomOut: TAction;
+    ActionList1: TActionList;
     MainMenu1: TMainMenu;
     MenuItem1: TMenuItem;
+    MenuItem10: TMenuItem;
+    MenuItem11: TMenuItem;
+    MenuItem12: TMenuItem;
+    MenuItem13: TMenuItem;
     MenuItem2: TMenuItem;
     MenuItem3: TMenuItem;
@@ -36 +44 @@
     ToolButton4: TToolButton;
     ToolButton5: TToolButton;
+    procedure AZoomAllExecute(Sender: TObject);
+    procedure AZoomInExecute(Sender: TObject);
+    procedure AZoomOutExecute(Sender: TObject);
     procedure FormActivate(Sender: TObject);
     procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
@@ -136 +147 @@
 end;
 
+procedure TFormMain.AZoomAllExecute(Sender: TObject);
+var
+  Factor: TFloatPoint;
+  MapRect: TRect;
+begin
+  with Core.Game, CurrentPlayer, View do begin
+    MapRect := Map.GetPixelRect;
+    Factor := FloatPoint((DestRect.Right - DestRect.Left) / (MapRect.Right - MapRect.Left),
+      (DestRect.Bottom - DestRect.Top) / (MapRect.Bottom - MapRect.Top));
+    if Factor.X < Factor.Y then Zoom := Factor.X
+      else Zoom := Factor.Y;
+    CenterMap;
+  end;
+  Redraw;
+end;
+
+procedure TFormMain.AZoomInExecute(Sender: TObject);
+begin
+  with Core.Game.CurrentPlayer do begin
+    View.Zoom := View.Zoom * ZoomFactor;
+  end;
+  Redraw;
+end;
+
+procedure TFormMain.AZoomOutExecute(Sender: TObject);
+var
+  D: TPoint;
+begin
+  with Core.Game.CurrentPlayer do begin
+    //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
+    //  Trunc(MousePos.Y - View.Top / ViewZoom));
+    View.Zoom := View.Zoom / ZoomFactor;
+    //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
+    //  Trunc((D.Y - MousePos.Y) * ViewZoom),
+    //  View.Right - View.Left,
+    //  View.Bottom - View.Top);
+  end;
+  Redraw;
+end;
+
 procedure TFormMain.FormClose(Sender: TObject; var CloseAction: TCloseAction);
 begin
@@ -172 +223 @@
   Cell: TCell;
   OldCell: TCell;
+  CellPos: TPoint;
 begin
   if Assigned(Core.Game.CurrentPlayer) then begin
@@ -195 +247 @@
       StatusBar1.Panels[0].Text := '';
     end;
+    CellPos := Core.Game.CurrentPlayer.View.CanvasToCellPos(Point(X, Y));
+    StatusBar1.Panels[2].Text := 'CellPos: ' + IntToStr(CellPos.X) + ', ' + IntToStr(CellPos.Y);
     if Cell <> OldCell then Redraw;
   end else StatusBar1.Panels[0].Text := '';
@@ -213 +267 @@
 procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
   Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
-var
-  D: TPoint;
-begin
-  with Core.Game.CurrentPlayer do begin
-    //D := Point(Trunc(MousePos.X - View.Left / ViewZoom),
-    //  Trunc(MousePos.Y - View.Top / ViewZoom));
-    View.Zoom := View.Zoom / ZoomFactor;
-    //View := Bounds(Trunc((D.X - MousePos.X) * ViewZoom),
-    //  Trunc((D.Y - MousePos.Y) * ViewZoom),
-    //  View.Right - View.Left,
-    //  View.Bottom - View.Top);
-  end;
-  Redraw;
+begin
+  AZoomOut.Execute;
 end;
 
@@ -231 +274 @@
   MousePos: TPoint; var Handled: Boolean);
 begin
-  with Core.Game.CurrentPlayer do
-    View.Zoom := View.Zoom * ZoomFactor;
-  Redraw;
+  AZoomIn.Execute;
 end;