pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

LazMapViewer: Fixes issues with painting/multithreading. Issue #39063, patch by Yuliyan Ivanov.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9092 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2023-12-18 16:56:22 +00:00
parent 0866840b01
commit a5741193c0
5 changed files with 177 additions and 225 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
components/lazmapviewer/source/mvcache.pas
View File

@ -60,8 +60,12 @@ Type
implementation
uses
FPimage, GraphType, FPReadJPEG;
FPimage, GraphType, FPReadJPEG, DateUtils;
const
MEMCACHE_MAX = 64; // Tiles kept in memory
MEMCACHE_SWEEP_CNT = 10; // Max tiles to be swept at once
DISKCACHE_MAXAGE = 10 * 86400; // 10 days
{ TPictureCache }
@ -104,7 +108,7 @@ end;
constructor TPictureCache.Create(aOwner: TComponent);
begin
inherited Create(aOwner);
FMemMaxElem := 2048 div 256;
FMemMaxElem := MEMCACHE_MAX;
Cache := TStringList.create;
end;
@ -200,11 +204,13 @@ end;
function TPictureCache.DiskCached(const aFileNAme: String): Boolean;
var
FullFileName: string;
Age: LongInt;
begin
if UseDisk then
begin
FullFileName := BasePath + aFileName;
Result := FileExists(FullFileName);
Age := FileAge(fullFileName);
Result := Age > (DateTimeToUnix(Now, False) - DISKCACHE_MAXAGE);
end
else
Result := False;
@ -217,9 +223,9 @@ var
lStream: TFileStream;
begin
img := nil;
FullFileName := BasePath + aFileName;
if FileExists(fullFileName) then
if DiskCached(aFileName) then
begin
FullFileName := BasePath + aFileName;
lStream := TFileStream.Create(FullFileName, fmOpenRead);
try
try
@ -258,7 +264,7 @@ begin
try
if Cache.Count > FMemMaxElem then
begin
for i:=1 to 10 do
for i := 1 to MEMCACHE_SWEEP_CNT do
begin
idx := pred(Cache.Count);
if idx > 1 then
@ -311,9 +317,6 @@ begin
end;
end;
end;
if not FUseThreads then
CheckCacheSize(self);
end;
procedure TPictureCache.GetFromCache(MapProvider: TMapProvider;

202
components/lazmapviewer/source/mvengine.pas
View File

@ -36,6 +36,8 @@ type
TDrawStretchedTileEvent = procedure (const TileId: TTileId; X,Y: Integer;
TileImg: TLazIntfImage; const R: TRect) of object;
TTileDownloadedEvent = procedure (const TileId: TTileId) of object;
TTileIdArray = Array of TTileId;
TDistanceUnits = (duMeters, duKilometers, duMiles);
@ -71,6 +73,7 @@ type
FOnChange: TNotifyEvent;
FOnDrawTile: TDrawTileEvent;
FOnDrawStretchedTile: TDrawStretchedTileEvent;
FOnTileDownloaded: TTileDownloadedEvent;
FOnZoomChange: TNotifyEvent;
lstProvider : TStringList;
Queue : TJobQueue;
@ -106,7 +109,7 @@ type
procedure CalculateWin(var AWin: TMapWindow);
function DegreesToPixelsEPSG3395(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
function DegreesToPixelsEPSG3857(const AWin: TMapWindow; ALonLat: TRealPoint): TPoint;
procedure Redraw(const aWin: TMapWindow);
procedure Redraw(const aWin: TMapWindow; const paintOnly: Boolean = False);
function CalculateVisibleTiles(const aWin: TMapWindow) : TArea;
function IsCurrentWin(const aWin: TMapWindow) : boolean;
protected
@ -115,6 +118,7 @@ type
function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt);
procedure DrawTileFromCache(constref ATile: TTileId; constref AWin: TMapWindow);
procedure DrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TLazIntfImage; const R: TRect);
Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
Procedure DoDrag(Sender: TDragObj);
@ -176,6 +180,7 @@ type
property OnChange: TNotifyEvent Read FOnChange write FOnchange; //called when visiable area change
property OnDrawStretchedTile: TDrawStretchedTileEvent read FOnDrawStretchedTile write FOnDrawStretchedTile;
property OnDrawTile: TDrawTileEvent read FOnDrawTile write FOnDrawTile;
property OnTileDownloaded: TTileDownloadedEvent read FOnTileDownloaded write FOnTileDownloaded;
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
@ -233,32 +238,8 @@ begin
Result := round(IntPower(2, AZoomLevel));
end;
type
{ TLaunchDownloadJob }
TLaunchDownloadJob = class(TJob)
private
AllRun: boolean;
Win: TMapWindow;
Engine: TMapViewerEngine;
FRunning: boolean;
FTiles: TTileIdArray;
FStates: Array of integer;
protected
function pGetTask: integer; override;
procedure pTaskStarted(aTask: integer); override;
procedure pTaskEnded(aTask: integer; aExcept: Exception); override;
public
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean; override;
public
constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray;
const aWin: TMapWindow);
end;
{ TEnvTile }
TEnvTile = Class(TBaseTile)
@ -285,90 +266,6 @@ type
end;
{ TLaunchDownloadJob }
function TLaunchDownloadJob.pGetTask: integer;
var
i: integer;
begin
if not AllRun and not Cancelled then
begin
for i:=Low(FStates) to High(FStates) do
if FStates[i] = 0 then
begin
Result := i + 1;
Exit;
end;
AllRun := True;
end;
Result := ALL_TASK_COMPLETED;
for i := Low(FStates) to High(FStates) do
if FStates[i] = 1 then
begin
Result := NO_MORE_TASK;
Exit;
end;
end;
procedure TLaunchDownloadJob.pTaskStarted(aTask: integer);
begin
FRunning := True;
FStates[aTask-1] := 1;
end;
procedure TLaunchDownloadJob.pTaskEnded(aTask: integer; aExcept: Exception);
begin
if Assigned(aExcept) then
FStates[aTask - 1] := 3
Else
FStates[aTask - 1] := 2;
end;
procedure TLaunchDownloadJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var
iTile: integer;
lJob: TEventJob;
lTile: TEnvTile;
begin
iTile := aTask - 1;
lTile:=TEnvTile.Create(FTiles[iTile], Win);
lJob := TEventJob.Create
(
@Engine.evDownload,
lTile,
false, // owns data
Engine.GetTileName(FTiles[iTile])
);
if not Queue.AddUniqueJob(lJob ,
Launcher
) then
begin
FreeAndNil(lJob);
FreeAndNil(lTile);
end;
end;
function TLaunchDownloadJob.Running: boolean;
begin
Result := FRunning;
end;
constructor TLaunchDownloadJob.Create(Eng: TMapViewerEngine;
const Tiles: TTileIdArray; const aWin: TMapWindow);
var
i: integer;
begin
Engine := Eng;
SetLength(FTiles, Length(Tiles));
For i:=Low(FTiles) to High(FTiles) do
FTiles[i] := Tiles[i];
SetLength(FStates, Length(Tiles));
AllRun := false;
Name := 'LaunchDownload';
Win := aWin;
end;
{ TEnvTile }
constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow);
@ -392,7 +289,6 @@ begin
FBkColor := colWhite;
RegisterProviders;
Queue := TJobQueue.Create(8);
Queue.OnIdle := @Cache.CheckCacheSize;
inherited Create(aOwner);
@ -531,8 +427,8 @@ begin
MoveMapCenter(Sender);
end;
procedure TMapViewerEngine.DrawStretchedTile(const TileID: TTileID; X, Y: Integer;
TileImg: TLazIntfImage; const R: TRect);
procedure TMapViewerEngine.DrawStretchedTile(const TileId: TTileID; X,
Y: Integer; TileImg: TLazIntfImage; const R: TRect);
begin
if Assigned(FOnDrawStretchedTile) then
FOnDrawStretchedTile(TileId, X, Y, TileImg, R);
@ -652,7 +548,7 @@ begin
end;
function TMapViewerEngine.IsValidTile(const aWin: TMapWindow;
const aTile: TTileId): boolean;
const aTile: TTIleId): boolean;
var
tiles: int64;
begin
@ -806,7 +702,8 @@ begin
Result.Lon := Math.EnsureRange(Result.Lon, MIN_LONGITUDE, MAX_LONGITUDE);
end;
Function TMapViewerEngine.PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer): TRealPoint;
function TMapViewerEngine.PixelsToDegreesEPSG3395(APoint: TPoint; Zoom: Integer
): TRealPoint;
function PhiIteration(y, phi: Extended): Extended;
var
@ -1048,18 +945,33 @@ begin
Redraw(MapWin);
end;
procedure TMapViewerEngine.Redraw(const AWin: TMapWindow);
procedure TMapViewerEngine.Redraw(const aWin: TMapWindow;
const paintOnly: Boolean);
var
TilesVis: TArea;
x, y : Integer; //int64;
x, y, px, py: Integer;
iTile, numTiles: Integer;
Tiles: TTileIdArray = nil;
iTile: Integer;
tile: TTileID;
numTiles: Integer;
px, py: Integer;
previewDrawn: Boolean;
previewImg: TLazIntfImage;
R: TRect;
procedure AddJob;
var
lTile: TEnvTile;
lJob: TEventJob;
begin
lTile:=TEnvTile.Create(Tiles[iTile], aWin);
lJob := TEventJob.Create(@evDownload, lTile, False, // owns data
GetTileName(Tiles[iTile]));
if not Queue.AddUniqueJob(lJob, Self) then
begin
FreeAndNil(lJob);
FreeAndNil(lTile);
end;
end;
begin
if not(Active) then
Exit;
@ -1082,9 +994,11 @@ begin
Tiles[iTile].Y := Y;
Tiles[iTile].Z := AWin.Zoom;
if Cache.InCache(AWin.MapProvider, Tiles[iTile]) then
DrawTileFromCache(Tiles[iTile], AWin)
else
// Avoid tiling artefacts when a tile does not exist (lowest zoom) or
// is not valid
if not Cache.InCache(AWin.MapProvider, Tiles[iTile]) then
begin
previewdrawn := False;
py := AWin.Y + Y * TILE_SIZE;
@ -1104,14 +1018,17 @@ begin
end;
if not previewDrawn then
DrawTile(Tiles[iTile], px, py, nil); // Draw blank tile if preview cannot be generated
end;
if IsValidTile(AWin, Tiles[iTile]) then
begin
AddJob;
inc(iTile);
end;
end;
end;
SetLength(Tiles, iTile);
if Length(Tiles) > 0 then
Queue.AddJob(TLaunchDownloadJob.Create(self, Tiles, AWin), self);
if Length(Tiles) < 1 then
Cache.CheckCacheSize(Nil);
end;
procedure TMapViewerEngine.RegisterProviders;
@ -1270,48 +1187,57 @@ end;
procedure TMapViewerEngine.TileDownloaded(Data: PtrInt);
var
EnvTile: TEnvTile;
begin
EnvTile := TEnvTile(Data);
try
if Assigned(FOnTileDownloaded) then
FOnTileDownloaded(EnvTile.Tile);
finally
FreeAndNil(EnvTile);
end;
end;
procedure TMapViewerEngine.DrawTileFromCache(constref ATile: TTileId; constref
AWin: TMapWindow);
var
img: TLazIntfImage;
X, Y: integer;
worldWidth : Integer;
numTiles : Integer;
baseX : Integer;
begin
EnvTile := TEnvTile(Data);
try
if IsCurrentWin(EnvTile.Win)then
if IsCurrentWin(AWin)then
begin
Cache.GetFromCache(EnvTile.Win.MapProvider, EnvTile.Tile, img);
Y := EnvTile.Win.Y + EnvTile.Tile.Y * TILE_SIZE; // begin of Y
Cache.GetFromCache(AWin.MapProvider, ATile, img);
Y := AWin.Y + ATile.Y * TILE_SIZE; // begin of Y
if Cyclic then
begin
baseX := EnvTile.Win.X + EnvTile.Tile.X * TILE_SIZE; // begin of X
numTiles := 1 shl EnvTile.Win.Zoom;
baseX := AWin.X + ATile.X * TILE_SIZE; // begin of X
numTiles := 1 shl AWin.Zoom;
worldWidth := numTiles * TILE_SIZE;
// From the center to the left (western) hemisphere
X := baseX;
while (X+TILE_SIZE >= 0) do
begin
DrawTile(EnvTile.Tile, X, Y, img);
DrawTile(ATile, X, Y, img);
X := X - worldWidth;
end;
// From the center to the right (eastern) hemisphere
X := baseX + worldWidth;
while ((X-TILE_SIZE) <= EnvTile.Win.Width) do
while ((X-TILE_SIZE) <= AWin.Width) do
begin
DrawTile(EnvTile.Tile, X, Y, img);
DrawTile(ATile, X, Y, img);
X := X + worldWidth;
end;
end else
begin
X := EnvTile.Win.X + EnvTile.Tile.X * TILE_SIZE; // begin of X
DrawTile(EnvTile.Tile, X, Y, img);
X := AWin.X + ATile.X * TILE_SIZE; // begin of X
DrawTile(ATile, X, Y, img);
end;
end;
finally
FreeAndNil(EnvTile);
end;
end;
function TMapViewerEngine.WorldScreenToLonLat(aPt: TPoint): TRealPoint;
begin
aPt.X := aPt.X - MapWin.X;

