pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases 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
Download Patch File Download Diff File Expand all files Collapse all files

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';