Changeset 35 for trunk/Forms

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.

Location:

trunk/Forms

Files:

• UFormMain.lfm (modified) (2 diffs)
• UFormMain.lrt (modified) (1 diff)
• UFormMain.pas (modified) (7 diffs)

trunk/Forms/UFormMain.lfm

@@ -108 +108 @@
       end
     end
+    object MenuItem10: TMenuItem
+      Caption = 'View'
+      object MenuItem11: TMenuItem
+        Action = AZoomAll
+      end
+      object MenuItem12: TMenuItem
+        Action = AZoomIn
+      end
+      object MenuItem13: TMenuItem
+        Action = AZoomOut
+      end
+    end
     object MenuItem8: TMenuItem
       Caption = 'Tools'
@@ -121 +133 @@
     top = 263
   end
+  object ActionList1: TActionList
+    Images = Core.ImageListSmall
+    left = 280
+    top = 152
+    object AZoomIn: TAction
+      Caption = 'Zoom in'
+      OnExecute = AZoomInExecute
+      ShortCut = 16491
+    end
+    object AZoomOut: TAction
+      Caption = 'Zoom out'
+      OnExecute = AZoomOutExecute
+      ShortCut = 16493
+    end
+    object AZoomAll: TAction
+      Caption = 'Zoom all'
+      OnExecute = AZoomAllExecute
+      ShortCut = 16449
+    end
+  end
 end

trunk/Forms/UFormMain.lrt

@@ -2 +2 @@
 TFORMMAIN.MENUITEM1.CAPTION=Game
 TFORMMAIN.MENUITEM5.CAPTION=-
+TFORMMAIN.MENUITEM10.CAPTION=View
 TFORMMAIN.MENUITEM8.CAPTION=Tools
+TFORMMAIN.AZOOMIN.CAPTION=Zoom in
+TFORMMAIN.AZOOMOUT.CAPTION=Zoom out
+TFORMMAIN.AZOOMALL.CAPTION=Zoom all

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;