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

lazmapviewer: Cosmetic changes

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6809 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-01-27 18:44:08 +00:00
parent f962f9a439
commit 70aa57d3bb
9 changed files with 634 additions and 682 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -22,7 +22,8 @@ unit mvCache;
interface
uses
Classes, SysUtils,mvmapprovider,IntfGraphics,syncObjs,mvtypes;
Classes, SysUtils, IntfGraphics, syncObjs,
mvMapProvider, mvTypes;
Type
@ -45,7 +46,7 @@ Type
Function MapProvider2FileName(MapProvider: TMapProvider): String;
Function DiskCached(const aFileName: String): Boolean;
procedure LoadFromDisk(const aFileName: String; out img: TLazIntfImage);
Function GetFileName(MapProvider: TMapProvider;const TileId: TTileId): String;
Function GetFileName(MapProvider: TMapProvider; const TileId: TTileId): String;
public
Procedure CheckCacheSize(Sender: TObject);
constructor Create(aOwner: TComponent); override;

109
components/lazmapviewer/source/mvdragobj.pas
View File

@ -31,7 +31,7 @@ Type
{ TDragObj }
TDragObj = Class
TDragObj = class
private
FMouseDown : boolean;
FLnkObj: TObject;
@ -50,76 +50,75 @@ Type
procedure SetOnDrag(AValue: TDragEvent);
procedure SetOnEndDrag(AValue: TDragEvent);
Procedure DostartDrag(X,Y : Integer);
Procedure DoDrag(X,Y : integer);
Procedure DoEndDrag(X,Y : integer);
Function HasMoved(X,Y : integer) : Boolean;
Procedure DostartDrag(X,Y: Integer);
Procedure DoDrag(X,Y: integer);
Procedure DoEndDrag(X,Y: integer);
Function HasMoved(X,Y: integer) : Boolean;
Procedure AbortDrag;
public
Procedure MouseDown(aDragSrc : TObject;X,Y : integer);
Procedure MouseUp(X,Y : integer);
Procedure MouseMove(X,Y : integer);
Procedure MouseDown(aDragSrc: TObject; X,Y: integer);
Procedure MouseUp(X,Y: integer);
Procedure MouseMove(X,Y: integer);
property OnDrag : TDragEvent read FOnDrag write SetOnDrag;
property OnEndDrag : TDragEvent read FOnEndDrag write SetOnEndDrag;
property OnDrag: TDragEvent read FOnDrag write SetOnDrag;
property OnEndDrag: TDragEvent read FOnEndDrag write SetOnEndDrag;
property OfsX : integer read FOfsX;
property OfsY : integer read FOfsY;
property StartX : integer read FStartX;
property StartY : integer read FStartY;
property MouseX : Integer read FMouseX;
property MouseY : integer read FMouseY;
property EndX : integer read FEndX;
property EndY : integer read FEndY;
Property LnkObj : TObject Read FLnkObj write SetLnkObj;
property DragSrc : TObject Read FStartSrc;
property OfsX: integer read FOfsX;
property OfsY: integer read FOfsY;
property StartX: integer read FStartX;
property StartY: integer read FStartY;
property MouseX: Integer read FMouseX;
property MouseY: integer read FMouseY;
property EndX: integer read FEndX;
property EndY: integer read FEndY;
Property LnkObj: TObject Read FLnkObj write SetLnkObj;
property DragSrc: TObject Read FStartSrc;
end;
implementation
{ TDragObj }
procedure TDragObj.SetDest(X, Y: Integer);
begin
FEndX:=X;
FEndY:=Y;
FOfsX:=FEndX-FstartX;
FOfsY:=FEndY-FstartY;
FEndX := X;
FEndY := Y;
FOfsX := FEndX-FstartX;
FOfsY := FEndY-FstartY;
end;
procedure TDragObj.SetLnkObj(AValue: TObject);
begin
if FLnkObj=AValue then Exit;
FreeAndNil(FLnkObj);
FLnkObj:=AValue;
FLnkObj := AValue;
end;
procedure TDragObj.SetOnDrag(AValue: TDragEvent);
begin
if FOnDrag=AValue then Exit;
FOnDrag:=AValue;
FOnDrag := AValue;
end;
procedure TDragObj.SetOnEndDrag(AValue: TDragEvent);
begin
if FOnEndDrag=AValue then Exit;
FOnEndDrag:=AValue;
FOnEndDrag := AValue;
end;
procedure TDragObj.DostartDrag(X, Y: Integer);
begin
InDrag:=True;
FStartSrc := FDragSrc;
DoDrag(X,Y);
InDrag := True;
FStartSrc := FDragSrc;
DoDrag(X,Y);
end;
procedure TDragObj.DoDrag(X, Y: integer);
begin
if (X<>FEndX) or (Y<>FEndY) then
Begin
begin
SetDest(X,Y);
if Assigned(FOnDrag) then
FOnDrag(Self);
@ -133,12 +132,12 @@ begin
FOnEndDrag(self);
FreeAndNil(FLnkObj);
FStartSrc := nil;
InDrag:=False;
InDrag := False;
end;
function TDragObj.HasMoved(X, Y: integer): Boolean;
begin
Result:=(X<>FStartX) or (Y<>FStartY);
Result := (X <> FStartX) or (Y <> FStartY);
end;
procedure TDragObj.AbortDrag;
@ -146,8 +145,8 @@ begin
if InDrag then
Begin
DoDrag(FstartX,FStartY);
InDrag:=False;
FMouseDown:=False;
InDrag := False;
FMouseDown := False;
FDragSrc :=nil;
FStartSrc := nil;
FreeAndNil(FLnkObj);
@ -157,16 +156,16 @@ end;
procedure TDragObj.MouseDown(aDragSrc : TObject;X, Y: integer);
begin
if not(FMouseDown) then
Begin
FDragSrc := aDragSrc;
FMouseDown := True;
FStartX := X;
FStartY := Y;
FEndX := X;
FEndY := Y;
End
Else
AbortDrag;
begin
FDragSrc := aDragSrc;
FMouseDown := True;
FStartX := X;
FStartY := Y;
FEndX := X;
FEndY := Y;
end
else
AbortDrag;
end;
@ -175,13 +174,13 @@ begin
FMouseX := X;
FMouseY := Y;
if FMouseDown then
Begin
begin
if InDrag then
DoDrag(X,Y)
DoDrag(X,Y)
else
Begin
if HasMoved(X,Y) then
DoStartDrag(X,Y);
begin
if HasMoved(X,Y) then
DoStartDrag(X,Y);
end;
end;
end;
@ -190,10 +189,10 @@ end;
procedure TDragObj.MouseUp(X, Y: integer);
begin
if FMouseDown then
Begin
FMouseDown:=False;
begin
FMouseDown := False;
if InDrag then
DoEndDrag(X,Y);
DoEndDrag(X,Y);
FDragSrc := nil;
end;
end;

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