51
components/lazmapviewer/source/mvgpsobj.pas
View File

@ -30,21 +30,20 @@ type
TGPSObj = class
private
BBoxSet: Boolean;
FBoundingBox: TRealArea;
FExtraData: TObject;
FName: String;
FIdOwner: integer;
function GetBoundingBox: TRealArea;
procedure SetBoundingBox(AValue: TRealArea);
procedure SetExtraData(AValue: TObject);
public
destructor Destroy; override;
procedure Assign(AObj: TGPSObj); virtual;
procedure GetArea(out Area: TRealArea); virtual; abstract;
procedure Draw(AView: TObject; Area: TRealArea); virtual; abstract;
property Name: String read FName write FName;
property ExtraData: TObject read FExtraData write SetExtraData;
property IdOwner: Integer read FIdOwner;
property BoundingBox: TRealArea read GetBoundingBox write SetBoundingBox;
property BoundingBox: TRealArea read GetBoundingBox;
end;
TGPSObjarray = Array of TGPSObj;
@ -66,6 +65,7 @@ type
procedure Assign(AObj: TGPSObj); override;
procedure GetArea(out Area: TRealArea);override;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
function HasElevation: boolean;
function HasDateTime: Boolean;
function DistanceInKmFrom(OtherPt: TGPSPoint; UseElevation: boolean=true): double;
@ -89,6 +89,7 @@ type
public
constructor Create(ALon, ALat: Double; AElevation: Double = NO_ELE;
ADateTime: TDateTime = NO_DATE);
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
property ImageIndex: Integer read FImageIndex write FImageIndex default -1;
end;
{ TGPSTrack }
@ -106,6 +107,7 @@ type
destructor Destroy; override;
procedure GetArea(out Area: TRealArea); override;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
function TrackLengthInKm(UseEle: Boolean=true): double;
property Points: TGPSPointList read FPoints;
@ -155,6 +157,7 @@ type
procedure ClearExcept(OwnedBy: integer; const ExceptLst: TIdArray;
out Notfound: TIdArray);
procedure GetArea(out Area: TRealArea); override;
procedure Draw({%H-}AView: TObject; {%H-}Area: TRealArea); override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
function GetIdsArea(const Ids: TIdArray; AIdOwner: integer): TRealArea;
@ -184,7 +187,7 @@ function GetAreaOf(objs: TGPSObjList): TRealArea;
implementation
uses
mvExtraData;
mvExtraData, mvMapViewer;
function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
begin
@ -249,19 +252,11 @@ begin
end;
function TGPSObj.GetBoundingBox: TRealArea;
var
A: TRealArea;
begin
if not(BBoxSet) then
begin
GetArea(FBoundingBox);
BBoxSet := true;
end;
Result := FBoundingBox;
end;
procedure TGPSObj.SetBoundingBox(AValue: TRealArea);
begin
FBoundingBox := AValue;
BBoxSet := true;
GetArea(A);
Result := A;
end;
destructor TGPSObj.Destroy;
@ -408,6 +403,11 @@ begin
end;
end;
procedure TGPSObjectList.Draw(AView: TObject; Area: TRealArea);
begin
//;
end;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList;
var
i: integer;
@ -628,7 +628,7 @@ begin
end;
end;
function TGPSObjectList.FindTrackByID(const ID: Integer): TGpsTrack;
function TGPSObjectList.FindTrackByID(const id: Integer): TGpsTrack;
var
i: Integer;
begin
@ -686,6 +686,11 @@ begin
end;
end;
procedure TGPSTrack.Draw(AView: TObject; Area: TRealArea);
begin
TMapView(AView).DrawTrack(Area, Self);
end;
function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;
var
i: integer;
@ -698,7 +703,7 @@ end;
{ TGPSPoint }
procedure TGPSPoint.Assign(AObj: TGpsObj);
procedure TGPSPoint.Assign(AObj: TGPSObj);
begin
if (AObj is TGPSPoint) then
begin
@ -725,6 +730,11 @@ begin
Area.BottomRight := FRealPt;
end;
procedure TGPSPoint.Draw(AView: TObject; Area: TRealArea);
begin
TMapView(AView).DrawPt(Area, Self);
end;
function TGPSPoint.HasElevation: boolean;
begin
Result := FElevation <> NO_ELE;
@ -796,6 +806,11 @@ begin
FImageIndex := -1;
end;
procedure TGPSPointOfInterest.Draw(AView: TObject; Area: TRealArea);
begin
TMapView(AView).DrawPointOfInterest(Area, Self);
end;
end.

