Changeset 5

Timestamp:

Feb 9, 2014, 5:30:12 PM (11 years ago)

Author:

chronos

Message:

• Added: Zoom view using mouse wheel.

Location:

trunk

Files:

• UFormMain.lfm (modified) (1 diff)
• UFormMain.pas (modified) (3 diffs)
• UGame.pas (modified) (8 diffs)

trunk/UFormMain.lfm

@@ -22 +22 @@
     OnMouseUp = PaintBox1MouseUp
     OnMouseLeave = PaintBox1MouseLeave
+    OnMouseWheelDown = PaintBox1MouseWheelDown
+    OnMouseWheelUp = PaintBox1MouseWheelUp
     OnPaint = PaintBox1Paint
   end

trunk/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
-  UGame, LCLType, Menus, ActnList;
+  UGame, LCLType, Menus, ActnList, types;
+
+const
+  ZoomFactor = 1.5;
 
 type
@@ -39 +42 @@
     procedure PaintBox1MouseUp(Sender: TObject; Button: TMouseButton;
       Shift: TShiftState; X, Y: Integer);
+    procedure PaintBox1MouseWheelDown(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
+    procedure PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+      MousePos: TPoint; var Handled: Boolean);
     procedure PaintBox1Paint(Sender: TObject);
     procedure EraseBackground(DC: HDC); override;
@@ -125 +132 @@
 end;
 
+procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
+  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+  with TPlayer(Game.Players[0]) do
+    ViewZoom := ViewZoom / ZoomFactor;
+  PaintBox1.Repaint;
+end;
+
+procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  with TPlayer(Game.Players[0]) do
+    ViewZoom := ViewZoom * ZoomFactor;
+  PaintBox1.Repaint;
+end;
+
 end.
 

trunk/UGame.pas

@@ -30 +30 @@
 
   TMap = class
-    CellSize: TPoint;
+    DefaultCellSize: TPoint;
     Cells: array of array of TCell;
-    procedure Paint(Canvas: TCanvas; Rect: TRect);
+    procedure Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
     constructor Create;
     destructor Destroy; override;
@@ -45 +45 @@
     View: TRect;
     Color: TColor;
+    ViewZoom: Double;
     procedure Paint(PaintBox: TPaintBox);
+    constructor Create;
   end;
 
@@ -81 +83 @@
   View := Bounds(View.Left, View.Top, PaintBox.Width,
     PaintBox.Height);
-  Game.Map.Paint(PaintBox.Canvas, View);
+  Game.Map.Paint(PaintBox.Canvas, View, ViewZoom);
+end;
+
+constructor TPlayer.Create;
+begin
+  ViewZoom := 1;
 end;
 
@@ -135 +142 @@
 { TMap }
 
-procedure TMap.Paint(Canvas: TCanvas; Rect: TRect);
+procedure TMap.Paint(Canvas: TCanvas; Rect: TRect; Zoom: Double);
 var
   CX, CY: Integer;
@@ -141 +148 @@
   HexShift: TFloatPoint;
   HexSize: TFloatPoint;
+  CellSize: TFloatPoint;
 
 procedure PaintHexagon(X, Y: Double; Text: string);
@@ -166 +174 @@
   *)
     Font.Color := clWhite;
+    Font.Size := Trunc(12 * Zoom);
     TextOut(Round(X) - TextWidth(Text) div 2, Round(Y) - TextHeight(Text) div 2, Text);
   end;
@@ -171 +180 @@
 
 begin
+  CellSize := FloatPoint(DefaultCellSize.X / 1.15 * Zoom, DefaultCellSize.Y / 1.35 * Zoom);
   HexShift := FloatPoint(0.5 * cos(30 / 180 * Pi),
     0.5 * sin(30 / 180 * Pi));
-  HexSize := FloatPoint(CellSize.X * 1.15, CellSize.Y * 1.35);
+  HexSize := FloatPoint(DefaultCellSize.X * Zoom, DefaultCellSize.Y * Zoom);
   with Canvas do try
     Lock;
@@ -198 +208 @@
 constructor TMap.Create;
 begin
-  CellSize := Point(62, 62);
+  DefaultCellSize := Point(62, 62);
 end;
 
 destructor TMap.Destroy;
 begin
-  Init(0, 0);
+  Init(Point(0, 0));
   inherited Destroy;
 end;