LazMapViewer: Add new property Cyclic (not functional yet)

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8804 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-04-25 11:19:04 +00:00
parent 1184330d05
commit 4ca84b72c3
4 changed files with 44 additions and 2 deletions

View File

@ -19,6 +19,7 @@ object MainForm: TMainForm
Width = 608 Width = 608
Align = alClient Align = alClient
CachePath = '../../../../cache/' CachePath = '../../../../cache/'
Cyclic = True
DefaultTrackColor = clBlue DefaultTrackColor = clBlue
DefaultTrackWidth = 3 DefaultTrackWidth = 3
DownloadEngine = MapView.BuiltInDLE DownloadEngine = MapView.BuiltInDLE

View File

@ -10,6 +10,11 @@
<OtherUnitFiles Value="source"/> <OtherUnitFiles Value="source"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/> <UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths> </SearchPaths>
<Other>
<CompilerMessages>
<IgnoredMessages idx6058="True"/>
</CompilerMessages>
</Other>
</CompilerOptions> </CompilerOptions>
<Description Value="Component for viewing maps (Google, OpenStreetMap, etc). <Description Value="Component for viewing maps (Google, OpenStreetMap, etc).
This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/> This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
@ -91,7 +96,7 @@ This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/c
</Item18> </Item18>
<Item19> <Item19>
<Filename Value="source/mvdlewin.pas"/> <Filename Value="source/mvdlewin.pas"/>
<UnitName Value="mvdlewin"/> <UnitName Value="mvDLEWin"/>
</Item19> </Item19>
</Files> </Files>
<CompatibilityMode Value="True"/> <CompatibilityMode Value="True"/>

View File

@ -59,6 +59,7 @@ type
DragObj : TDragObj; DragObj : TDragObj;
Cache : TPictureCache; Cache : TPictureCache;
FActive: boolean; FActive: boolean;
FCyclic: Boolean;
FDownloadEngine: TMvCustomDownloadEngine; FDownloadEngine: TMvCustomDownloadEngine;
FDrawTitleInGuiThread: boolean; FDrawTitleInGuiThread: boolean;
FOnCenterMove: TNotifyEvent; FOnCenterMove: TNotifyEvent;
@ -82,7 +83,8 @@ type
procedure SetActive(AValue: boolean); procedure SetActive(AValue: boolean);
procedure SetCacheOnDisk(AValue: Boolean); procedure SetCacheOnDisk(AValue: Boolean);
procedure SetCachePath(AValue: String); procedure SetCachePath(AValue: String);
procedure SetCenter(aCenter: TRealPoint); procedure SetCenter(ACenter: TRealPoint);
procedure SetCyclic(AValue: Boolean);
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
procedure SetHeight(AValue: integer); procedure SetHeight(AValue: integer);
procedure SetMapProvider(AValue: String); procedure SetMapProvider(AValue: String);
@ -118,6 +120,7 @@ type
GetZStr: TGetValStr = nil): TMapProvider; GetZStr: TGetValStr = nil): TMapProvider;
procedure CancelCurrentDrawing; procedure CancelCurrentDrawing;
procedure ClearMapProviders; procedure ClearMapProviders;
function CrossesDateline: Boolean;
procedure GetMapProviders(AList: TStrings); procedure GetMapProviders(AList: TStrings);
function LonLatToScreen(ALonLat: TRealPoint): TPoint; function LonLatToScreen(ALonLat: TRealPoint): TPoint;
function LonLatToWorldScreen(ALonLat: TRealPoint): TPoint; function LonLatToWorldScreen(ALonLat: TRealPoint): TPoint;
@ -146,6 +149,7 @@ type
property Active: Boolean read FActive write SetActive default false; property Active: Boolean read FActive write SetActive default false;
property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk; property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath; property CachePath: String read GetCachePath write SetCachePath;
property Cyclic: Boolean read FCyclic write SetCyclic default false;
property DownloadEngine: TMvCustomDownloadEngine property DownloadEngine: TMvCustomDownloadEngine
read FDownloadEngine write SetDownloadEngine; read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean property DrawTitleInGuiThread: boolean
@ -481,6 +485,17 @@ begin
end; end;
end; end;
{ Returns true when the visible window crosses the date line, i.e. the longitudes
at the left of the window are > 0, and those at the right are < 0. }
function TMapViewerEngine.CrossesDateline: Boolean;
var
visArea: TRealArea;
begin
visArea.TopLeft := ScreenToLonLat(Point(0, 0));
visArea.BottomRight := ScreenToLonLat(Point(Width, Height));
Result := (visArea.TopLeft.Lon > 0) and (visArea.BottomRight.Lon < 0);
end;
procedure TMapViewerEngine.DblClick(Sender: TObject); procedure TMapViewerEngine.DblClick(Sender: TObject);
var var
pt: TPoint; pt: TPoint;
@ -1153,6 +1168,14 @@ begin
end; end;
end; end;
procedure TMapViewerEngine.SetCyclic(AValue: Boolean);
begin
if FCyclic = AValue then exit;
FCyclic := AValue;
if CrossesDateLine then
Redraw;
end;
procedure TMapViewerEngine.SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure TMapViewerEngine.SetDownloadEngine(AValue: TMvCustomDownloadEngine);
begin begin
if FDownloadEngine = AValue then Exit; if FDownloadEngine = AValue then Exit;

