Changeset 30 for trunk/UFormMain.pas

Timestamp:

Apr 18, 2015, 6:17:34 PM (9 years ago)

Author:

chronos

Message:

• Added: Automatic zooming to all existed map stations. This solve problem if too many stations were existed and some of them appeared behind window border.
• Added: Much of used TCanvas functions are now available through TMetaCanvas.

File:

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

trunk/UFormMain.pas

@@ -7 +7 @@
 uses
   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, Menus,
-  ExtCtrls, UEngine, LCLType;
+  ExtCtrls, UEngine, LCLType, types;
 
 type
@@ -26 +26 @@
     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 PaintBox1Resize(Sender: TObject);
@@ -68 +72 @@
   Randomize;
   Engine.Map.Size := Point(PaintBox1.Width, PaintBox1.Height);
+  Engine.View.DestRect := Rect(0, 0, PaintBox1.Width, PaintBox1.Height);
   Engine.Reset;
 end;
@@ -87 +92 @@
 begin
   Engine.MouseUp(Button, Point(X, Y));
+end;
+
+procedure TFormMain.PaintBox1MouseWheelDown(Sender: TObject;
+  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
+begin
+  Engine.View.Zoom := Engine.View.Zoom * 1.2;
+end;
+
+procedure TFormMain.PaintBox1MouseWheelUp(Sender: TObject; Shift: TShiftState;
+  MousePos: TPoint; var Handled: Boolean);
+begin
+  Engine.View.Zoom := Engine.View.Zoom / 1.2;
 end;