@ -39,7 +39,8 @@ const
Type
TDrawTileEvent = Procedure (const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage) of object;
TDrawTileEvent = Procedure (const TileId: TTileId; X,Y: integer;
TileImg: TLazIntfImage) of object;
TTileIdArray = Array of TTileId;
@ -49,7 +50,7 @@ Type
MapProvider: TMapProvider;
X: Int64;
Y: Int64;
Center : TRealPoint;
Center: TRealPoint;
Zoom: integer;
Height: integer;
Width: integer;
@ -100,21 +101,21 @@ Type
function IsCurrentWin(const aWin: TMapWindow) : boolean;
protected
procedure ConstraintZoom(var aWin: TMapWindow);
function GetTileName(const Id: TTileId) : String;
procedure evDownload(Data: TObject;Job : TJob);
function GetTileName(const Id: TTileId): String;
procedure evDownload(Data: TObject; Job: TJob);
procedure TileDownloaded(Data: PtrInt);
Procedure RegisterProviders;
Procedure DrawTile(const TileId : TTileId;X,Y : integer;TileImg : TLazIntfImage);
Procedure DrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
function GetLetterSvr(id: integer): String;
function GetYahooSvr(id: integer): String;
function GetYahooY(const Tile : TTileId): string;
function GetYahooZ(const Tile : TTileId): string;
function GetQuadKey(const Tile : TTileId): string;
function GetYahooY(const Tile: TTileId): string;
function GetYahooZ(const Tile: TTileId): string;
function GetQuadKey(const Tile: TTileId): string;
Procedure DoDrag(Sender : TDragObj);
Procedure DoDrag(Sender: TDragObj);
public
constructor Create(aOwner : TComponent);override;
constructor Create(aOwner: TComponent); override;
destructor Destroy; override;
function AddMapProvider(OpeName: String; Url: String;
@ -133,11 +134,12 @@ Type
procedure DblClick(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; {%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; {%H-}Shift: TShiftState;
X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
{%H-}Shift: TShiftState; X, Y: Integer);
procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState; WheelDelta: Integer;
{%H-}MousePos: TPoint; var Handled: Boolean);
procedure MouseWheel(Sender: TObject; {%H-}Shift: TShiftState;
WheelDelta: Integer; {%H-}MousePos: TPoint; var Handled: Boolean);
procedure ZoomOnArea(const aArea: TRealArea);
property Center: TRealPoint read GetCenter write SetCenter;
@ -146,8 +148,10 @@ Type
property Active: Boolean read FActive write SetActive default false;
property CacheOnDisk: Boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath;
property DownloadEngine: TMvCustomDownloadEngine read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property DownloadEngine: TMvCustomDownloadEngine
read FDownloadEngine write SetDownloadEngine;
property DrawTitleInGuiThread: boolean
read FDrawTitleInGuiThread write FDrawTitleInGuiThread;
property Height: integer read GetHeight write SetHeight;
property JobQueue: TJobQueue read Queue;
property MapProvider: String read GetMapProvider write SetMapProvider;
@ -161,6 +165,7 @@ Type
property OnZoomChange: TNotifyEvent read FOnZoomChange write FOnZoomChange;
end;
implementation
uses
@ -171,7 +176,7 @@ type
{ TLaunchDownloadJob }
TLaunchDownloadJob = Class(TJob)
TLaunchDownloadJob = class(TJob)
private
AllRun: boolean;
Win: TMapWindow;
@ -180,14 +185,15 @@ type
FTiles: TTileIdArray;
FStates: Array of integer;
protected
function pGetTask: integer;override;
procedure pTaskStarted(aTask: integer);override;
procedure pTaskEnded(aTask: integer; aExcept: Exception);override;
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;
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean; override;
public
Constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray; const aWin: TMapWindow);
constructor Create(Eng: TMapViewerEngine; const Tiles: TTileIdArray;
const aWin: TMapWindow);
end;
@ -295,7 +301,7 @@ end;
{ TEnvTile }
constructor TEnvTile.Create(const aTile : TTileId;Const aWin : TMapWindow);
constructor TEnvTile.Create(const aTile: TTileId; const aWin: TMapWindow);
begin
Tile := aTile;
Win := aWin;
@ -336,7 +342,7 @@ end;
function TMapViewerEngine.AddMapProvider(OpeName: String; Url: String;
MinZoom, MaxZoom, NbSvr: integer; GetSvrStr: TGetSvrStr; GetXStr: TGetValStr;
GetYStr: TGetValStr; GetZStr: TGetValStr) : TMapProvider;
GetYStr: TGetValStr; GetZStr: TGetValStr): TMapProvider;
var
idx :integer;
Begin
@ -357,8 +363,8 @@ var
begin
MaxX := (Int64(aWin.Width) div TILE_SIZE) + 1;
MaxY := (Int64(aWin.Height) div TILE_SIZE) + 1;
startX := (-(aWin.X)) div TILE_SIZE;
startY := (-(aWin.Y)) div TILE_SIZE;
startX := -aWin.X div TILE_SIZE;
startY := -aWin.Y div TILE_SIZE;
Result.Left := startX;
Result.Right := startX + MaxX;
Result.Top := startY;
@ -712,10 +718,8 @@ var
nCenter: TRealPoint;
aPt: TPoint;
Begin
if Sender.LnkObj=nil then
begin
if Sender.LnkObj = nil then
Sender.LnkObj := TMemObj.Create(MapWin);
end;
old := TMemObj(Sender.LnkObj);
aPt.X := old.FWin.Width DIV 2-Sender.OfsX;
aPt.Y := old.FWin.Height DIV 2-Sender.OfsY;
@ -757,7 +761,7 @@ end;
procedure TMapViewerEngine.RegisterProviders;
begin
AddMapProvider('Aucun','',0,30, 0);
AddMapProvider('Aucun','',0,30, 0);
{
AddMapProvider('Google Satellite','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4);
AddMapProvider('Google Hybrid','http://khm%d.google.com/kh/v=82&x=%x%&y=%y%&z=%z%&s=Ga',4);
@ -771,7 +775,7 @@ begin
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/ae/ximg?v=1.9&t=a&s=256&.intl=en&x=%x%&y=%y%&z=%z%&r=1', 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
//AddMapProvider('Yahoo Hybrid','http://maps%serv%.yimg.com/hx/tl?b=1&v=4.3&t=h&.intl=en&x=%x%&y=%y%&z=%z%&r=1' , 0,20,3,@GetYahooSvr, nil, @getYahooY, @GetYahooZ); //[Random(3)+1, X, YahooY(Y), Z+1]));
// opeName, Url, MinZoom, MaxZoom, NbSvr, GetSvrStr, GetXStr, GetYStr, GetZStr
// opeName, Url, MinZoom, MaxZoom, NbSvr, GetSvrStr, GetXStr, GetYStr, GetZStr
MapWin.MapProvider := AddMapProvider('OpenStreetMap Mapnik',
'http://%serv%.tile.openstreetmap.org/%z%/%x%/%y%.png',
0, 19, 3, @GetLetterSvr);
@ -877,7 +881,7 @@ var
begin
idx := lstProvider.IndexOf(aValue);
if not ((aValue = '') or (idx <> -1)) then
raise Exception.Create('Unknow Provider : ' + aValue);
raise Exception.Create('Unknow Provider: ' + aValue);
if Assigned(MapWin.MapProvider) and (MapWin.MapProvider.Name = AValue) then Exit;
if idx <> -1 then
begin

18
components/lazmapviewer/source/mvextradata.pas
View File

@ -5,7 +5,7 @@ unit mvExtraData;
interface
uses
Classes, SysUtils,graphics;
Classes, SysUtils, graphics;
type
@ -17,26 +17,26 @@ type
FId: integer;
procedure SetColor(AValue: TColor);
public
constructor Create(aId : integer);virtual;
property Color : TColor read FColor write SetColor;
property Id : integer read FId;
constructor Create(aId: integer);virtual;
property Color: TColor read FColor write SetColor;
property Id: integer read FId;
End;
implementation
{ TDrawingExtraData }
procedure TDrawingExtraData.SetColor(AValue: TColor);
begin
if FColor=AValue then Exit;
FColor:=AValue;
if FColor = AValue then Exit;
FColor := AValue;
end;
constructor TDrawingExtraData.Create(aId: integer);
begin
FId:=aId;
FColor:=clRed;
FId := aId;
FColor := clRed;
end;
end.

88
components/lazmapviewer/source/mvgeonames.pas
View File

@ -62,7 +62,7 @@ type
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
published
property LocationName: string read FLocationName;
property OnNameFound : TNameFoundEvent read FOnNameFound write FOnNameFound;
property OnNameFound: TNameFoundEvent read FOnNameFound write FOnNameFound;
end;
@ -195,51 +195,13 @@ begin
parser.Free;
end;
end;
(*
function TMVGeoNames.RemoveTag(Const str : String) : TStringArray;
var iStart,iEnd,i : Integer;
tmp : String;
lst : TStringList;
Begin
SetLength(Result,0);
tmp := StringReplace(str,'<br>',#13,[rfReplaceall]);
tmp := StringReplace(tmp,'&nbsp;',' ',[rfReplaceall]);
tmp := StringReplace(tmp,' ',' ',[rfReplaceall]);
repeat
iEnd:=-1;
iStart:=pos('<',tmp);
if iStart>0 then
Begin
iEnd:=posEx('>',tmp,iStart);
if iEnd>0 then
Begin
tmp:=copy(tmp,1,iStart-1)+copy(tmp,iEnd+1,length(tmp));
end;
end;
until iEnd<=0;
lst:=TStringList.Create;
try
lst.Text:=tmp;
SetLEngth(Result,lst.Count);
For i:=0 to pred(lst.Count) do
Result[i]:=trim(lst[i]);
finally
freeAndNil(lst);
end;
end;
*)
function TMVGeoNames.Search(ALocationName: String;
ADownloadEngine: TMvCustomDownloadEngine): TRealPoint;
{
const
LAT_ID = '<span class="latitude">';
LONG_ID = '<span class="longitude">';
}
var
s: string;
function gs(id: string;Start : integer): string;
function gs(id: string; Start: integer): string;
var
i: Integer;
ln: Integer;
@ -260,12 +222,6 @@ var
var
ms: TMemoryStream;
url: String;
{
iRes,i : integer;
lstRes : Array of TResRec;
iStartDescr : integer;
lst : TStringArray;
}
begin
FLocationName := ALocationName;
ms := TMemoryStream.Create;
@ -280,46 +236,6 @@ begin
end;
Result := Parse(PChar(s));
{
Result.Lon := 0;
Result.Lat := 0;
SetLength(lstRes, 0);
iRes := Pos('<span class="geo"',s);
while (iRes>0) do
begin
SetLength(lstRes,length(lstRes)+1);
lstRes[high(lstRes)].Loc.Lon := StrToFloat(gs(LONG_ID,iRes));
lstRes[high(lstRes)].Loc.Lat := StrToFloat(gs(LAT_ID,iRes));
iStartDescr := RPosex('<td>',s,iRes);
if iStartDescr>0 then
begin
lst:=RemoveTag(Copy(s,iStartDescr,iRes-iStartDescr));
if length(lst)>0 then
lstRes[high(lstRes)].Name:=lst[0];
lstRes[high(lstRes)].Descr:='';
for i:=1 to high(lst) do
lstRes[high(lstRes)].Descr+=lst[i];
end;
Result.Lon += lstRes[high(lstRes)].Loc.Lon;
Result.Lat += lstRes[high(lstRes)].Loc.Lat;
iRes := PosEx('<span class="geo"',s,iRes+17);
end;
if Length(lstRes) > 0 then
begin
if Length(lstRes) > 1 then
begin
Result.Lon := Result.Lon/length(lstRes);
Result.Lat := Result.Lat/length(lstRes);
end;
if Assigned(FOnNameFound) then
for iRes:=low(lstRes) to high(lstRes) do
begin
FOnNameFound(lstRes[iRes].Name, lstRes[iRes].Descr, lstRes[iRes].Loc);
end;
end;
}
end;
end.

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

@ -23,151 +23,159 @@ interface
uses
Classes, SysUtils,fgl,mvtypes,contnrs,syncobjs;
const
NO_ELE = -10000000;
NO_DATE = 0;
type
TIdArray = Array of integer;
TIdArray = Array of integer;
{ TGPSObj }
{ TGPSObj }
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 GetArea(out Area : TRealArea);virtual;abstract;
property Name : String read FName write FName;
property ExtraData : TObject read FExtraData write SetExtraData;
property BoundingBox : TRealArea read GetBoundingBox write SetBoundingBox;
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 GetArea(out Area: TRealArea); virtual; abstract;
property Name: String read FName write FName;
property ExtraData: TObject read FExtraData write SetExtraData;
property BoundingBox: TRealArea read GetBoundingBox write SetBoundingBox;
end;
end;
TGPSObjarray = Array of TGPSObj;
TGPSObjarray = Array of TGPSObj;
{ TGPSPoint }
{ TGPSPoint }
TGPSPoint = class(TGPSObj)
private
FRealPt: TRealPoint;
FEle: Double;
FDateTime: TDateTime;
function GetLat: Double;
function GetLon: Double;
public
constructor Create(ALon,ALat : double;AEle : double=NO_ELE;ADateTime : TDateTime=NO_DATE);
class function CreateFrom(aPt: TRealPoint): TGPSPoint;
TGPSPoint = Class(TGPSObj)
private
FRealPt : TRealPoint;
FEle : Double;
FDateTime : TDateTime;
function GetLat: Double;
function GetLon: Double;
public
Procedure GetArea(out Area : TRealArea);override;
Function HasEle : boolean;
Function HasDateTime : Boolean;
Function DistanceInKmFrom(OtherPt : TGPSPoint;UseEle : boolean=true) : double;
constructor Create(ALon,ALat : double;AEle : double=NO_ELE;ADateTime : TDateTime=NO_DATE);
Class function CreateFrom(aPt : TRealPoint) : TGPSPoint;
procedure GetArea(out Area: TRealArea);override;
function HasEle: boolean;
function HasDateTime: Boolean;
function DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean=true): double;
property Lon : Double read GetLon;
property Lat : Double read GetLat;
property Ele : double read FEle;
property DateTime : TDateTime read FDateTime;
property RealPoint : TRealPoint read FRealPt;
end;
property Lon: Double read GetLon;
property Lat: Double read GetLat;
property Ele: double read FEle;
property DateTime: TDateTime read FDateTime;
property RealPoint: TRealPoint read FRealPt;
end;
TGPSPointList = specialize TFPGObjectList<TGPSPoint>;
TGPSPointList = specialize TFPGObjectList<TGPSPoint>;
{ TGPSTrack }
{ TGPSTrack }
TGPSTrack = Class(TGPSObj)
private
FDateTime: TDateTime;
FPoints : TGPSPointList;
function GetDateTime: TDateTime;
public
constructor Create;
destructor Destroy;override;
TGPSTrack = class(TGPSObj)
private
FDateTime: TDateTime;
FPoints: TGPSPointList;
function GetDateTime: TDateTime;
public
constructor Create;
destructor Destroy; override;
Procedure GetArea(out Area : TRealArea);override;
Function TrackLengthInKm(UseEle : Boolean=true) : double;
procedure GetArea(out Area: TRealArea); override;
function TrackLengthInKm(UseEle: Boolean=true): double;
property Points : TGPSPointList read FPoints;
property DateTime : TDateTime read GetDateTime write FDateTime;
end;
property Points: TGPSPointList read FPoints;
property DateTime: TDateTime read GetDateTime write FDateTime;
end;
TGPSObjList_ = specialize TFPGObjectList<TGPSObj>;
TGPSObjList_ = specialize TFPGObjectList<TGPSObj>;
{ TGPSObjList }
{ TGPSObjList }
TGPSObjList = class(TGPSObjList_)
private
FRef : TObject;
public
Destructor Destroy;override;
end;
TGPSObjList = class(TGPSObjList_)
private
FRef: TObject;
public
destructor Destroy; override;
end;
{ TGPSObjectList }
TModifiedEvent = procedure (Sender : TObject;objs : TGPSObjList;Adding : boolean) of object;
{ TGPSObjectList }
TGPSObjectList = Class(TGPSObj)
private
Crit: TCriticalSection;
FPending: TObjectList;
FRefCount: integer;
FOnModified: TModifiedEvent;
FUpdating: integer;
FItems: TGPSObjList;
function Getcount: integer;
protected
Procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
Procedure FreePending;
Procedure DecRef;
procedure Lock;
procedure UnLock;
procedure CallModified(lst: TGPSObjList; Adding: boolean);
property Items : TGPSObjList read FItems;
procedure IdsToObj(const Ids : TIdArray; out objs: TGPSObjArray;IdOwner : integer);
public
Procedure GetArea(out Area : TRealArea);override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
constructor Create;
destructor Destroy;override;
Procedure Clear(OwnedBy : integer);
procedure ClearExcept(OwnedBy : integer;const ExceptLst : TIdArray;out Notfound : TIdArray);
function GetIdsArea(const Ids : TIdArray;IdOwner : integer) : TRealArea;
TModifiedEvent = procedure (Sender: TObject; objs: TGPSObjList;
Adding: boolean) of object;
function Add(aItem : TGpsObj;IdOwner : integer) : integer;
Procedure DeleteById(const Ids : Array of integer);
TGPSObjectList = class(TGPSObj)
private
Crit: TCriticalSection;
FPending: TObjectList;
FRefCount: integer;
FOnModified: TModifiedEvent;
FUpdating: integer;
FItems: TGPSObjList;
function GetCount: integer;
protected
procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
procedure FreePending;
procedure DecRef;
procedure Lock;
procedure UnLock;
procedure CallModified(lst: TGPSObjList; Adding: boolean);
property Items: TGPSObjList read FItems;
procedure IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray; IdOwner: integer);
public
constructor Create;
destructor Destroy; override;
Procedure Clear(OwnedBy: integer);
procedure ClearExcept(OwnedBy: integer; const ExceptLst: TIdArray;
out Notfound: TIdArray);
procedure GetArea(out Area: TRealArea); override;
function GetObjectsInArea(const Area: TRealArea): TGPSObjList;
function GetIdsArea(const Ids: TIdArray; IdOwner: integer): TRealArea;
Procedure BeginUpdate;
Procedure EndUpdate;
function Add(aItem: TGpsObj; IdOwner: integer): integer;
procedure DeleteById(const Ids: Array of integer);
property Count : integer read Getcount;
property OnModified : TModifiedEvent read FOnModified write FOnModified;
end;
procedure BeginUpdate;
procedure EndUpdate;
function hasIntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : boolean;
function IntersectArea(const Area1 : TRealArea;const Area2 : TRealArea) : TRealArea;
function PtInsideArea(const aPoint : TRealPoint;const Area : TRealArea) : boolean;
Function AreaInsideArea(const AreaIn : TRealArea;const AreaOut : TRealArea) : boolean;
Procedure ExtendArea(var AreaToExtend : TRealArea;Const Area : TRealArea);
Function GetAreaOf(objs : TGPSObjList) : TRealArea;
property Count: integer read GetCount;
property OnModified: TModifiedEvent read FOnModified write FOnModified;
end;
function HasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
function GetAreaOf(objs: TGPSObjList): TRealArea;
implementation
uses mvextradata;
uses
mvExtraData;
function hasIntersectArea(const Area1: TRealArea; const Area2: TRealArea): boolean;
begin
Result:=(Area1.TopLeft.Lon<=Area2.BottomRight.Lon) and (Area1.BottomRight.Lon>=Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat>=Area2.BottomRight.Lat) and (Area1.BottomRight.Lat<=Area2.TopLeft.Lat);
Result := (Area1.TopLeft.Lon <= Area2.BottomRight.Lon) and
(Area1.BottomRight.Lon >= Area2.TopLeft.Lon) and
(Area1.TopLeft.Lat >= Area2.BottomRight.Lat) and
(Area1.BottomRight.Lat <= Area2.TopLeft.Lat);
end;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea
): TRealArea;
function IntersectArea(const Area1: TRealArea; const Area2: TRealArea): TRealArea;
begin
Result:=Area1;
Result := Area1;
if Result.TopLeft.Lon<Area2.topLeft.Lon then
Result.TopLeft.Lon:=Area2.topLeft.Lon;
if Result.TopLeft.Lat>Area2.topLeft.Lat then
@ -180,15 +188,18 @@ end;
function PtInsideArea(const aPoint: TRealPoint; const Area: TRealArea): boolean;
begin
Result:=(Area.TopLeft.Lon<=aPoint.Lon) and (Area.BottomRight.Lon>=aPoint.Lon) and
(Area.TopLeft.Lat>=aPoint.Lat) and (Area.BottomRight.Lat<=aPoint.Lat);
Result := (Area.TopLeft.Lon <= aPoint.Lon) and
(Area.BottomRight.Lon >= aPoint.Lon) and
(Area.TopLeft.Lat >= aPoint.Lat) and
(Area.BottomRight.Lat <= aPoint.Lat);
end;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea
): boolean;
function AreaInsideArea(const AreaIn: TRealArea; const AreaOut: TRealArea): boolean;
begin
Result:=(AreaIn.TopLeft.Lon>=AreaOut.TopLeft.Lon) and (AreaIn.BottomRight.Lon<=AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat>=AreaIn.TopLeft.Lat) and (AreaOut.BottomRight.Lat<=AreaIn.BottomRight.Lat);
Result := (AreaIn.TopLeft.Lon >= AreaOut.TopLeft.Lon) and
(AreaIn.BottomRight.Lon <= AreaOut.BottomRight.Lon) and
(AreaOut.TopLeft.Lat >= AreaIn.TopLeft.Lat) and
(AreaOut.BottomRight.Lat <= AreaIn.BottomRight.Lat);
end;
procedure ExtendArea(var AreaToExtend: TRealArea; const Area: TRealArea);
@ -205,17 +216,18 @@ begin
end;
function GetAreaOf(objs: TGPSObjList): TRealArea;
var i : integer;
var
i: integer;
begin
Result.TopLeft.Lon:=0;
Result.TopLeft.Lat:=0;
Result.BottomRight.Lon:=0;
Result.BottomRight.Lat:=0;
Result.TopLeft.Lon := 0;
Result.TopLeft.Lat := 0;
Result.BottomRight.Lon := 0;
Result.BottomRight.Lat := 0;
if Objs.Count>0 then
Begin
Result:=Objs[0].BoundingBox;
For i:=1 to pred(Objs.Count) do
ExtendArea(Result,Objs[i].BoundingBox);
begin
Result := Objs[0].BoundingBox;
for i:=1 to pred(Objs.Count) do
ExtendArea(Result, Objs[i].BoundingBox);
end;
end;
@ -224,7 +236,7 @@ end;
destructor TGPSObjList.Destroy;
begin
if Assigned(FRef) then
TGPSObjectList(FRef).DecRef;
TGPSObjectList(FRef).DecRef;
inherited Destroy;
end;
@ -234,24 +246,24 @@ procedure TGPSObj.SetExtraData(AValue: TObject);
begin
if FExtraData=AValue then Exit;
if Assigned(FExtraData) then
FreeAndNil(FExtraData);
FExtraData:=AValue;
FreeAndNil(FExtraData);
FExtraData := AValue;
end;
function TGPSObj.GetBoundingBox: TRealArea;
begin
if not(BBoxSet) then
Begin
GetArea(FBoundingBox);
BBoxSet:=true;
begin
GetArea(FBoundingBox);
BBoxSet := true;
end;
Result:=FBoundingBox;
Result := FBoundingBox;
end;
procedure TGPSObj.SetBoundingBox(AValue: TRealArea);
begin
FBoundingBox:=AValue;
BBoxSet:=true;
FBoundingBox := AValue;
BBoxSet := true;
end;
destructor TGPSObj.Destroy;
@ -262,39 +274,39 @@ end;
{ TGPSObjectList }
function TGPSObjectList.Getcount: integer;
function TGPSObjectList.GetCount: integer;
begin
Result:=FItems.Count
Result := FItems.Count
end;
procedure TGPSObjectList._Delete(Idx: Integer; var DelLst: TGPSObjList); // wp: was "out"
var
Item: TGpsObj;
begin
Lock;
Try
if not(Assigned(DelLst)) then
Begin
DelLst:=TGpsObjList.Create(False);
DelLst.FRef:=Self;
inc(FRefCount);
end;
if not Assigned(FPending) then
FPending:=TObjectList.Create(true);
Item:=Items.Extract(Items[Idx]);
FPending.Add(Item);
finally
UnLock;
Lock;
try
if not(Assigned(DelLst)) then
begin
DelLst := TGpsObjList.Create(False);
DelLst.FRef := Self;
inc(FRefCount);
end;
DelLst.Add(Item);
if not Assigned(FPending) then
FPending := TObjectList.Create(true);
Item := Items.Extract(Items[Idx]);
FPending.Add(Item);
finally
UnLock;
end;
DelLst.Add(Item);
end;
procedure TGPSObjectList.FreePending;
begin
if Assigned(FPending) then
Begin
begin
Lock;
Try
try
FreeAndNil(FPending);
finally
UnLock;
@ -324,41 +336,42 @@ end;
procedure TGPSObjectList.CallModified(lst: TGPSObjList; Adding: boolean);
begin
if (FUpdating=0) and Assigned(FOnModified) then
FOnModified(self,lst,Adding)
FOnModified(self, lst, Adding)
else
lst.Free;
end;
procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;IdOwner : integer);
procedure TGPSObjectList.IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray;
IdOwner: integer);
function ToSelect(aId: integer): boolean;
var
i: integer;
begin
result:=false;
result := false;
for i:=low(Ids) to high(Ids) do
if Ids[i]=aId then
begin
result:=true;
break;
result := true;
break;
end;
end;
var
i,nb : integer;
begin
SetLength(objs,length(Ids));
nb:=0;
SetLength(objs, Length(Ids));
nb := 0;
Lock;
Try
try
for i:=0 to pred(FItems.Count) do
begin
if (IdOwner=0) or (IdOwner=FItems[i].FIdOwner) then
if (IdOwner = 0) or (IdOwner = FItems[i].FIdOwner) then
if Assigned(FItems[i].ExtraData) and FItems[i].ExtraData.InheritsFrom(TDrawingExtraData) then
Begin
begin
if ToSelect(TDrawingExtraData(FItems[i].ExtraData).Id) then
Begin
objs[nb]:=FItems[i];
begin
objs[nb] := FItems[i];
nb+=1;
end;
end;
@ -366,26 +379,27 @@ begin
finally
Unlock;
end;
SetLength(objs,nb);
SetLength(objs, nb);
end;
procedure TGPSObjectList.GetArea(out Area: TRealArea);
var i : integer;
ptArea : TRealArea;
var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon:=0;
Area.BottomRight.lat:=0;
Area.TopLeft.lon:=0;
Area.TopLeft.lat:=0;
Area.BottomRight.lon := 0;
Area.BottomRight.lat := 0;
Area.TopLeft.lon := 0;
Area.TopLeft.lat := 0;
Lock;
Try
if Items.Count>0 then
try
if Items.Count > 0 then
begin
Area:=Items[0].BoundingBox;
Area := Items[0].BoundingBox;
for i:=1 to pred(Items.Count) do
begin
ptArea:=Items[i].BoundingBox;
ExtendArea(Area,ptArea);
ptArea := Items[i].BoundingBox;
ExtendArea(Area, ptArea);
end;
end;
finally
@ -394,21 +408,22 @@ begin
end;
function TGPSObjectList.GetObjectsInArea(const Area: TRealArea): TGPSObjList;
var i : integer;
ItemArea : TRealArea;
var
i: integer;
ItemArea: TRealArea;
begin
Result:=TGPSObjList.Create(false);
Result := TGPSObjList.Create(false);
Lock;
Try
try
Inc(FRefCount);
For i:=0 to pred(Items.Count) do
Begin
ItemArea:=Items[i].BoundingBox;
If hasIntersectArea(Area,ItemArea) then
Result.Add(Items[i]);
for i:=0 to pred(Items.Count) do
begin
ItemArea := Items[i].BoundingBox;
if hasIntersectArea(Area,ItemArea) then
Result.Add(Items[i]);
end;
if Result.Count>0 then
Result.FRef:=Self
if Result.Count > 0 then
Result.FRef := Self
else
Dec(FRefCount);
finally
@ -418,7 +433,7 @@ end;
constructor TGPSObjectList.Create;
begin
Crit:=TCriticalSection.Create;
Crit := TCriticalSection.Create;
FItems := TGPSObjList.Create(true);
end;
@ -431,59 +446,63 @@ begin
end;
procedure TGPSObjectList.Clear(OwnedBy: integer);
var i : integer;
DelObj : TGPSObjList;
var
i: integer;
DelObj: TGPSObjList;
begin
DelObj:=nil;
DelObj := nil;
Lock;
try
For i:=pred(FItems.Count) downto 0 do
if (OwnedBy=0) or (FItems[i].FIdOwner=OwnedBy) then
_Delete(i,DelObj);
for i:=pred(FItems.Count) downto 0 do
if (OwnedBy = 0) or (FItems[i].FIdOwner = OwnedBy) then
_Delete(i,DelObj);
finally
Unlock;
end;
if Assigned(DelObj) then
CallModified(DelObj,false);
CallModified(DelObj, false);
end;
procedure TGPSObjectList.ClearExcept(OwnedBy: integer;
const ExceptLst : TIdArray; out Notfound: TIdArray);
const ExceptLst: TIdArray; out Notfound: TIdArray);
var Found : TIdArray;
var
Found: TIdArray;
function ToDel(aIt : TGPsObj) : boolean;
var i,Id : integer;
Begin
if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then
result:=true
else
Begin
Result:=true;
Id:=TDrawingExtraData(aIt.ExtraData).Id;
for i:=low(ExceptLst) to high(ExceptLst) do
if Id=ExceptLst[i] then
begin
result:=false;
SetLength(Found,Length(Found)+1);
Found[high(Found)]:=Id;
exit;
end;
function ToDel(aIt: TGPsObj): boolean;
var
i,Id: integer;
begin
if (aIt.ExtraData=nil) or not(aIt.ExtraData.InheritsFrom(TDrawingExtraData)) then
Result := true
else
Begin
Result := true;
Id := TDrawingExtraData(aIt.ExtraData).Id;
for i := Low(ExceptLst) to High(ExceptLst) do
if Id = ExceptLst[i] then
begin
Result := false;
SetLength(Found, Length(Found)+1);
Found[high(Found)] := Id;
exit;
end;
end;
end;
end;
var i,j : integer;
IsFound : boolean;
DelLst : TGPSObjList;
var
i,j: integer;
IsFound: boolean;
DelLst: TGPSObjList;
begin
DelLst:=nil;
SetLength(NotFound,0);
SetLength(Found,0);
DelLst := nil;
SetLength(NotFound, 0);
SetLength(Found, 0);
Lock;
try
For i:=pred(FItems.Count) downto 0 do
for i := pred(FItems.Count) downto 0 do
begin
if (FItems[i].FIdOwner=OwnedBy) or (OwnedBy=0) then
if (FItems[i].FIdOwner = OwnedBy) or (OwnedBy = 0) then
Begin
if ToDel(FItems[i]) then
_Delete(i,DelLst);
@ -492,77 +511,77 @@ begin
finally
Unlock;
end;
For i:=low(ExceptLst) to high(ExceptLst) do
Begin
IsFound:=false;
for j:=low(Found) to high(Found) do
if Found[j]=ExceptLst[i] then
for i:=low(ExceptLst) to high(ExceptLst) do
begin
IsFound := false;
for j:=Low(Found) to High(Found) do
if Found[j] = ExceptLst[i] then
begin
IsFound:=true;
IsFound := true;
break;
end;
if not(IsFound) then
Begin
SetLength(NotFound,length(NotFound)+1);
NotFound[high(NotFound)]:=ExceptLst[i];
if not IsFound then
begin
SetLength(NotFound, Length(NotFound)+1);
NotFound[high(NotFound)] := ExceptLst[i];
end;
end;
if Assigned(DelLst) then
CallModified(DelLst,false);
CallModified(DelLst, false);
end;
function TGPSObjectList.GetIdsArea(const Ids: TIdArray;IdOwner : integer): TRealArea;
var Objs : TGPSObjarray;
i : integer;
function TGPSObjectList.GetIdsArea(const Ids: TIdArray; IdOwner: integer): TRealArea;
var
Objs: TGPSObjarray;
i: integer;
begin
Result.BottomRight.Lat:=0;
Result.BottomRight.Lon:=0;
Result.TopLeft.Lat:=0;
Result.TopLeft.Lon:=0;
Result.BottomRight.Lat := 0;
Result.BottomRight.Lon := 0;
Result.TopLeft.Lat := 0;
Result.TopLeft.Lon := 0;
Lock;
Try
IdsToObj(Ids,Objs,IdOwner);
if length(Objs)>0 then
Begin
Result:=Objs[0].BoundingBox;
for i:=succ(low(Objs)) to high(Objs) do
begin
ExtendArea(Result,Objs[i].BoundingBox);
end;
try
IdsToObj(Ids, Objs, IdOwner);
if Length(Objs) > 0 then
begin
Result := Objs[0].BoundingBox;
for i:=succ(Low(Objs)) to High(Objs) do
ExtendArea(Result, Objs[i].BoundingBox);
end;
finally
Unlock;
end;
end;
function TGPSObjectList.Add(aItem: TGpsObj;IdOwner : integer): integer;
var mList : TGPSObjList;
function TGPSObjectList.Add(aItem: TGpsObj; IdOwner: integer): integer;
var
mList: TGPSObjList;
begin
aItem.FIdOwner:=IdOwner;
aItem.FIdOwner := IdOwner;
Lock;
try
Result:=Items.Add(aItem);
mList:=TGPSObjList.Create(false);
Result := Items.Add(aItem);
mList := TGPSObjList.Create(false);
mList.Add(aItem);
inc(FRefCount);
mList.FRef:=Self;
mList.FRef := Self;
finally
Unlock;
end;
CallModified(mList,true);
CallModified(mList, true);
end;
procedure TGPSObjectList.DeleteById(const Ids: array of integer);
function ToDelete(const AId : integer) : Boolean;
function ToDelete(const AId: integer): Boolean;
var
i: integer;
begin
result:=false;
For i:=low(Ids) to high(Ids) do
if Ids[i]=AId then
Begin
result:=true;
result := false;
For i:=Low(Ids) to High(Ids) do
if Ids[i] = AId then
begin
result := true;
exit;
end;
end;
@ -572,7 +591,7 @@ var
i: integer;
DelLst: TGPSObjList;
begin
DelLst:=nil;
DelLst := nil;
Lock;
try
for i:=Pred(Items.Count) downto 0 do
@ -584,8 +603,9 @@ begin
Extr := TDrawingExtraData(Items[i]);
// !!! wp: There is a warning that TGPSObj and TDrawingExtraData are not related !!!
if ToDelete(Extr.Id) then
_Delete(i,DelLst);
// !!! wp: DelLst is a local var and created by _Delete but not destroyed anywhere here !!!
_Delete(i, DelLst);
// !!! wp: DelLst is a local var and was created by _Delete but is
// not destroyed anywhere here !!!
end;
end;
end;
@ -593,7 +613,7 @@ begin
Unlock;
end;
if Assigned(DelLst) then
// wp: is this missing here: DelLst.Free;
end;
procedure TGPSObjectList.BeginUpdate;
@ -603,11 +623,11 @@ end;
procedure TGPSObjectList.EndUpdate;
begin
if FUpdating>0 then
if FUpdating > 0 then
begin
Dec(FUpdating);
if FUpdating=0 then
CallModified(nil,true);
if FUpdating = 0 then
CallModified(nil, true);
end;
end;
@ -616,12 +636,12 @@ end;
function TGPSTrack.GetDateTime: TDateTime;
begin
if FDateTime=0 then
if FDateTime = 0 then
Begin
if FPoints.Count>0 then
FDateTime:=FPoints[0].DateTime;
if FPoints.Count > 0 then
FDateTime := FPoints[0].DateTime;
end;
Result:=FDateTime;
Result := FDateTime;
end;
constructor TGPSTrack.Create;
@ -636,66 +656,68 @@ begin
end;
procedure TGPSTrack.GetArea(out Area: TRealArea);
var i : integer;
ptArea : TRealArea;
var
i: integer;
ptArea: TRealArea;
begin
Area.BottomRight.lon:=0;
Area.BottomRight.lat:=0;
Area.TopLeft.lon:=0;
Area.TopLeft.lat:=0;
if FPoints.Count>0 then
Area.BottomRight.lon := 0;
Area.BottomRight.lat := 0;
Area.TopLeft.lon := 0;
Area.TopLeft.lat := 0;
if FPoints.Count > 0 then
begin
Area:=FPoints[0].BoundingBox;
Area := FPoints[0].BoundingBox;
for i:=1 to pred(FPoints.Count) do
begin
ptArea:=FPoints[i].BoundingBox;
ExtendArea(Area,ptArea);
ptArea := FPoints[i].BoundingBox;
ExtendArea(Area, ptArea);
end;
end;
end;
function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;
var i : integer;
var
i: integer;
begin
Result:=0;
For i:=1 to pred(FPoints.Count) do
begin
result+=FPoints[i].DistanceInKmFrom(FPoints[pred(i)],UseEle);
end;
Result := 0;
for i:=1 to pred(FPoints.Count) do
result += FPoints[i].DistanceInKmFrom(FPoints[pred(i)], UseEle);
end;
{ TGPSPoint }
function TGPSPoint.GetLat: Double;
begin
result:=FRealPt.Lat;
result := FRealPt.Lat;
end;
function TGPSPoint.GetLon: Double;
begin
result:=FRealPt.Lon;
result := FRealPt.Lon;
end;
procedure TGPSPoint.GetArea(out Area: TRealArea);
begin
Area.TopLeft:=FRealPt;
Area.BottomRight:=FRealPt;
Area.TopLeft := FRealPt;
Area.BottomRight := FRealPt;
end;
function TGPSPoint.HasEle: boolean;
begin
Result:=FEle<>NO_ELE;
Result := FEle <> NO_ELE;
end;
function TGPSPoint.HasDateTime: Boolean;
begin
Result:=FDateTime<>NO_DATE;
Result := FDateTime <> NO_DATE;
end;
function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint;UseEle : boolean): double;
var a : double;
lat1,lat2,lon1,lon2,t1,t2,t3,t4,t5,rad_dist : double;
DiffEle :Double;
function TGPSPoint.DistanceInKmFrom(OtherPt: TGPSPoint; UseEle: boolean): double;
var
a: double;
lat1, lat2, lon1, lon2, t1, t2, t3, t4, t5, rad_dist: double;
DiffEle: Double;
begin
a := PI / 180;
lat1 := lat * a;
@ -712,25 +734,25 @@ begin
result := (rad_dist * 3437.74677 * 1.1508) * 1.6093470878864446;
if UseEle and (FEle<>OtherPt.FEle) then
if (HasEle) and (OtherPt.HasEle) then
Begin
begin
//FEle is assumed in Metter
DiffEle:=(FEle-OtherPt.Ele)/1000;
Result:=sqrt(DiffEle*DiffEle+result*result);
DiffEle := (FEle-OtherPt.Ele)/1000;
Result := sqrt(DiffEle*DiffEle+result*result);
end;
end;
constructor TGPSPoint.Create(ALon, ALat: double; AEle: double;
ADateTime: TDateTime);
begin
FRealPt.Lon:=ALon;
FRealPt.Lat:=ALat;
FEle:=AEle;
FDateTime:=ADateTime;
FRealPt.Lon := ALon;
FRealPt.Lat := ALat;
FEle := AEle;
FDateTime := ADateTime;
end;
class function TGPSPoint.CreateFrom(aPt: TRealPoint): TGPSPoint;
begin
Result:=Create(aPt.Lon,aPt.Lat);
Result := Create(aPt.Lon,aPt.Lat);
end;
end.

