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

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

@ -10,7 +10,7 @@ object MainForm: TMainForm
OnDestroy = FormDestroy OnDestroy = FormDestroy
OnShow = FormShow OnShow = FormShow
ShowHint = True ShowHint = True
LCLVersion = '2.1.0.0' LCLVersion = '2.0.6.0'
object MapView: TMapView object MapView: TMapView
Left = 0 Left = 0
Height = 640 Height = 640
@ -27,6 +27,7 @@ object MainForm: TMainForm
MapProvider = 'OpenStreetMap Mapnik' MapProvider = 'OpenStreetMap Mapnik'
UseThreads = True UseThreads = True
Zoom = 0 Zoom = 0
ZoomToCursor = False
OnZoomChange = MapViewZoomChange OnZoomChange = MapViewZoomChange
OnChange = MapViewChange OnChange = MapViewChange
OnMouseLeave = MapViewMouseLeave OnMouseLeave = MapViewMouseLeave
@ -38,9 +39,9 @@ object MainForm: TMainForm
Height = 640 Height = 640
Top = 0 Top = 0
Width = 275 Width = 275
ActivePage = PgData ActivePage = PgConfig
Align = alRight Align = alRight
TabIndex = 0 TabIndex = 1
TabOrder = 1 TabOrder = 1
object PgData: TTabSheet object PgData: TTabSheet
Caption = 'Data' Caption = 'Data'
@ -673,14 +674,14 @@ object MainForm: TMainForm
end end
object CbUseThreads: TCheckBox object CbUseThreads: TCheckBox
AnchorSideLeft.Control = PgConfig AnchorSideLeft.Control = PgConfig
AnchorSideTop.Control = CbProviders AnchorSideTop.Control = CbZoomToCursor
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 56 Top = 81
Width = 81 Width = 81
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 8 BorderSpacing.Top = 6
Caption = 'Use threads' Caption = 'Use threads'
Checked = True Checked = True
OnChange = CbUseThreadsChange OnChange = CbUseThreadsChange
@ -693,7 +694,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 81 Top = 106
Width = 87 Width = 87
BorderSpacing.Top = 6 BorderSpacing.Top = 6
BorderSpacing.Right = 9 BorderSpacing.Right = 9
@ -709,7 +710,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 106 Top = 131
Width = 79 Width = 79
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Debug tiles' Caption = 'Debug tiles'
@ -721,7 +722,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 16 Left = 16
Height = 25 Height = 25
Top = 230 Top = 255
Width = 93 Width = 93
AutoSize = True AutoSize = True
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -737,7 +738,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 164 Left = 164
Height = 22 Height = 22
Top = 231 Top = 256
Width = 97 Width = 97
NoneColorColor = clWhite NoneColorColor = clWhite
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors] Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
@ -754,7 +755,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 117 Left = 117
Height = 15 Height = 15
Top = 235 Top = 260
Width = 39 Width = 39
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Backgr.' Caption = 'Backgr.'
@ -767,7 +768,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 6 Left = 6
Height = 4 Height = 4
Top = 133 Top = 158
Width = 255 Width = 255
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -779,7 +780,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 77 Height = 77
Top = 145 Top = 170
Width = 143 Width = 143
AutoFill = True AutoFill = True
AutoSize = True AutoSize = True
@ -803,23 +804,39 @@ object MainForm: TMainForm
OnClick = rgPOIModeClick OnClick = rgPOIModeClick
TabOrder = 6 TabOrder = 6
end 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
end end
object GeoNames: TMVGeoNames object GeoNames: TMVGeoNames
OnNameFound = GeoNamesNameFound OnNameFound = GeoNamesNameFound
Left = 240 left = 240
Top = 192 top = 192
end end
object OpenDialog: TOpenDialog object OpenDialog: TOpenDialog
DefaultExt = '.pgx' DefaultExt = '.pgx'
Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*' Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
Left = 240 left = 240
Top = 456 top = 456
end end
object FontDialog: TFontDialog object FontDialog: TFontDialog
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
Left = 680 left = 808
Top = 296 top = 104
end end
end end

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

@ -30,6 +30,7 @@ type
CbDistanceUnits: TComboBox; CbDistanceUnits: TComboBox;
CbDebugTiles: TCheckBox; CbDebugTiles: TCheckBox;
cbPOITextBgColor: TColorBox; cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog; FontDialog: TFontDialog;
GbCenterCoords: TGroupBox; GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox; GbScreenSize: TGroupBox;
@ -78,6 +79,7 @@ type
procedure CbShowPOIImageChange(Sender: TObject); procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject); procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject); procedure CbDistanceUnitsChange(Sender: TObject);
procedure CbZoomToCursorChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
@ -312,6 +314,11 @@ begin
UpdateViewPortSize; UpdateViewPortSize;
end; end;
procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
begin
MapView.ZoomToCursor := CbZoomToCursor.Checked;
end;
procedure TMainForm.ClearFoundLocations; procedure TMainForm.ClearFoundLocations;
var var
i: Integer; i: Integer;
@ -337,6 +344,7 @@ begin
CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider); CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider);
MapView.DoubleBuffered := true; MapView.DoubleBuffered := true;
MapView.Zoom := 1; MapView.Zoom := 1;
CbZoomToCursor.Checked := MapView.ZoomToCursor;
CbUseThreads.Checked := MapView.UseThreads; CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered; CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor; CbPOITextBgColor.Selected := MapView.POITextBgColor;

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