11
components/lazmapviewer/source/mvjobqueue.pas
View File

@ -107,8 +107,8 @@ type
implementation
const
WAIT_TIME = 3000;
TERMINATE_TIMEOUT = 1000;
WAIT_TIME = 300;
TERMINATE_TIMEOUT = WAIT_TIME * 2;
type
@ -297,7 +297,6 @@ begin
end
else
begin
MyQueue.FEvent.ResetEvent;
if not(RestartTask) then
MyQueue.pTaskStarted(aJob, TaskId);
end;
@ -366,7 +365,7 @@ var
begin
Jobs := TObjectList.Create(true);
Threads := TObjectList.Create(true);
FEvent := TEvent.Create(nil,true,false,'');
FEvent := TEvent.Create(Nil, False, False,'');
FSect := TCriticalSection.Create;
TerminatedThread := 0;
for i:=1 to FNbThread do
@ -383,9 +382,11 @@ begin
try
FEvent.SetEvent;
TerminatedThread := 0;
for i:=0 to pred(Threads.Count) do
for i := 0 to Pred(Threads.Count) do
TQueueThread(Threads[i]).Terminate;
TerminateEvent.WaitFor(TERMINATE_TIMEOUT);
for i := 0 to Pred(Threads.Count) do
TQueueThread(Threads[i]).WaitFor;
FreeAndNil(FSect);
FreeAndNil(FEvent);
FreeAndNil(Threads);

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

