diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 91059e11a..4cc18a17b 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -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;