View File

@ -60,6 +60,7 @@ Type
function GetCacheOnDisk: boolean; function GetCacheOnDisk: boolean;
function GetCachePath: String; function GetCachePath: String;
function GetCenter: TRealPoint; function GetCenter: TRealPoint;
function GetCyclic: Boolean;
function GetDownloadEngine: TMvCustomDownloadEngine; function GetDownloadEngine: TMvCustomDownloadEngine;
function GetDrawingEngine: TMvCustomDrawingEngine; function GetDrawingEngine: TMvCustomDrawingEngine;
function GetMapProvider: String; function GetMapProvider: String;
@ -75,6 +76,7 @@ Type
procedure SetCacheOnDisk(AValue: boolean); procedure SetCacheOnDisk(AValue: boolean);
procedure SetCachePath(AValue: String); procedure SetCachePath(AValue: String);
procedure SetCenter(AValue: TRealPoint); procedure SetCenter(AValue: TRealPoint);
procedure SetCyclic(AValue: Boolean);
procedure SetDebugTiles(AValue: Boolean); procedure SetDebugTiles(AValue: Boolean);
procedure SetDefaultTrackColor(AValue: TColor); procedure SetDefaultTrackColor(AValue: TColor);
procedure SetDefaultTrackWidth(AValue: Integer); procedure SetDefaultTrackWidth(AValue: Integer);
@ -140,6 +142,7 @@ Type
property Align; property Align;
property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true; property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true;
property CachePath: String read GetCachePath write SetCachePath stored IsCachePathStored; property CachePath: String read GetCachePath write SetCachePath stored IsCachePathStored;
property Cyclic: Boolean read GetCyclic write SetCyclic default false;
property DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false; property DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false;
property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed; property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1; property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
@ -319,6 +322,11 @@ begin
Result := Engine.Center; Result := Engine.Center;
end; end;
function TMapView.GetCyclic: Boolean;
begin
Result := Engine.Cyclic;
end;
function TMapView.GetDownloadEngine: TMvCustomDownloadEngine; function TMapView.GetDownloadEngine: TMvCustomDownloadEngine;
begin begin
if FDownloadEngine = nil then if FDownloadEngine = nil then
@ -396,6 +404,11 @@ begin
Engine.Center := AValue; Engine.Center := AValue;
end; end;
procedure TMapView.SetCyclic(AValue: Boolean);
begin
Engine.Cyclic := AValue;
end;
procedure TMapView.SetDebugTiles(AValue: Boolean); procedure TMapView.SetDebugTiles(AValue: Boolean);
begin begin
if FDebugTiles = AValue then exit; if FDebugTiles = AValue then exit;