paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer. Introduce "ZoomToCursor" feature. Issue #38284, patch by regs.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7953 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz 2020-12-31 18:09:46 +00:00
parent 438e967c42
commit ef821b4227
6 changed files with 138 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
components/lazmapviewer/example/main.lfm
View File

@ -10,7 +10,7 @@ object MainForm: TMainForm
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 @@ object MainForm: TMainForm
MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True
Zoom = 0
ZoomToCursor = False
OnZoomChange = MapViewZoomChange
OnChange = MapViewChange
OnMouseLeave = MapViewMouseLeave
@ -38,9 +39,9 @@ object MainForm: TMainForm
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 @@ object MainForm: TMainForm
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 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 81
Top = 106
Width = 87
BorderSpacing.Top = 6
BorderSpacing.Right = 9
@ -709,7 +710,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 106
Top = 131
Width = 79
BorderSpacing.Top = 6
Caption = 'Debug tiles'
@ -721,7 +722,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 16
Height = 25
Top = 230
Top = 255
Width = 93
AutoSize = True
BorderSpacing.Top = 8
@ -737,7 +738,7 @@ object MainForm: TMainForm
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 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter
Left = 117
Height = 15
Top = 235
Top = 260
Width = 39
BorderSpacing.Left = 8
Caption = 'Backgr.'
@ -767,7 +768,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 6
Height = 4
Top = 133
Top = 158
Width = 255
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8
@ -779,7 +780,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 77
Top = 145
Top = 170
Width = 143
AutoFill = True
AutoSize = True
@ -803,23 +804,39 @@ object MainForm: TMainForm
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

8
components/lazmapviewer/example/main.pas
View File

@ -30,6 +30,7 @@ type
CbDistanceUnits: TComboBox;
CbDebugTiles: TCheckBox;
cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@ -78,6 +79,7 @@ type
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 @@ begin
UpdateViewPortSize;
end;
procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
begin
MapView.ZoomToCursor := CbZoomToCursor.Checked;
end;
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@ -337,6 +344,7 @@ begin
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;

52
components/lazmapviewer/example_with_addons/main.lfm
View File

@ -37,9 +37,9 @@ object MainForm: TMainForm
Height = 640
Top = 0
Width = 275
ActivePage = PgConfig
ActivePage = PgData
Align = alRight
TabIndex = 1
TabIndex = 0
TabOrder = 1
object PgData: TTabSheet
Caption = 'Data'
@ -710,14 +710,14 @@ object MainForm: TMainForm
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 +730,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 127
Top = 152
Width = 87
BorderSpacing.Top = 6
BorderSpacing.Right = 9
@ -746,7 +746,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 152
Top = 177
Width = 79
BorderSpacing.Top = 6
Caption = 'Debug tiles'
@ -759,7 +759,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 19
Top = 189
Top = 214
Width = 107
BorderSpacing.Top = 6
Caption = 'Show POI image'
@ -771,7 +771,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
Left = 6
Height = 25
Top = 216
Top = 241
Width = 93
AutoSize = True
BorderSpacing.Top = 8
@ -788,7 +788,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom
Left = 154
Height = 22
Top = 217
Top = 242
Width = 107
NoneColorColor = clWhite
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
@ -805,7 +805,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter
Left = 107
Height = 15
Top = 221
Top = 246
Width = 39
BorderSpacing.Left = 8
Caption = 'Backgr.'
@ -819,29 +819,45 @@ object MainForm: TMainForm
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
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 = 648
top = 280
Left = 816
Top = 152
end
end

8
components/lazmapviewer/example_with_addons/main.pas
View File

@ -33,6 +33,7 @@ type
CbDrawingEngine: TComboBox;
CbShowPOIImage: TCheckBox;
cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog;
GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox;
@ -82,6 +83,7 @@ type
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 @@ begin
UpdateViewPortSize;
end;
procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
begin
MapView.ZoomToCursor := CbZoomToCursor.Checked;
end;
procedure TMainForm.ClearFoundLocations;
var
i: Integer;
@ -357,6 +364,7 @@ begin
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;

