LazMapViewer: Improved restricted panning along the edge of the allowed area.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9495 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/lazmapviewer/examples/restricted_zoom_pan/RestrictedZoomPan_Demo.lpi

@@ -44,6 +44,7 @@
         <Filename Value="main.pas"/>
         <IsPartOfProject Value="True"/>
         <ComponentName Value="Form1"/>
+        <HasResources Value="True"/>
         <ResourceBaseClass Value="Form"/>
       </Unit1>
     </Units>

components/lazmapviewer/examples/restricted_zoom_pan/RestrictedZoomPan_Demo.lpr

@@ -17,7 +17,7 @@ uses
 
 begin
   RequireDerivedFormResource := True;
-  Application.Scaled := True;
+  Application.Scaled:=True;
   Application.{%H-}MainFormOnTaskbar := True;
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);

components/lazmapviewer/examples/restricted_zoom_pan/main.lfm

@@ -10,11 +10,13 @@ object Form1: TForm1
   OnCreate = FormCreate
   object MapView1: TMapView
     Left = 0
-    Height = 538
-    Top = 42
+    Height = 511
+    Top = 69
     Width = 686
     Active = True
     Align = alClient
+    Cyclic = True
+    DebugTiles = True
     DownloadEngine = MapView1.BuiltInDLE
     DrawingEngine = MapView1.BuiltInDE
     Layers = <>
@@ -42,23 +44,60 @@ object Form1: TForm1
   end
   object Panel1: TPanel
     Left = 0
-    Height = 42
+    Height = 69
     Top = 0
     Width = 686
     Align = alTop
     AutoSize = True
     BevelOuter = bvNone
-    ClientHeight = 42
+    ClientHeight = 69
     ClientWidth = 686
     TabOrder = 2
     object Label1: TLabel
-      Left = 6
+      AnchorSideLeft.Control = rgCenter
+      AnchorSideLeft.Side = asrBottom
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      Left = 190
       Height = 30
-      Top = 6
-      Width = 674
-      Align = alTop
+      Top = 19
+      Width = 237
+      BorderSpacing.Left = 12
       BorderSpacing.Around = 6
       Caption = 'London cannot be moved out of the window'#13#10'Only zoom levels > 8 allowed.'
     end
+    object rgCenter: TRadioGroup
+      AnchorSideLeft.Control = Panel1
+      AnchorSideTop.Control = Panel1
+      AnchorSideTop.Side = asrCenter
+      AnchorSideRight.Side = asrBottom
+      Left = 12
+      Height = 45
+      Top = 12
+      Width = 160
+      AutoFill = True
+      AutoSize = True
+      BorderSpacing.Around = 12
+      Caption = 'Center'
+      ChildSizing.LeftRightSpacing = 12
+      ChildSizing.TopBottomSpacing = 3
+      ChildSizing.HorizontalSpacing = 12
+      ChildSizing.EnlargeHorizontal = crsHomogenousChildResize
+      ChildSizing.EnlargeVertical = crsHomogenousChildResize
+      ChildSizing.ShrinkHorizontal = crsScaleChilds
+      ChildSizing.ShrinkVertical = crsScaleChilds
+      ChildSizing.Layout = cclLeftToRightThenTopToBottom
+      ChildSizing.ControlsPerLine = 2
+      ClientHeight = 25
+      ClientWidth = 156
+      Columns = 2
+      ItemIndex = 0
+      Items.Strings = (
+        'London'
+        'Dateline'
+      )
+      TabOrder = 0
+      OnClick = rgCenterClick
+    end
   end
 end

components/lazmapviewer/examples/restricted_zoom_pan/main.pas

@@ -9,16 +9,22 @@ uses
   Dialogs, mvMapViewer, mvTypes, mvGeoMath;
 
 type
+
+  { TForm1 }
+
   TForm1 = class(TForm)
     Label1: TLabel;
     MapView1: TMapView;
     Panel1: TPanel;
+    rgCenter: TRadioGroup;
     StatusBar1: TStatusBar;
     procedure FormCreate(Sender: TObject);
     procedure MapView1Change(Sender: TObject);
+    procedure rgCenterClick(Sender: TObject);
   private
     FInitialArea: TRealArea;
-    procedure MapCenterMoving(Sender: TObject; NewCenter: TRealPoint; var Allow: Boolean);
+    FMinZoom: Integer;
+    procedure MapCenterMoving(Sender: TObject; var NewCenter: TRealPoint; var Allow: Boolean);
     procedure MapZoomChanging(Sender: TObject; NewZoom: Integer; var Allow: Boolean);
 
   public
@@ -32,18 +38,10 @@ implementation
 
 {$R *.lfm}
 
-const
-  MIN_ZOOM = 8;
-
 procedure TForm1.FormCreate(Sender: TObject);
 begin
-  MapView1.MapCenter.Longitude := -0.15;  // London
-  MapView1.MapCenter.Latitude := 51.5;
-  MapView1.Zoom := MIN_ZOOM;
-  MapView1.OnZoomChanging := @MapZoomChanging;
-  MapView1.OnCenterMoving := @MapCenterMoving;
+  rgCenterClick(nil);
   MapView1Change(nil);
-  FInitialArea := MapView1.GetVisibleArea;
 end;
 
 procedure TForm1.MapView1Change(Sender: TObject);
@@ -53,15 +51,42 @@ begin
   Statusbar1.Panels[2].Text := 'Zoom ' + IntToStr(MapView1.Zoom);
 end;
 