@ -37,9 +37,9 @@ object MainForm: TMainForm
Height = 640 Height = 640
Top = 0 Top = 0
Width = 275 Width = 275
ActivePage = PgConfig ActivePage = PgData
Align = alRight Align = alRight
TabIndex = 1 TabIndex = 0
TabOrder = 1 TabOrder = 1
object PgData: TTabSheet object PgData: TTabSheet
Caption = 'Data' Caption = 'Data'
@ -710,14 +710,14 @@ object MainForm: TMainForm
end end
object CbUseThreads: TCheckBox object CbUseThreads: TCheckBox
AnchorSideLeft.Control = PgConfig AnchorSideLeft.Control = PgConfig
AnchorSideTop.Control = CbProviders AnchorSideTop.Control = CbZoomToCursor
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 102 Top = 127
Width = 81 Width = 81
BorderSpacing.Left = 6 BorderSpacing.Left = 6
BorderSpacing.Top = 8 BorderSpacing.Top = 6
Caption = 'Use threads' Caption = 'Use threads'
Checked = True Checked = True
OnChange = CbUseThreadsChange OnChange = CbUseThreadsChange
@ -730,7 +730,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 127 Top = 152
Width = 87 Width = 87
BorderSpacing.Top = 6 BorderSpacing.Top = 6
BorderSpacing.Right = 9 BorderSpacing.Right = 9
@ -746,7 +746,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 152 Top = 177
Width = 79 Width = 79
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Debug tiles' Caption = 'Debug tiles'
@ -759,7 +759,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 19 Height = 19
Top = 189 Top = 214
Width = 107 Width = 107
BorderSpacing.Top = 6 BorderSpacing.Top = 6
Caption = 'Show POI image' Caption = 'Show POI image'
@ -771,7 +771,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 6 Left = 6
Height = 25 Height = 25
Top = 216 Top = 241
Width = 93 Width = 93
AutoSize = True AutoSize = True
BorderSpacing.Top = 8 BorderSpacing.Top = 8
@ -788,7 +788,7 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 154 Left = 154
Height = 22 Height = 22
Top = 217 Top = 242
Width = 107 Width = 107
NoneColorColor = clWhite NoneColorColor = clWhite
Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors] Style = [cbStandardColors, cbExtendedColors, cbIncludeNone, cbCustomColor, cbPrettyNames, cbCustomColors]
@ -805,7 +805,7 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 107 Left = 107
Height = 15 Height = 15
Top = 221 Top = 246
Width = 39 Width = 39
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Backgr.' Caption = 'Backgr.'
@ -819,29 +819,45 @@ object MainForm: TMainForm
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 6 Left = 6
Height = 4 Height = 4
Top = 179 Top = 204
Width = 255 Width = 255
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Shape = bsTopLine Shape = bsTopLine
end 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
end end
object GeoNames: TMVGeoNames object GeoNames: TMVGeoNames
OnNameFound = GeoNamesNameFound OnNameFound = GeoNamesNameFound
left = 240 Left = 240
top = 192 Top = 192
end end
object OpenDialog: TOpenDialog object OpenDialog: TOpenDialog
DefaultExt = '.pgx' DefaultExt = '.pgx'
Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*' Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
left = 240 Left = 240
top = 456 Top = 456
end end
object FontDialog: TFontDialog object FontDialog: TFontDialog
MinFontSize = 0 MinFontSize = 0
MaxFontSize = 0 MaxFontSize = 0
left = 648 Left = 816
top = 280 Top = 152
end end
end end

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