41
components/lazmapviewer/source/mvengine.pas
View File

@ -45,6 +45,8 @@ type
Y: Int64;
Center: TRealPoint;
Zoom: integer;
ZoomCenter: TRealPoint;
ZoomOffset: TPoint;
Height: integer;
Width: integer;
end;
@ -66,6 +68,7 @@ type
lstProvider : TStringList;
Queue : TJobQueue;
MapWin : TMapWindow;
FZoomToCursor: Boolean;
function GetCacheOnDisk: Boolean;
function GetCachePath: String;
function GetCenter: TRealPoint;
@ -85,7 +88,8 @@ type
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); overload;
function DegreesToMapPixels(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
function MapPixelsToDegrees(const AWin: TMapWindow; APoint: TPoint): TRealPoint;
function PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer): TRealPoint;
@ -97,6 +101,7 @@ type
function CalculateVisibleTiles(const aWin: TMapWindow) : TArea;
function IsCurrentWin(const aWin: TMapWindow) : boolean;
protected
procedure AdjustZoomCenter(var AWin: TMapWindow);
procedure ConstraintZoom(var aWin: TMapWindow);
function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob);
@ -151,6 +156,7 @@ type
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
@ -342,6 +348,7 @@ begin
inherited Create(aOwner);
FZoomToCursor := true;
ConstraintZoom(MapWin);
CalculateWin(mapWin);
end;
@ -373,6 +380,17 @@ Begin
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,7 +803,9 @@ procedure TMapViewerEngine.MouseWheel(Sender: TObject;
var
Val: Integer;
nZoom: integer;
bZoomToCursor: Boolean;
begin
bZoomToCursor := False;
Val := 0;
if WheelDelta > 0 then
Val := 1;
@ -793,7 +813,15 @@ begin
Val := -1;
nZoom := Zoom + Val;
if (nZoom > 0) and (nZoom < 20) then
Zoom := nZoom;
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;
@ -1154,12 +1182,19 @@ begin
Redraw(MapWin);
end;
procedure TMapViewerEngine.SetZoom(AValue: integer);
procedure TMapViewerEngine.SetZoom(AValue: Integer);
begin
SetZoom(AValue, false);
end;
procedure TMapViewerEngine.SetZoom(AValue: integer; AZoomToCursor: Boolean);
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);

14
components/lazmapviewer/source/mvmapviewer.pas
View File

@ -63,6 +63,7 @@ Type
function GetOnZoomChange: TNotifyEvent;
function GetUseThreads: boolean;
function GetZoom: integer;
function GetZoomToCursor: Boolean;
function IsCachePathStored: Boolean;
function IsFontStored: Boolean;
procedure SetActive(AValue: boolean);
@ -84,6 +85,7 @@ Type
procedure SetPOITextBgColor(AValue: TColor);
procedure SetUseThreads(AValue: boolean);
procedure SetZoom(AValue: integer);
procedure SetZoomToCursor(AValue: Boolean);
procedure UpdateFont(Sender: TObject);
procedure UpdateImage(Sender: TObject);
@ -143,6 +145,7 @@ Type
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;
@ -336,6 +339,11 @@ begin
result := Engine.Zoom;
end;
function TMapView.GetZoomToCursor: Boolean;
begin
Result := Engine.ZoomToCursor;
end;
function TMapView.IsCachePathStored: Boolean;
begin
Result := not SameText(CachePath, 'cache/');
@ -466,6 +474,11 @@ begin
Engine.Zoom := AValue;
end;
procedure TMapView.SetZoomToCursor(AValue: Boolean);
begin
Engine.ZoomToCursor := AValue;
end;
function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean;
begin
@ -740,6 +753,7 @@ begin
FEngine.OnDrawTile := @DoDrawTile;
FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine;
FEngine.ZoomToCursor := True;
FBuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self);
FBuiltinDrawingEngine.Name := 'BuiltInDE';