git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7171 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-10-25 08:44:07 +00:00
parent 1a83d68689
commit 8c879bfca5
2 changed files with 94 additions and 12 deletions

View File

@ -213,12 +213,12 @@ type
{ TEnvTile } { TEnvTile }
TEnvTile = Class TEnvTile = Class(TBaseTile)
private private
Tile: TTileId; Tile: TTileId;
Win: TMapWindow; Win: TMapWindow;
public public
constructor Create(const aTile: TTileId; const aWin: TMapWindow); constructor Create(const aTile: TTileId; const aWin: TMapWindow);reintroduce;
end; end;
@ -279,17 +279,25 @@ end;
procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean); procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var var
iTile: integer; iTile: integer;
lJob: TEventJob;
lTile: TEnvTile;
begin begin
iTile := aTask - 1; iTile := aTask - 1;
Queue.AddUniqueJob(TEventJob.Create lTile:=TEnvTile.Create(FTiles[iTile], Win);
lJob := TEventJob.Create
( (
@Engine.evDownload, @Engine.evDownload,
TEnvTile.Create(FTiles[iTile], Win), lTile,
false, // owns data false, // owns data
Engine.GetTileName(FTiles[iTile]) Engine.GetTileName(FTiles[iTile])
), );
if not Queue.AddUniqueJob(lJob ,
Launcher Launcher
); ) then
begin
FreeAndNil(lJob);
FreeAndNil(lTile);
end;
end; end;
function TLaunchDownloadJob.Running: boolean; function TLaunchDownloadJob.Running: boolean;
@ -317,6 +325,7 @@ end;
constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow); constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow);
begin begin
inherited Create(aWin.MapProvider);
Tile := aTile; Tile := aTile;
Win := aWin; Win := aWin;
end; end;

View File

@ -36,6 +36,18 @@ type
TGetSvrStr = function (id: integer): string; TGetSvrStr = function (id: integer): string;
TGetValStr = function (const Tile: TTileId): String; TGetValStr = function (const Tile: TTileId): String;
TMapProvider = class;
{TBaseTile}
TBaseTile= class
FID:integer;
FMapProvider:TMapProvider;
Public
constructor Create(aProvider:TMapProvider);
destructor Destroy; override;
Property ID:integer read FID;
end;
{ TMapProvider } { TMapProvider }
TMapProvider = class TMapProvider = class
@ -51,12 +63,15 @@ type
FGetZStr: Array of TGetValStr; FGetZStr: Array of TGetValStr;
FMinZoom: Array of integer; FMinZoom: Array of integer;
FMaxZoom: Array of integer; FMaxZoom: Array of integer;
FTiles:array of TBaseTile;
FTileHandling: TRTLCriticalSection;
function GetLayerCount: integer; function GetLayerCount: integer;
procedure SetLayer(AValue: integer); procedure SetLayer(AValue: integer);
public public
constructor Create(AName: String); constructor Create(AName: String);
destructor Destroy; override; destructor Destroy; override;
function AppendTile(aTile: TBaseTile): integer;
procedure RemoveTile(aTile: TBaseTile);
procedure AddURL(Url: String; NbSvr, aMinZoom, aMaxZoom: integer; procedure AddURL(Url: String; NbSvr, aMinZoom, aMaxZoom: integer;
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
GetZStr: TGetValStr); GetZStr: TGetValStr);
@ -117,10 +132,27 @@ Begin
result := IntToStr(Tile.Z + 1); result := IntToStr(Tile.Z + 1);
end; end;
{ TBaseTile }
constructor TBaseTile.Create(aProvider: TMapProvider);
begin
FMapProvider := aProvider;
if assigned(aProvider) then
FID:=aProvider.AppendTile(self);
end;
destructor TBaseTile.Destroy;
begin
If assigned(FMapProvider) then
FMapProvider.RemoveTile(self);
FMapProvider:=nil;
inherited Destroy;
end;
{ TMapProvider } { TMapProvider }
function TMapProvider.getLayerCount: integer; function TMapProvider.GetLayerCount: integer;
begin begin
Result:=length(FUrl); Result:=length(FUrl);
end; end;
@ -135,12 +167,15 @@ begin
FLayer:=AValue; FLayer:=AValue;
end; end;
constructor TMapProvider.Create(aName: String); constructor TMapProvider.Create(AName: String);
begin begin
FName := aName; FName := aName;
InitCriticalSection(FTileHandling);
end; end;
destructor TMapProvider.Destroy; destructor TMapProvider.Destroy;
var
i: Integer;
begin begin
Finalize(idServer); Finalize(idServer);
Finalize(FName); Finalize(FName);
@ -152,12 +187,50 @@ begin
Finalize(FGetZStr); Finalize(FGetZStr);
Finalize(FMinZoom); Finalize(FMinZoom);
Finalize(FMaxZoom); Finalize(FMaxZoom);
EnterCriticalSection(FTileHandling);
for i := high(FTiles) downto 1 do
try
freeandnil(FTiles[i]);
except
FTiles[i]:=nil;
end;
LeaveCriticalsection(FTileHandling);
DoneCriticalsection(FTileHandling);
inherited; inherited;
end; end;
procedure TMapProvider.AddURL(Url: String; NbSvr: integer; function TMapProvider.AppendTile(aTile: TBaseTile): integer;
aMinZoom: integer; aMaxZoom: integer; GetSvrStr: TGetSvrStr; var
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr); lNewID: Integer;
begin
EnterCriticalSection(FTileHandling);
lNewID :=high(FTiles)+1;
setlength(FTiles,lNewID+1);
FTiles[lNewID]:=aTile;
LeaveCriticalsection(FTileHandling);
result := lNewID;
end;
procedure TMapProvider.RemoveTile(aTile: TBaseTile);
var
lID, lMaxTile: Integer;
begin
if (atile.ID <= high(FTiles)) and (atile.ID>0) and (FTiles[aTile.ID]=aTile) then
begin
EnterCriticalSection(FTileHandling);
lID := aTile.ID;
lMaxTile :=High(FTiles);
aTile.FID := -1;
FTiles[lID] := FTiles[lMaxTile];
FTiles[lID].FID := lID;
setlength(FTiles,lMaxTile);
LeaveCriticalsection(FTileHandling);
end;
end;
procedure TMapProvider.AddURL(Url: String; NbSvr, aMinZoom, aMaxZoom: integer;
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
GetZStr: TGetValStr);
var var
nb: integer; nb: integer;
begin begin