View Issue Details
| ID | Project | Category | View Status | Date Submitted | Last Update |
|---|---|---|---|---|---|
| 0038284 | Lazarus CCR | Packages | public | 2020-12-31 02:04 | 2020-12-31 19:10 |
| Reporter | regs | Assigned To | wp | ||
| Priority | normal | Severity | minor | Reproducibility | have not tried |
| Status | resolved | Resolution | fixed | ||
| Summary | 0038284: Zoom to cursor for LazMapViewer | ||||
| Description | Keeping location under cursor while zooming in and out. Similar to many online maps. | ||||
| Tags | lazmapviewer | ||||
| Widgetset | |||||
| Attached Files |
| ||||
|
|
zoomtocursor.diff (5,693 bytes)
Index: mvengine.pas
===================================================================
--- mvengine.pas (revision 7951)
+++ mvengine.pas (working copy)
@@ -47,6 +47,8 @@
Zoom: integer;
Height: integer;
Width: integer;
+ ZoomCenter: TRealPoint;
+ ZoomOffset: TPoint;
end;
@@ -66,6 +68,7 @@
lstProvider : TStringList;
Queue : TJobQueue;
MapWin : TMapWindow;
+ FZoomToCursor: Boolean;
function GetCacheOnDisk: Boolean;
function GetCachePath: String;
function GetCenter: TRealPoint;
@@ -85,7 +88,8 @@
procedure SetMapProvider(AValue: String);
procedure SetUseThreads(AValue: Boolean);
procedure SetWidth(AValue: integer);
- procedure SetZoom(AValue: integer);
+ procedure SetZoom(AValue: integer); overload;
+ procedure SetZoom(AValue: integer; AZoomToCursor: Boolean = False); overload;
function DegreesToMapPixels(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
function MapPixelsToDegrees(const AWin: TMapWindow; APoint: TPoint): TRealPoint;
function PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer): TRealPoint;
@@ -93,6 +97,7 @@
procedure CalculateWin(var AWin: TMapWindow);
function DegreesToPixelsEPSG3395(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
function DegreesToPixelsEPSG3857(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
+ procedure AdjustZoomCenter(var aWin: TMapWindow);
procedure Redraw(const aWin: TMapWindow);
function CalculateVisibleTiles(const aWin: TMapWindow) : TArea;
function IsCurrentWin(const aWin: TMapWindow) : boolean;
@@ -151,6 +156,7 @@
property UseThreads: Boolean read GetUseThreads write SetUseThreads;
property Width: integer read GetWidth write SetWidth;
property Zoom: integer read GetZoom write SetZoom;
+ property ZoomToCursor: Boolean read FZoomToCursor write FZoomToCursor default True;
property OnCenterMove: TNotifyEvent read FOnCenterMove write FOnCenterMove;
property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change
@@ -373,6 +379,20 @@
Result.AddUrl(Url, ProjectionType, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
end;
+procedure TMapViewerEngine.AdjustZoomCenter(var aWin: TMapWindow);
+var
+ ptMouseCursor: TPoint;
+ rPtAdjustedCenter: TRealPoint;
+begin
+
+ ptMouseCursor := LonLatToScreen(aWin.ZoomCenter);
+ rPtAdjustedCenter := ScreenToLonLat(ptMouseCursor.Add(aWin.ZoomOffset));
+ aWin.Center := rPtAdjustedCenter;
+
+ CalculateWin(aWin);
+
+end;
+
function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow): TArea;
var
MaxX, MaxY, startX, startY: int64;
@@ -785,8 +805,13 @@
var
Val: Integer;
nZoom: integer;
+ bZoomToCursor: Boolean;
+
begin
+
+ bZoomToCursor := False;
Val := 0;
+
if WheelDelta > 0 then
Val := 1;
if WheelDelta < 0 then
@@ -793,8 +818,18 @@
Val := -1;
nZoom := Zoom + Val;
if (nZoom > 0) and (nZoom < 20) then
- Zoom := nZoom;
- Handled := true;
+ begin
+ if ZoomToCursor then
+ begin
+ MapWin.ZoomCenter := ScreenToLonLat(MousePos);
+ MapWin.ZoomOffset := LonLatToScreen(Center).Subtract(MousePos);
+ bZoomToCursor := True;
+ end;
+ SetZoom(nZoom, bZoomToCursor);
+ end;
+
+ Handled := True;
+
end;
procedure TMapViewerEngine.MoveMapCenter(Sender: TDragObj);
@@ -1156,10 +1191,17 @@
procedure TMapViewerEngine.SetZoom(AValue: integer);
begin
+ SetZoom(AValue, False);
+end;
+
+procedure TMapViewerEngine.SetZoom(AValue: integer; AZoomToCursor: Boolean = False);
+begin
if MapWin.Zoom = AValue then Exit;
MapWin.Zoom := AValue;
ConstraintZoom(MapWin);
CalculateWin(MapWin);
+ if AZoomToCursor then
+ AdjustZoomCenter(MapWin);
Redraw(MapWin);
if Assigned(OnZoomChange) then
OnZoomChange(Self);
Index: mvmapviewer.pas
===================================================================
--- mvmapviewer.pas (revision 7951)
+++ mvmapviewer.pas (working copy)
@@ -105,6 +105,8 @@
procedure Paint; override;
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
Adding: boolean);
+ function GetZoomToCursor: Boolean;
+ procedure SetZoomToCursor(AValue: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@@ -143,6 +145,7 @@
property UseThreads: boolean read GetUseThreads write SetUseThreads default false;
property Width default 150;
property Zoom: integer read GetZoom write SetZoom;
+ property ZoomToCursor: Boolean read GetZoomToCursor write SetZoomToCursor default True;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
@@ -740,6 +743,7 @@
FEngine.OnDrawTile := @DoDrawTile;
FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine;
+ FEngine.ZoomToCursor := True;
FBuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self);
FBuiltinDrawingEngine.Name := 'BuiltInDE';
@@ -850,6 +854,16 @@
Result.BottomRight := Engine.ScreenToLonLat(aPt);;
end;
+function TMapView.GetZoomToCursor: Boolean;
+begin
+ Result := Engine.ZoomToCursor;
+end;
+
+procedure TMapView.SetZoomToCursor(AValue: Boolean);
+begin
+ Engine.ZoomToCursor := AValue;
+end;
+
procedure TMapView.ClearBuffer;
begin
DrawingEngine.CreateBuffer(ClientWidth, ClientHeight); // ???
zoomtocursor_example.diff (5,392 bytes)
Index: main.lfm
===================================================================
--- main.lfm (revision 7951)
+++ main.lfm (working copy)
@@ -10,7 +10,7 @@
OnDestroy = FormDestroy
OnShow = FormShow
ShowHint = True
- LCLVersion = '2.1.0.0'
+ LCLVersion = '2.0.6.0'
object MapView: TMapView
Left = 0
Height = 640
@@ -27,6 +27,7 @@
MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True
Zoom = 0
+ ZoomToCursor = False
OnZoomChange = MapViewZoomChange
OnChange = MapViewChange
OnMouseLeave = MapViewMouseLeave
@@ -38,9 +39,9 @@
Height = 640
Top = 0
Width = 275
- ActivePage = PgData
+ ActivePage = PgConfig
Align = alRight
- TabIndex = 0
+ TabIndex = 1
TabOrder = 1
object PgData: TTabSheet
Caption = 'Data'
@@ -673,14 +674,14 @@
end
object CbUseThreads: TCheckBox
AnchorSideLeft.Control = PgConfig
- AnchorSideTop.Control = CbProviders
+ AnchorSideTop.Control = CbZoomToCursor
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 56
+ Top = 81
Width = 81
BorderSpacing.Left = 6
- BorderSpacing.Top = 8
+ BorderSpacing.Top = 6
Caption = 'Use threads'
Checked = True
OnChange = CbUseThreadsChange
@@ -693,7 +694,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 81
+ Top = 106
Width = 87
BorderSpacing.Top = 6
BorderSpacing.Right = 9
@@ -709,7 +710,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 106
+ Top = 131
Width = 79
BorderSpacing.Top = 6
Caption = 'Debug tiles'
@@ -721,7 +722,7 @@
AnchorSideTop.Side = asrBottom
Left = 16
Height = 25
- Top = 230
+ Top = 255
Width = 93
AutoSize = True
BorderSpacing.Top = 8
@@ -737,7 +738,7 @@
AnchorSideRight.Side = asrBottom
Left = 164
Height = 22
- Top = 231
+ Top = 256
Width = 97
NoneColorColor = clWhite
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
@@ -754,7 +755,7 @@
AnchorSideTop.Side = asrCenter
Left = 117
Height = 15
- Top = 235
+ Top = 260
Width = 39
BorderSpacing.Left = 8
Caption = 'Backgr.'
@@ -767,7 +768,7 @@
AnchorSideRight.Side = asrBottom
Left = 6
Height = 4
- Top = 133
+ Top = 158
Width = 255
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
@@ -779,7 +780,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 77
- Top = 145
+ Top = 170
Width = 143
AutoFill = True
AutoSize = True
@@ -803,23 +804,39 @@
OnClick = rgPOIModeClick
TabOrder = 6
end
+ object CbZoomToCursor: TCheckBox
+ AnchorSideLeft.Control = PgConfig
+ AnchorSideTop.Control = CbProviders
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 19
+ Top = 56
+ Width = 102
+ BorderSpacing.Left = 6
+ BorderSpacing.Top = 8
+ Caption = 'Zoom to cursor'
+ Checked = True
+ OnChange = CbZoomToCursorChange
+ State = cbChecked
+ TabOrder = 7
+ end
end
end
object GeoNames: TMVGeoNames
OnNameFound = GeoNamesNameFound
- Left = 240
- Top = 192
+ left = 240
+ top = 192
end
object OpenDialog: TOpenDialog
DefaultExt = '.pgx'
Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
- Left = 240
- Top = 456
+ left = 240
+ top = 456
end
object FontDialog: TFontDialog
MinFontSize = 0
MaxFontSize = 0
- Left = 680
- Top = 296
+ left = 808
+ top = 104
end
end
Index: main.pas
===================================================================
--- main.pas (revision 7951)
+++ main.pas (working copy)
@@ -30,6 +30,7 @@
CbDistanceUnits: TComboBox;
CbDebugTiles: TCheckBox;
cbPOITextBgColor: TColorBox;
+ CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@@ -78,6 +79,7 @@
procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject);
+ procedure CbZoomToCursorChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
@@ -312,6 +314,11 @@
UpdateViewPortSize;
end;
+procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
+begin
+ MapView.ZoomToCursor := CbZoomToCursor.Checked;
+end;
+
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@@ -337,6 +344,7 @@
CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider);
MapView.DoubleBuffered := true;
MapView.Zoom := 1;
+ CbZoomToCursor.Checked := MapView.ZoomToCursor;
CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor;
zoomtocursor_example_with_addons.diff (4,588 bytes)
Index: main.lfm
===================================================================
--- main.lfm (revision 7951)
+++ main.lfm (working copy)
@@ -10,7 +10,6 @@
OnDestroy = FormDestroy
OnShow = FormShow
ShowHint = True
- LCLVersion = '2.1.0.0'
object MapView: TMapView
Left = 0
Height = 640
@@ -710,14 +709,14 @@
end
object CbUseThreads: TCheckBox
AnchorSideLeft.Control = PgConfig
- AnchorSideTop.Control = CbProviders
+ AnchorSideTop.Control = CbZoomToCursor
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 102
+ Top = 127
Width = 81
BorderSpacing.Left = 6
- BorderSpacing.Top = 8
+ BorderSpacing.Top = 6
Caption = 'Use threads'
Checked = True
OnChange = CbUseThreadsChange
@@ -730,7 +729,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 127
+ Top = 152
Width = 87
BorderSpacing.Top = 6
BorderSpacing.Right = 9
@@ -746,7 +745,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 152
+ Top = 177
Width = 79
BorderSpacing.Top = 6
Caption = 'Debug tiles'
@@ -759,7 +758,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
- Top = 189
+ Top = 214
Width = 107
BorderSpacing.Top = 6
Caption = 'Show POI image'
@@ -771,7 +770,7 @@
AnchorSideTop.Side = asrBottom
Left = 6
Height = 25
- Top = 216
+ Top = 241
Width = 93
AutoSize = True
BorderSpacing.Top = 8
@@ -788,7 +787,7 @@
AnchorSideRight.Side = asrBottom
Left = 154
Height = 22
- Top = 217
+ Top = 242
Width = 107
NoneColorColor = clWhite
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
@@ -805,7 +804,7 @@
AnchorSideTop.Side = asrCenter
Left = 107
Height = 15
- Top = 221
+ Top = 246
Width = 39
BorderSpacing.Left = 8
Caption = 'Backgr.'
@@ -819,12 +818,28 @@
AnchorSideRight.Side = asrBottom
Left = 6
Height = 4
- Top = 179
+ Top = 204
Width = 255
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
Shape = bsTopLine
end
+ object CbZoomToCursor: TCheckBox
+ AnchorSideLeft.Control = PgConfig
+ AnchorSideTop.Control = CbProviders
+ AnchorSideTop.Side = asrBottom
+ Left = 6
+ Height = 19
+ Top = 102
+ Width = 102
+ BorderSpacing.Left = 6
+ BorderSpacing.Top = 8
+ Caption = 'Zoom to cursor'
+ Checked = True
+ OnChange = CbZoomToCursorChange
+ State = cbChecked
+ TabOrder = 8
+ end
end
end
object GeoNames: TMVGeoNames
@@ -841,7 +856,7 @@
object FontDialog: TFontDialog
MinFontSize = 0
MaxFontSize = 0
- left = 648
- top = 280
+ left = 816
+ top = 152
end
end
Index: main.pas
===================================================================
--- main.pas (revision 7951)
+++ main.pas (working copy)
@@ -33,6 +33,7 @@
CbDrawingEngine: TComboBox;
CbShowPOIImage: TCheckBox;
cbPOITextBgColor: TColorBox;
+ CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@@ -82,6 +83,7 @@
procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject);
+ procedure CbZoomToCursorChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject);
@@ -332,6 +334,11 @@
UpdateViewPortSize;
end;
+procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
+begin
+ MapView.ZoomToCursor := CbZoomToCursor.Checked;
+end;
+
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@@ -357,6 +364,7 @@
CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider);
MapView.DoubleBuffered := true;
MapView.Zoom := 1;
+ CbZoomToCursor.Checked := MapView.ZoomToCursor;
CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor;
|
|
|
Thanks for this nice feature. Patch applied with minor modifications. Please test and close if ok. |
| Date Modified | Username | Field | Change |
|---|---|---|---|
| 2020-12-31 02:04 | regs | New Issue | |
| 2020-12-31 02:04 | regs | File Added: zoomtocursor.diff | |
| 2020-12-31 02:04 | regs | File Added: zoomtocursor_example.diff | |
| 2020-12-31 02:04 | regs | File Added: zoomtocursor_example_with_addons.diff | |
| 2020-12-31 02:04 | regs | Tag Attached: lazmapviewer | |
| 2020-12-31 11:56 | wp | Assigned To | => wp |
| 2020-12-31 11:56 | wp | Status | new => assigned |
| 2020-12-31 19:10 | wp | Status | assigned => resolved |
| 2020-12-31 19:10 | wp | Resolution | open => fixed |
| 2020-12-31 19:10 | wp | Note Added: 0127979 |