@ -33,6 +33,7 @@ type
CbDrawingEngine: TComboBox; CbDrawingEngine: TComboBox;
CbShowPOIImage: TCheckBox; CbShowPOIImage: TCheckBox;
cbPOITextBgColor: TColorBox; cbPOITextBgColor: TColorBox;
CbZoomToCursor: TCheckBox;
FontDialog: TFontDialog; FontDialog: TFontDialog;
GbCenterCoords: TGroupBox; GbCenterCoords: TGroupBox;
GbScreenSize: TGroupBox; GbScreenSize: TGroupBox;
@ -82,6 +83,7 @@ type
procedure CbShowPOIImageChange(Sender: TObject); procedure CbShowPOIImageChange(Sender: TObject);
procedure CbUseThreadsChange(Sender: TObject); procedure CbUseThreadsChange(Sender: TObject);
procedure CbDistanceUnitsChange(Sender: TObject); procedure CbDistanceUnitsChange(Sender: TObject);
procedure CbZoomToCursorChange(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject); procedure FormDestroy(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
@ -332,6 +334,11 @@ begin
UpdateViewPortSize; UpdateViewPortSize;
end; end;
procedure TMainForm.CbZoomToCursorChange(Sender: TObject);
begin
MapView.ZoomToCursor := CbZoomToCursor.Checked;
end;
procedure TMainForm.ClearFoundLocations; procedure TMainForm.ClearFoundLocations;
var var
i: Integer; i: Integer;
@ -357,6 +364,7 @@ begin
CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider); CbProviders.ItemIndex := CbProviders.Items.Indexof(MapView.MapProvider);
MapView.DoubleBuffered := true; MapView.DoubleBuffered := true;
MapView.Zoom := 1; MapView.Zoom := 1;
CbZoomToCursor.Checked := MapView.ZoomToCursor;
CbUseThreads.Checked := MapView.UseThreads; CbUseThreads.Checked := MapView.UseThreads;
CbDoubleBuffer.Checked := MapView.DoubleBuffered; CbDoubleBuffer.Checked := MapView.DoubleBuffered;
CbPOITextBgColor.Selected := MapView.POITextBgColor; CbPOITextBgColor.Selected := MapView.POITextBgColor;

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