2
components/lazmapviewer/source/mvjobs.pas
View File

@ -105,10 +105,12 @@ begin
Result := NO_MORE_TASK
end
else
begin
if FEnded then
Result := ALL_TASK_COMPLETED
else
Result := 1;
end;
end;
procedure TSimpleJob.pTaskStarted(aTask: integer);

56
components/lazmapviewer/source/mvmapprovider.pas
View File

@ -78,17 +78,17 @@ end;
procedure TMapProvider.SetLayer(AValue: integer);
begin
if FLayer=AValue then Exit;
if (aValue<low(FUrl)) and (aValue>high(FUrl)) then
if FLayer = AValue then Exit;
if (aValue < Low(FUrl)) and (aValue > High(FUrl)) then
Begin
Raise Exception.create('bad Layer');
Raise Exception.Create('bad Layer');
end;
FLayer:=AValue;
end;
constructor TMapProvider.Create(aName: String);
begin
FName:=aName;
FName := aName;
end;
destructor TMapProvider.Destroy;
@ -107,31 +107,31 @@ begin
end;
procedure TMapProvider.AddURL(Url: String; NbSvr: integer;
aMinZoom : integer;aMaxZoom : integer;
GetSvrStr: TGetSvrStr; GetXStr: TGetValStr; GetYStr: TGetValStr;
GetZStr: TGetValStr);
var nb : integer;
aMinZoom: integer; aMaxZoom: integer; GetSvrStr: TGetSvrStr;
GetXStr: TGetValStr; GetYStr: TGetValStr; GetZStr: TGetValStr);
var
nb: integer;
begin
nb:=length(FUrl)+1;
SetLength(IdServer,nb);
SetLength(FUrl,nb);
SetLength(FNbSvr,nb);
SetLength(FGetSvrStr,nb);
SetLength(FGetXStr,nb);
SetLength(FGetYStr,nb);
SetLength(FGetZStr,nb);
SetLength(FMinZoom,nb);
SetLength(FMaxZoom,nb);
nb:=high(FUrl);
FUrl[nb]:=Url;
FNbSvr[nb]:=NbSvr;
FMinZoom[nb]:=aMinZoom;
FMaxZoom[nb]:=aMaxZoom;
FGetSvrStr[nb]:=GetSvrStr;
FGetXStr[nb]:=GetXStr;
FGetYStr[nb]:=GetYStr;
FGetZStr[nb]:=GetZStr;
FLayer:=low(FUrl);
nb := Length(FUrl)+1;
SetLength(IdServer, nb);
SetLength(FUrl, nb);
SetLength(FNbSvr, nb);
SetLength(FGetSvrStr, nb);
SetLength(FGetXStr, nb);
SetLength(FGetYStr, nb);
SetLength(FGetZStr, nb);
SetLength(FMinZoom, nb);
SetLength(FMaxZoom, nb);
nb := High(FUrl);
FUrl[nb] := Url;
FNbSvr[nb] := NbSvr;
FMinZoom[nb] := aMinZoom;
FMaxZoom[nb] := aMaxZoom;
FGetSvrStr[nb] := GetSvrStr;
FGetXStr[nb] := GetXStr;
FGetYStr[nb] := GetYStr;
FGetZStr[nb] := GetZStr;
FLayer := Low(FUrl);
end;
procedure TMapProvider.GetZoomInfos(out AZoomMin, AZoomMax: integer);

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