-procedure TForm1.MapCenterMoving(Sender: TObject; NewCenter: TRealPoint;
+procedure TForm1.rgCenterClick(Sender: TObject);
+const
+  INFO = '%s cannot be moved out of the window.'#13'Only zoom levels > %d allowed.';
+begin
+  MapView1.OnZoomChanging := nil;
+  MapView1.OnCenterMoving := nil;
+  case rgCenter.ItemIndex of
+    0: begin  // London
+         MapView1.MapCenter.Longitude := -DMSToDeg(0, 7, 54.6);
+         MapView1.MapCenter.Latitude := DMSToDeg(51, 30, 31.2);
+         FMinZoom := 8;
+         Label1.Caption := Format(INFO, ['London', FMinZoom]);
+       end;
+    1: begin   // somewhere in Siberia near dateline
+         MapView1.MapCenter.Longitude := 178;
+         MapView1.MapCenter.Latitude := 64.7;
+         FMinZoom := 6;
+         Label1.Caption := Format(INFO, ['Center', FMinZoom]);
+       end;
+  end;
+  MapView1.Zoom := FMinZoom;
+  FInitialArea := MapView1.GetVisibleArea;
+  MapView1.OnZoomChanging := @MapZoomChanging;
+  MapView1.OnCenterMoving := @MapCenterMoving;
+end;
+
+procedure TForm1.MapCenterMoving(Sender: TObject; var NewCenter: TRealPoint;
   var Allow: Boolean);
 begin
-  Allow := FInitialArea.ContainsPoint(NewCenter);
+  if not FInitialArea.ContainsPoint(NewCenter) then
+    FInitialArea.MakeAreaPoint(NewCenter);
 end;
 
 procedure TForm1.MapZoomChanging(Sender: TObject; NewZoom: Integer; var Allow: Boolean);
 begin
-  Allow := NewZoom >= MIN_ZOOM;
+  Allow := NewZoom >= FMinZoom;
 end;
 
 end.

components/lazmapviewer/source/mvengine.pas

@@ -34,7 +34,7 @@ type
 
   TTileDownloadedEvent = procedure (const TileId: TTileId) of object;
 
-  TCenterMovingEvent = procedure (Sender: TObject; NewCenter: TRealPoint; var Allow: Boolean) of object;
+  TCenterMovingEvent = procedure (Sender: TObject; var NewCenter: TRealPoint; var Allow: Boolean) of object;
   TZoomChangingEvent = procedure (Sender: TObject; NewZoom: Integer; var Allow: Boolean) of object;
 
   TTileIdArray = Array of TTileId;
@@ -134,7 +134,7 @@ type
       Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TPictureCacheItem);
       Procedure DoDrag(Sender: TDragObj);
       Procedure DoEndDrag(Sender: TDragObj);
-      Function DoCenterMoving(ANewPoint: TRealPoint): Boolean;
+      Function DoCenterMoving(var ANewPoint: TRealPoint): Boolean;
       Function DoZoomChanging(ANewZoom: Integer): Boolean;
 
     public
@@ -476,7 +476,7 @@ begin
   FInDrag := False;
 end;
 
-function TMapViewerEngine.DoCenterMoving(ANewPoint: TRealPoint): Boolean;
+function TMapViewerEngine.DoCenterMoving(var ANewPoint: TRealPoint): Boolean;
 begin
   Result := true;
   if Assigned(FOnCenterMoving) then

components/lazmapviewer/source/mvtypes.pas

@@ -61,6 +61,7 @@ Type
     function Equal(Area: TRealArea): Boolean;
     function Intersection(const Area: TRealArea): TRealArea;
     function Intersects(const Area: TRealArea): boolean;
+    procedure MakeAreaPoint(var APoint: TRealPoint);
     function Union(const Area: TRealArea): TRealArea;
   end;
 
@@ -87,7 +88,6 @@ begin
     Result := (x > x1) or (x < x2);
 end;
 
-
 { Checks whether the line segment between A1 and A2 intersects the line segment
   between B1 and B2. It is assumed that A1 < A2 and B1 < B2. }
 function LinearIntersects(A1, A2, B1, B2: Extended): Boolean;
@@ -238,6 +238,28 @@ begin
   end;
 end;
 
+{ Makes sure that x is between Left and Right (geometrically) where Right is
+  allowed to be smaller than Left. }
+procedure RestrictToRange(var x: Double; Left, Right: Double);
+begin
+  // Normal order
+  if Left < Right then
+  begin
+    if x < Left then
+      x := Left
+    else
+    if x > Right then
+      x := Right;
+  end else
+  begin
+    // Reverse order
+    if (x > 0) and (x < Left) then
+      x := Left
+    else
+    if (x < 0) and (x > Right) then
+      x := Right;
+  end;
+end;
 
 { TRealPoint }
 
@@ -339,6 +361,13 @@ begin
     CyclicIntersects(TopLeft.Lon, BottomRight.Lon, Area.TopLeft.Lon, Area.BottomRight.Lon);
 end;
 
+{ Makes sure that the point cannot leave the area. }
+procedure TRealArea.MakeAreaPoint(var APoint: TRealPoint);
+begin
+  RestrictToRange(APoint.Lat, BottomRight.Lat, TopLeft.Lat);
+  RestrictToRange(APoint.Lon, TopLeft.Lon, BottomRight.Lon);
+end;
+
 { Calculates the union with the other area. When the date line is crossed the
   right longitude becomes smaller than the left longitude! }
 function TRealArea.Union(const Area: TRealArea): TRealArea;