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

LazMapViewer: Added CacheLocation property to the TMapView

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9265 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110 2024-03-04 13:36:32 +00:00
parent d85d2a6abd
commit 58f994c821
1 changed files with 65 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -40,6 +40,8 @@ Type
TMapViewOptions = set of TMapViewOption;
TCacheLocation = (clProfile, clTemp, clCustom);
const
DefaultMapViewOptions = [mvoMouseDragging, mvoMouseZooming];
@ -196,6 +198,8 @@ type
TMapView = class(TCustomControl)
private
FCacheLocation: TCacheLocation;
FCachePath, FCacheFullPath: String;
FCenter: TMapCenter;
FDownloadEngine: TMvCustomDownloadEngine;
FBuiltinDownloadEngine: TMvCustomDownloadEngine;
@ -225,7 +229,6 @@ type
procedure DrawGpsObj(const {%H-}Area: TRealArea; AObj: TGPSObj);
function GetCacheMaxAge: Integer;
function GetCacheOnDisk: boolean;
function GetCachePath: String;
function GetCenter: TRealPoint;
function GetCyclic: Boolean;
function GetDownloadEngine: TMvCustomDownloadEngine;
@ -247,6 +250,7 @@ type
function IsFontStored: Boolean;
function IsLayersStored: Boolean;
procedure SetActive(AValue: boolean);
procedure SetCacheLocation(AValue: TCacheLocation);
procedure SetCacheMaxAge(AValue: Integer);
procedure SetCacheOnDisk(AValue: boolean);
procedure SetCachePath(AValue: String);
@ -304,6 +308,9 @@ type
function CreateLayers: TMapLayers; virtual;
procedure UpdateLayers;
procedure ChangeCachePath(AOldLoc: TCacheLocation; ANewPath: String);
class function CacheDirectory(ALoc: TCacheLocation; ACustomPath: String): String;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
@ -334,7 +341,9 @@ type
property Active: boolean read FActive write SetActive default false;
property Align;
property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk default true;
property CachePath: String read GetCachePath write SetCachePath stored IsCachePathStored;
property CacheLocation: TCacheLocation read FCacheLocation write SetCacheLocation default clProfile;
property CachePath: String read FCachePath write SetCachePath stored IsCachePathStored;
property CacheFullPath: String read FCacheFullPath stored False;
property CacheMaxAge: Integer read GetCacheMaxAge write SetCacheMaxAge stored IsCacheMaxAgeStored;
property Cyclic: Boolean read GetCyclic write SetCyclic default false;
property DebugTiles: Boolean read FDebugTiles write SetDebugTiles default false;
@ -443,7 +452,7 @@ type
implementation
uses
GraphMath, Types, Math,
GraphMath, FileUtil, Types, Math,
mvJobQueue, mvExtraData, mvDLEFpc,
{$IFDEF MSWINDOWS}
mvDLEWin,
@ -980,6 +989,21 @@ begin
Engine.Active := false;
end;
procedure TMapView.SetCacheLocation(AValue: TCacheLocation);
var
NewPath: String;
OldLoc: TCacheLocation;
begin
if FCacheLocation = AValue then
Exit;
OldLoc := FCacheLocation;
FCacheLocation := AValue;
NewPath := CacheDirectory(AValue, CachePath);
if NewPath = Engine.CachePath then
Exit;
ChangeCachePath(OldLoc, NewPath);
end;
procedure TMapView.SetCacheMaxAge(AValue: Integer);
begin
if Engine.CacheMaxAge = AValue then
@ -993,11 +1017,6 @@ begin
Result := FCacheOnDisk;
end;
function TMapView.GetCachePath: String;
begin
Result := Engine.CachePath;
end;
function TMapView.GetCenter: TRealPoint;
begin
Result := Engine.Center;
@ -1115,9 +1134,16 @@ begin
end;
procedure TMapView.SetCachePath(AValue: String);
var
NewPath: String;
begin
Engine.CachePath := AValue;
UpdateLayers;
if FCachePath = AValue then
Exit;
FCachePath := AValue;
NewPath := CacheDirectory(CacheLocation, AValue);
if NewPath = Engine.CachePath then
Exit;
ChangeCachePath(CacheLocation, NewPath);
end;
procedure TMapView.SetCenter(AValue: TRealPoint);
@ -1808,9 +1834,11 @@ begin
{$ENDIF}
FBuiltinDownloadEngine.Name := 'BuiltInDLE';
FCacheLocation := clProfile;
FEngine := TMapViewerEngine.Create(self);
FEngine.BkColor := colWhite;
FEngine.CachePath := 'cache/';
{FEngine.}CachePath := 'cache/';
FEngine.CacheOnDisk := true;
FEngine.OnDrawTile := @DoDrawTile;
FEngine.OnDrawStretchedTile := @DoDrawStretchedTile;
@ -2098,6 +2126,32 @@ begin
FLayers[I].FComboLayer.TileLayer.ParentViewChanged;
end;
procedure TMapView.ChangeCachePath(AOldLoc: TCacheLocation; ANewPath: String);
var
OldPath: String;
begin
OldPath := Engine.CachePath;
FCacheFullPath := ANewPath;
//ForceDirectories(ANewPath);
Engine.CachePath := ANewPath;
UpdateLayers;
if AOldLoc = clTemp then
DeleteDirectory(OldPath, False);
end;
class function TMapView.CacheDirectory(ALoc: TCacheLocation;
ACustomPath: String): String;
const
LazMVCacheFolder: String = '.lazmapcache/';
begin
case ALoc of
clProfile: Result := Concat(GetUserDir, LazMVCacheFolder);
clTemp: Result := Concat(GetTempDir(True), LazMVCacheFolder);
otherwise
Result := ACustomPath;
end;
end;
{ TGPSTileLayerBase }
function TGPSTileLayerBase.GetMapProvider: String;