@ -23,7 +23,7 @@ interface
uses
Classes, SysUtils, Controls, Graphics, FPImage, IntfGraphics, Forms, ImgList, LCLVersion,
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine;
MvTypes, MvGPSObj, MvEngine, MvMapProvider, MvDownloadEngine, MvDrawingEngine, mvCache;
Type
@ -54,9 +54,7 @@ Type
procedure CallAsyncInvalidate;
procedure DoAsyncInvalidate({%H-}Data: PtrInt);
procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
procedure DrawPointOfInterest(const {%H-}Area: TRealArea; APt: TGPSPointOfInterest);
procedure DrawPt(const {%H-}Area: TRealArea; APt: TGPSPoint);
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
procedure DrawGpsObj(const {%H-}Area: TRealArea; AObj: TGPSObj);
function GetCacheOnDisk: boolean;
function GetCachePath: String;
function GetCenter: TRealPoint;
@ -108,6 +106,7 @@ Type
procedure DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer; TileImg: TLazIntfImage; const R: TRect);
procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
procedure DoDrawTileInfo(const {%H-}TileID: TTileID; X,Y: Integer);
procedure DoTileDownloaded(const TileId: TTileId);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
@ -124,6 +123,9 @@ Type
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure DrawPointOfInterest(const {%H-}Area: TRealArea; APt: TGPSPointOfInterest);
procedure DrawPt(const {%H-}Area: TRealArea; APt: TGPSPoint);
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
procedure ClearBuffer;
procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea;
@ -266,13 +268,7 @@ var
begin
iObj := aTask-1;
Obj := FLst[iObj];
if Obj.InheritsFrom(TGPSTrack) then
Viewer.DrawTrack(FArea, TGPSTrack(Obj));
if Obj.InheritsFrom(TGPSPointOfInterest) then
Viewer.DrawPointOfInterest(FArea, TGPSPointOfInterest(Obj))
else
if Obj.InheritsFrom(TGPSPoint) then
Viewer.DrawPt(FArea, TGPSPoint(Obj));
Viewer.DrawGpsObj(FArea, Obj);
end;
function TDrawObjJob.Running: boolean;
@ -295,8 +291,6 @@ destructor TDrawObjJob.Destroy;
begin
inherited Destroy;
FreeAndNil(FLst);
if not(Cancelled) then
Viewer.CallAsyncInvalidate;
end;
@ -557,6 +551,7 @@ begin
Result:=inherited DoMouseWheel(Shift, WheelDelta, MousePos);
if IsActive then
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
Invalidate;
end;
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
@ -565,6 +560,7 @@ begin
inherited MouseDown(Button, Shift, X, Y);
if IsActive then
Engine.MouseDown(self,Button,Shift,X,Y);
Invalidate;
end;
procedure TMapView.MouseUp(Button: TMouseButton; Shift: TShiftState;
@ -573,6 +569,7 @@ begin
inherited MouseUp(Button, Shift, X, Y);
if IsActive then
Engine.MouseUp(self,Button,Shift,X,Y);
Invalidate;
end;
procedure TMapView.MouseMove(Shift: TShiftState; X, Y: Integer);
@ -580,6 +577,7 @@ begin
inherited MouseMove(Shift, X, Y);
if IsActive then
Engine.MouseMove(self,Shift,X,Y);
Invalidate;
end;
procedure TMapView.Notification(AComponent: TComponent; Operation: TOperation);
@ -594,6 +592,7 @@ begin
inherited DblClick;
if IsActive then
Engine.DblClick(self);
Invalidate;
end;
procedure TMapView.DoOnResize;
@ -604,13 +603,18 @@ begin
DrawingEngine.CreateBuffer(ClientWidth, ClientHeight);
if IsActive then
Engine.SetSize(ClientWidth, ClientHeight);
Invalidate;
end;
procedure TMapView.Paint;
begin
inherited Paint;
if IsActive then
DrawingEngine.PaintToCanvas(Canvas)
begin
Engine.Redraw;
DrawObjects(Default(TTileId), 0, 0, Canvas.Width, Canvas.Height);
DrawingEngine.PaintToCanvas(Canvas);
end
else
begin
Canvas.Brush.Color := InactiveColor;
@ -631,7 +635,7 @@ begin
if hasIntersectArea(objArea, visArea) then
begin
Area := IntersectArea(objArea, visArea);
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, Objs, Area), Engine);
Invalidate;
end
else
objs.Free;
@ -654,8 +658,6 @@ begin
if not trk.Visible or (trk.Points.Count = 0) then
exit;
GPSItems.Lock;
try
// Determine track color
if trk.LineColor = clDefault then
begin
@ -687,9 +689,6 @@ begin
pt1 := pt2;
iPt1 := iPt2;
end;
finally
GPSItems.Unlock;
end;
end;
procedure TMapView.DrawPointOfInterest(const Area: TRealArea; APt: TGPSPointOfInterest);
@ -701,8 +700,6 @@ var
bmp: TBitmap;
w, h: Integer;
begin
GPSItems.Lock;
try
pt := Engine.LonLatToScreen(APt.RealPoint);
// Draw point as symbol from image list ...
@ -746,9 +743,6 @@ begin
end;
extent := DrawingEngine.TextExtent(s);
DrawingEngine.TextOut(pt.X - extent.CX div 2, pt.Y + 5, s);
finally
GPSItems.Unlock;
end;
end;
procedure TMapView.DrawPt(const Area: TRealArea; APt: TGPSPoint);
@ -758,8 +752,6 @@ var
extent: TSize;
s: String;
begin
GPSItems.Lock;
try
if Assigned(FOnDrawGpsPoint) then begin
FOnDrawGpsPoint(Self, DrawingEngine, APt);
exit;
@ -796,6 +788,13 @@ begin
extent := DrawingEngine.TextExtent(s);
DrawingEngine.Textout(Pt.X - extent.CX div 2, Pt.Y + 5, s);
end;
procedure TMapView.DrawGpsObj(const Area: TRealArea; AObj: TGPSObj);
begin
GPSItems.Lock;
try
AObj.Draw(Self, Area);
finally
GPSItems.Unlock;
end;
@ -815,22 +814,25 @@ procedure TMapView.DrawObjects(const TileId: TTileId;
var
Area: TRealArea;
lst: TGPSObjList;
I: Integer;
begin
Area.TopLeft := Engine.ScreenToLonLat(Point(aLeft, aTop));
Area.BottomRight := Engine.ScreenToLonLat(Point(aRight, aBottom));
if GPSItems.Count > 0 then
begin
lst := GPSItems.GetObjectsInArea(Area);
try
if lst.Count > 0 then
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, lst, Area), Engine)
else
begin
for I := 0 to Pred(lst.Count) do
DrawGpsObj(Area, lst[I]);
end;
finally
FreeAndNil(Lst);
CallAsyncInvalidate;
end;
end
else
CallAsyncInvalidate;
;
end;
procedure TMapView.DoAsyncInvalidate(Data: PtrInt);
@ -839,7 +841,7 @@ Begin
AsyncInvalidate := false;
end;
procedure TMapView.DoDrawStretchedTile(const TileId: TTileId; X, Y: Integer;
procedure TMapView.DoDrawStretchedTile(const TileId: TTileID; X, Y: Integer;
TileImg: TLazIntfImage; const R: TRect);
begin
if Assigned(TileImg) then
@ -850,7 +852,6 @@ begin
if FDebugTiles then
DoDrawTileInfo(TileID, X, Y);
DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
@ -864,7 +865,6 @@ begin
if FDebugTiles then
DoDrawTileInfo(TileID, X, Y);
DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
procedure TMapView.DoDrawTileInfo(const TileID: TTileID; X, Y: Integer);
@ -877,6 +877,12 @@ begin
DrawingEngine.Line(X, Y + TILE_SIZE, X + TILE_SIZE, Y + TILE_SIZE);
end;
procedure TMapView.DoTileDownloaded(const TileId: TTileId);
begin
// TODO: Include tile information to optimize redraw.
CallAsyncInvalidate;
end;
function TMapView.IsActive: Boolean;
begin
if not(csDesigning in ComponentState) then
@ -911,6 +917,7 @@ begin
FEngine.CacheOnDisk := true;
FEngine.OnDrawTile := @DoDrawTile;
FEngine.OnDrawStretchedTile := @DoDrawStretchedTile;
FEngine.OnTileDownloaded := @DoTileDownloaded;
FEngine.DrawPreviewTiles := True;
FEngine.DrawTitleInGuiThread := false;
FEngine.DownloadEngine := FBuiltinDownloadEngine;
@ -1054,7 +1061,7 @@ end;
procedure TMapView.Redraw;
begin
Engine.Redraw;
Invalidate;
end;
function TMapView.GetVisibleArea: TRealArea;