@ -45,6 +45,8 @@ type
Y: Int64; Y: Int64;
Center: TRealPoint; Center: TRealPoint;
Zoom: integer; Zoom: integer;
ZoomCenter: TRealPoint;
ZoomOffset: TPoint;
Height: integer; Height: integer;
Width: integer; Width: integer;
end; end;
@ -66,6 +68,7 @@ type
lstProvider : TStringList; lstProvider : TStringList;
Queue : TJobQueue; Queue : TJobQueue;
MapWin : TMapWindow; MapWin : TMapWindow;
FZoomToCursor: Boolean;
function GetCacheOnDisk: Boolean; function GetCacheOnDisk: Boolean;
function GetCachePath: String; function GetCachePath: String;
function GetCenter: TRealPoint; function GetCenter: TRealPoint;
@ -85,7 +88,8 @@ type
procedure SetMapProvider(AValue: String); procedure SetMapProvider(AValue: String);
procedure SetUseThreads(AValue: Boolean); procedure SetUseThreads(AValue: Boolean);
procedure SetWidth(AValue: integer); 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 DegreesToMapPixels(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
function MapPixelsToDegrees(const AWin: TMapWindow; APoint: TPoint): TRealPoint; function MapPixelsToDegrees(const AWin: TMapWindow; APoint: TPoint): TRealPoint;
function PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer): TRealPoint; function PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer): TRealPoint;
@ -97,6 +101,7 @@ type
function CalculateVisibleTiles(const aWin: TMapWindow) : TArea; function CalculateVisibleTiles(const aWin: TMapWindow) : TArea;
function IsCurrentWin(const aWin: TMapWindow) : boolean; function IsCurrentWin(const aWin: TMapWindow) : boolean;
protected protected
procedure AdjustZoomCenter(var AWin: TMapWindow);
procedure ConstraintZoom(var aWin: TMapWindow); procedure ConstraintZoom(var aWin: TMapWindow);
function GetTileName(const Id: TTileId): String; function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob); procedure evDownload(Data: TObject; Job: TJob);
@ -151,6 +156,7 @@ type
property UseThreads: Boolean read GetUseThreads write SetUseThreads; property UseThreads: Boolean read GetUseThreads write SetUseThreads;
property Width: integer read GetWidth write SetWidth; property Width: integer read GetWidth write SetWidth;
property Zoom: integer read GetZoom write SetZoom; property Zoom: integer read GetZoom write SetZoom;
property ZoomToCursor: Boolean read FZoomToCursor write FZoomToCursor default True;
property OnCenterMove: TNotifyEvent read FOnCenterMove write FOnCenterMove; property OnCenterMove: TNotifyEvent read FOnCenterMove write FOnCenterMove;
property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change
@ -342,6 +348,7 @@ begin
inherited Create(aOwner); inherited Create(aOwner);
FZoomToCursor := true;
ConstraintZoom(MapWin); ConstraintZoom(MapWin);
CalculateWin(mapWin); CalculateWin(mapWin);
end; end;
@ -373,6 +380,17 @@ Begin
Result.AddUrl(Url, ProjectionType, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr); Result.AddUrl(Url, ProjectionType, NbSvr, MinZoom, MaxZoom, GetSvrStr, GetXStr, GetYStr, GetZStr);
end; 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; function TMapViewerEngine.CalculateVisibleTiles(const aWin: TMapWindow): TArea;
var var
MaxX, MaxY, startX, startY: int64; MaxX, MaxY, startX, startY: int64;
@ -785,7 +803,9 @@ procedure TMapViewerEngine.MouseWheel(Sender: TObject;
var var
Val: Integer; Val: Integer;
nZoom: integer; nZoom: integer;
bZoomToCursor: Boolean;
begin begin
bZoomToCursor := False;
Val := 0; Val := 0;
if WheelDelta > 0 then if WheelDelta > 0 then
Val := 1; Val := 1;
@ -793,7 +813,15 @@ begin
Val := -1; Val := -1;
nZoom := Zoom + Val; nZoom := Zoom + Val;
if (nZoom > 0) and (nZoom < 20) then 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; Handled := true;
end; end;
@ -1154,12 +1182,19 @@ begin
Redraw(MapWin); Redraw(MapWin);
end; end;
procedure TMapViewerEngine.SetZoom(AValue: integer); procedure TMapViewerEngine.SetZoom(AValue: Integer);
begin
SetZoom(AValue, false);
end;
procedure TMapViewerEngine.SetZoom(AValue: integer; AZoomToCursor: Boolean);
begin begin
if MapWin.Zoom = AValue then Exit; if MapWin.Zoom = AValue then Exit;
MapWin.Zoom := AValue; MapWin.Zoom := AValue;
ConstraintZoom(MapWin); ConstraintZoom(MapWin);
CalculateWin(MapWin); CalculateWin(MapWin);
if AZoomToCursor then
AdjustZoomCenter(MapWin);
Redraw(MapWin); Redraw(MapWin);
if Assigned(OnZoomChange) then if Assigned(OnZoomChange) then
OnZoomChange(Self); OnZoomChange(Self);

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

@ -63,6 +63,7 @@ Type
function GetOnZoomChange: TNotifyEvent; function GetOnZoomChange: TNotifyEvent;
function GetUseThreads: boolean; function GetUseThreads: boolean;
function GetZoom: integer; function GetZoom: integer;
function GetZoomToCursor: Boolean;
function IsCachePathStored: Boolean; function IsCachePathStored: Boolean;
function IsFontStored: Boolean; function IsFontStored: Boolean;
procedure SetActive(AValue: boolean); procedure SetActive(AValue: boolean);
@ -84,6 +85,7 @@ Type
procedure SetPOITextBgColor(AValue: TColor); procedure SetPOITextBgColor(AValue: TColor);
procedure SetUseThreads(AValue: boolean); procedure SetUseThreads(AValue: boolean);
procedure SetZoom(AValue: integer); procedure SetZoom(AValue: integer);
procedure SetZoomToCursor(AValue: Boolean);
procedure UpdateFont(Sender: TObject); procedure UpdateFont(Sender: TObject);
procedure UpdateImage(Sender: TObject); procedure UpdateImage(Sender: TObject);
@ -143,6 +145,7 @@ Type
property UseThreads: boolean read GetUseThreads write SetUseThreads default false; property UseThreads: boolean read GetUseThreads write SetUseThreads default false;
property Width default 150; property Width default 150;
property Zoom: integer read GetZoom write SetZoom; property Zoom: integer read GetZoom write SetZoom;
property ZoomToCursor: Boolean read GetZoomToCursor write SetZoomToCursor default True;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove; property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange; property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange; property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
@ -336,6 +339,11 @@ begin
result := Engine.Zoom; result := Engine.Zoom;
end; end;
function TMapView.GetZoomToCursor: Boolean;
begin
Result := Engine.ZoomToCursor;
end;
function TMapView.IsCachePathStored: Boolean; function TMapView.IsCachePathStored: Boolean;
begin begin
Result := not SameText(CachePath, 'cache/'); Result := not SameText(CachePath, 'cache/');
@ -466,6 +474,11 @@ begin
Engine.Zoom := AValue; Engine.Zoom := AValue;
end; end;
procedure TMapView.SetZoomToCursor(AValue: Boolean);
begin
Engine.ZoomToCursor := AValue;
end;
function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; function TMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; MousePos: TPoint): Boolean;
begin begin
@ -740,6 +753,7 @@ begin
FEngine.OnDrawTile := @DoDrawTile; FEngine.OnDrawTile := @DoDrawTile;
FEngine.DrawTitleInGuiThread := false; FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine; FEngine.DownloadEngine := FBuiltinDownloadEngine;
FEngine.ZoomToCursor := True;
FBuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self); FBuiltinDrawingEngine := TMvIntfGraphicsDrawingEngine.Create(self);
FBuiltinDrawingEngine.Name := 'BuiltInDE'; FBuiltinDrawingEngine.Name := 'BuiltInDE';