@ -97,19 +97,23 @@ Type
{$ENDIF}
procedure DblClick; override;
Procedure DoDrawTile(const TileId: TTileId; X,Y: integer; TileImg: TLazIntfImage);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint): Boolean; override;
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer;
MousePos: TPoint): Boolean; override;
procedure DoOnResize; override;
Function IsActive : Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y:Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
function IsActive: Boolean;
procedure MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer); override;
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
procedure Paint; override;
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;Adding : boolean);
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
Adding: boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure ClearBuffer;
procedure GetMapProviders(lstProviders : TStrings);
procedure GetMapProviders(lstProviders: TStrings);
function GetVisibleArea: TRealArea;
function LonLatToScreen(aPt: TRealPoint): TPoint;
function ScreenToLonLat(aPt: TPoint): TRealPoint;
@ -134,9 +138,9 @@ Type
property UseThreads: boolean read GetUseThreads write SetUseThreads;
property Width default 150;
property Zoom: integer read GetZoom write SetZoom;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
property OnChange: TNotifyEvent Read GetOnChange write SetOnChange;
property OnCenterMove: TNotifyEvent read GetOnCenterMove write SetOnCenterMove;
property OnZoomChange: TNotifyEvent read GetOnZoomChange write SetOnZoomChange;
property OnChange: TNotifyEvent read GetOnChange write SetOnChange;
property OnDrawGpsPoint: TDrawGpsPointEvent read FOnDrawGpsPoint write FOnDrawGpsPoint;
property OnMouseDown;
property OnMouseEnter;
@ -145,6 +149,7 @@ Type
property OnMouseUp;
end;
implementation
uses
@ -212,24 +217,24 @@ Type
{ TDrawObjJob }
TDrawObjJob = Class(TJob)
TDrawObjJob = class(TJob)
private
AllRun : boolean;
Viewer : TMapView;
FRunning : boolean;
FLst : TGPSObjList;
FStates : Array of integer;
FArea : TRealArea;
AllRun: boolean;
Viewer: TMapView;
FRunning: boolean;
FLst: TGPSObjList;
FStates: Array of integer;
FArea: TRealArea;
protected
function pGetTask: integer;override;
procedure pTaskStarted(aTask: integer);override;
procedure pTaskEnded(aTask: integer; aExcept: Exception);override;
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;
procedure ExecuteTask(aTask: integer; FromWaiting: boolean); override;
function Running: boolean;override;
public
Constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
destructor Destroy;override;
constructor Create(aViewer: TMapView; aLst: TGPSObjList; const aArea: TRealArea);
destructor Destroy; override;
end;
{ TDrawObjJob }
@ -240,51 +245,49 @@ var
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;
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;
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 TDrawObjJob.pTaskStarted(aTask: integer);
begin
FRunning:=True;
FStates[aTask-1]:=1;
FRunning := True;
FStates[aTask-1] := 1;
end;
procedure TDrawObjJob.pTaskEnded(aTask: integer; aExcept: Exception);
begin
if Assigned(aExcept) then
FStates[aTask-1]:=3
FStates[aTask-1] := 3
else
FStates[aTask-1]:=2;
FStates[aTask-1] := 2;
end;
procedure TDrawObjJob.ExecuteTask(aTask: integer; FromWaiting: boolean);
var iObj : integer;
Obj : TGpsObj;
var
iObj: integer;
Obj: TGpsObj;
begin
iObj:=aTask-1;
Obj:=FLst[iObj];
if Obj.InheritsFrom(TGPSTrack) then
begin
Viewer.DrawTrack(FArea,TGPSTrack(Obj));
end;
if Obj.InheritsFrom(TGPSPoint) then
begin
Viewer.DrawPt(FArea,TGPSPoint(Obj));
end;
iObj := aTask-1;
Obj := FLst[iObj];
if Obj.InheritsFrom(TGPSTrack) then
Viewer.DrawTrack(FArea, TGPSTrack(Obj));
if Obj.InheritsFrom(TGPSPoint) then
Viewer.DrawPt(FArea, TGPSPoint(Obj));
end;
function TDrawObjJob.Running: boolean;
@ -451,8 +454,8 @@ begin
Engine.MouseWheel(self,Shift,WheelDelta,MousePos,Result);
end;
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
Y: Integer);
procedure TMapView.MouseDown(Button: TMouseButton; Shift: TShiftState;
X, Y: Integer);
begin
inherited MouseDown(Button, Shift, X, Y);
if IsActive then
@ -521,9 +524,9 @@ begin
end
else
begin
Canvas.Brush.Color:=InactiveColor;
Canvas.Brush.Style:=bsSolid;
Canvas.FillRect(0,0,ClientWidth,ClientHeight);
Canvas.Brush.Color := InactiveColor;
Canvas.Brush.Style := bsSolid;
Canvas.FillRect(0, 0, ClientWidth, ClientHeight);
end;
end;
@ -532,14 +535,14 @@ procedure TMapView.OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
var
Area,ObjArea,vArea: TRealArea;
begin
if Adding and assigned(Objs) then
if Adding and Assigned(Objs) then
begin
ObjArea := GetAreaOf(Objs);
vArea := GetVisibleArea;
if hasIntersectArea(ObjArea,vArea) then
begin
Area:=IntersectArea(ObjArea,vArea);
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,Objs,Area),Engine);
Area := IntersectArea(ObjArea, vArea);
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, Objs, Area), Engine);
end
else
objs.Free;
@ -551,53 +554,54 @@ begin
end;
end;
procedure TMapView.DrawTrack(const Area : TRealArea;trk : TGPSTrack);
var Old,New : TPoint;
i : integer;
aPt : TRealPoint;
LastInside,IsInside : boolean;
trkColor : TColor;
Begin
if trk.Points.Count>0 then
Begin
trkColor:=clRed;
if trk.ExtraData<>nil then
Begin
if trk.ExtraData.inheritsFrom(TDrawingExtraData) then
trkColor:=TDrawingExtraData(trk.ExtraData).Color;
end;
LastInside:=false;
For i:=0 to pred(trk.Points.Count) do
Begin
aPt:=trk.Points[i].RealPoint;
IsInside:=PtInsideArea(aPt,Area);
if IsInside or LastInside then
Begin
New:=Engine.LonLatToScreen(aPt);
if i>0 then
Begin
if not(LastInside) then
Old:=Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
{$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.OutlineColor := trkColor;
Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor);
BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y);
{$ENDIF}
end;
Old := New;
LastInside := IsInside;
end;
end;
end;
procedure TMapView.DrawTrack(const Area: TRealArea; trk: TGPSTrack);
var
Old,New: TPoint;
i: integer;
aPt: TRealPoint;
LastInside, IsInside: boolean;
trkColor: TColor;
begin
if trk.Points.Count>0 then
begin
trkColor := clRed;
if trk.ExtraData <> nil then
begin
if trk.ExtraData.InheritsFrom(TDrawingExtraData) then
trkColor := TDrawingExtraData(trk.ExtraData).Color;
end;
LastInside := false;
for i:=0 to pred(trk.Points.Count) do
begin
aPt := trk.Points[i].RealPoint;
IsInside := PtInsideArea(aPt,Area);
if IsInside or LastInside then
begin
New := Engine.LonLatToScreen(aPt);
if i > 0 then
begin
if not LastInside then
Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
{$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.OutlineColor := trkColor;
Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor);
BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y);
{$ENDIF}
end;
Old := New;
LastInside := IsInside;
end;
end;
end;
end;
procedure TMapView.DrawPt(const Area: TRealArea; aPOI: TGPSPoint);
var
PT : TPoint;
PtColor : TColor;
PT: TPoint;
PtColor: TColor;
begin
if Assigned(FOnDrawGpsPoint) then begin
{$IFDEF USE_RGBGRAPHICS}
@ -609,17 +613,17 @@ begin
exit;
end;
Pt:=Engine.LonLatToScreen(aPOI.RealPoint);
PtColor:=clRed;
if aPOI.ExtraData<>nil then
Begin
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor:=TDrawingExtraData(aPOI.ExtraData).Color;
Pt := Engine.LonLatToScreen(aPOI.RealPoint);
PtColor := clRed;
if aPOI.ExtraData <> nil then
begin
if aPOI.ExtraData.inheritsFrom(TDrawingExtraData) then
PtColor := TDrawingExtraData(aPOI.ExtraData).Color;
end;
{$IFDEF USE_RGBGRAPHICS}
Buffer.canvas.OutlineColor:=ptColor;
Buffer.canvas.Line(Pt.X,Pt.y-5,Pt.X,Pt.Y+5);
Buffer.canvas.Line(Pt.X-5,Pt.y,Pt.X+5,Pt.Y);
Buffer.Canvas.OutlineColor := ptColor;
Buffer.Canvas.Line(Pt.X, Pt.y-5, Pt.X, Pt.Y+5);
Buffer.Canvas.Line(Pt.X-5, Pt.y, Pt.X+5, Pt.Y);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(ptColor);
@ -633,29 +637,30 @@ end;
procedure TMapView.CallAsyncInvalidate;
Begin
if not(AsyncInvalidate) then
Begin
AsyncInvalidate:=true;
Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate,0);
begin
AsyncInvalidate := true;
Engine.Jobqueue.QueueAsyncCall(@DoAsyncInvalidate, 0);
end;
end;
procedure TMapView.DrawObjects(const TileId: TTileId; aLeft, aTop,aRight,aBottom: integer);
procedure TMapView.DrawObjects(const TileId: TTileId;
aLeft, aTop,aRight,aBottom: integer);
var
aPt: TPoint;
Area: TRealArea;
lst: TGPSObjList;
begin
aPt.X:=aLeft;
aPt.Y:=aTop;
Area.TopLeft:=Engine.ScreenToLonLat(aPt);
aPt.X:=aRight;
aPt.Y:=aBottom;
Area.BottomRight:=Engine.ScreenToLonLat(aPt);
if GPSItems.count>0 then
aPt.X := aLeft;
aPt.Y := aTop;
Area.TopLeft := Engine.ScreenToLonLat(aPt);
aPt.X := aRight;
aPt.Y := aBottom;
Area.BottomRight := Engine.ScreenToLonLat(aPt);
if GPSItems.Count > 0 then
begin
lst:=GPSItems.GetObjectsInArea(Area);
if lst.Count>0 then
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self,lst,Area),Engine)
lst := GPSItems.GetObjectsInArea(Area);
if lst.Count > 0 then
Engine.Jobqueue.AddJob(TDrawObjJob.Create(self, lst, Area), Engine)
else
begin
FreeAndNil(Lst);
@ -669,31 +674,31 @@ end;
procedure TMapView.DoAsyncInvalidate(Data: PtrInt);
Begin
Invalidate;
AsyncInvalidate:=false;
AsyncInvalidate := false;
end;
procedure TMapView.DoDrawTile(const TileId: TTileId; X, Y: integer;
TileImg: TLazIntfImage);
{$IFDEF USE_RGBGRAPHICS}
var
temp : TRGB32Bitmap;
ri : TRawImage;
BuffLaz : TLazIntfImage;
temp: TRGB32Bitmap;
ri: TRawImage;
BuffLaz: TLazIntfImage;
{$ENDIF}
begin
if Assigned(Buffer) then
begin
if Assigned(TileImg) then
Begin
begin
{$IFDEF USE_RGBGRAPHICS}
if (X>=0) and (Y>=0) then //http://mantis.freepascal.org/view.php?id=27144
if (X >= 0) and (Y >= 0) then //http://mantis.freepascal.org/view.php?id=27144
begin
ri.Init;
ri.Description.Init_BPP32_R8G8B8A8_BIO_TTB(Buffer.Width,Buffer.Height);
ri.Data:=Buffer.Pixels;
BuffLaz := TLazIntfImage.Create(ri,false);
ri.Data := Buffer.Pixels;
BuffLaz := TLazIntfImage.Create(ri, false);
try
BuffLaz.CopyPixels(TileImg,X,y);
BuffLaz.CopyPixels(TileImg, X, Y);
ri.Init;
finally
FreeandNil(BuffLaz);
@ -702,11 +707,11 @@ begin
else
begin
//i think it take more memory then the previous method but work in all case
temp:=TRGB32Bitmap.CreateFromLazIntfImage(TileImg);
temp := TRGB32Bitmap.CreateFromLazIntfImage(TileImg);
try
Buffer.Draw(X,Y,temp);
Buffer.Draw(X, Y, temp);
finally
FreeAndNil(Temp);
FreeAndNil(temp);
end;
end;
{$ENDIF}
@ -721,24 +726,24 @@ begin
end
else
{$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.FillRect(X,Y,X+TILE_SIZE,Y+TILE_SIZE);
Buffer.Canvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
begin
BufferCanvas.Brush.FPColor := ColWhite;
BufferCanvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
begin
BufferCanvas.Brush.FPColor := ColWhite;
BufferCanvas.FillRect(X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
{$ENDIF}
end;
DrawObjects(TileId,X,Y,X+TILE_SIZE,Y+TILE_SIZE);
DrawObjects(TileId, X, Y, X + TILE_SIZE, Y + TILE_SIZE);
end;
function TMapView.IsActive: Boolean;
begin
if not(csDesigning in ComponentState) then
Result:=FActive
Result := FActive
else
Result:=false;
Result := false;
end;
constructor TMapView.Create(AOwner: TComponent);
@ -750,7 +755,7 @@ begin
FEngine := TMapViewerEngine.Create(self);
FBuiltinDownloadEngine := TMvDEFpc.Create(self);
{$IFDEF USE_RGBGRAPHICS}
Buffer := TRGB32Bitmap.Create(Width,Height);
Buffer := TRGB32Bitmap.Create(Width, Height);
{$ENDIF}
{$IFDEF USE_LAZINTFIMAGE}
CreateLazIntfImageAndCanvas(Buffer, BufferCanvas, Width, Height);
@ -812,17 +817,19 @@ begin
end;
procedure TMapView.CenterOnObj(obj: TGPSObj);
var Area : TRealArea;
Pt : TRealPoint;
var
Area: TRealArea;
Pt: TRealPoint;
begin
obj.GetArea(Area);
Pt.Lon:=(Area.TopLeft.Lon+Area.BottomRight.Lon) /2;
Pt.Lat:=(Area.TopLeft.Lat+Area.BottomRight.Lat) /2;
Center:=Pt;
Pt.Lon := (Area.TopLeft.Lon + Area.BottomRight.Lon) /2;
Pt.Lat := (Area.TopLeft.Lat + Area.BottomRight.Lat) /2;
Center := Pt;
end;
procedure TMapView.ZoomOnObj(obj: TGPSObj);
var Area : TRealArea;
var
Area: TRealArea;
begin
obj.GetArea(Area);
Engine.ZoomOnArea(Area);
@ -834,14 +841,15 @@ begin
end;
function TMapView.GetVisibleArea: TRealArea;
var aPt : TPoint;
var
aPt: TPoint;
begin
aPt.X:=0;
aPt.Y:=0;
Result.TopLeft:=Engine.ScreenToLonLat(aPt);
aPt.X:=Width;
aPt.Y:=Height;
Result.BottomRight:=Engine.ScreenToLonLat(aPt);;
aPt.X := 0;
aPt.Y := 0;
Result.TopLeft := Engine.ScreenToLonLat(aPt);
aPt.X := Width;
aPt.Y := Height;
Result.BottomRight := Engine.ScreenToLonLat(aPt);;
end;
procedure TMapView.ClearBuffer;