Changeset 5 for trunk/UFormMain.pas

Timestamp:

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

Author:

chronos

Message:

• Added: Zoom view using mouse wheel.

File:

• trunk/UFormMain.pas (modified) (3 diffs)

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.