LazMapViewer: Added CacheLocation property to the TMapView

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9265 8e941d3f-bd1b-0410-a28a-d453659cc2b4

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;
+  if FCachePath = AValue then
-  UpdateLayers;
+    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;