You've already forked lazarus-ccr
LazMapViewer: Add support of GPX files.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6913 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
@@ -123,6 +123,7 @@ type
|
||||
FUpdating: integer;
|
||||
FItems: TGPSObjList;
|
||||
function GetCount: integer;
|
||||
function GetItem(AIndex: Integer): TGpsObj;
|
||||
protected
|
||||
procedure _Delete(Idx: Integer; var DelLst: TGPSObjList);
|
||||
procedure FreePending;
|
||||
@@ -130,7 +131,7 @@ type
|
||||
procedure Lock;
|
||||
procedure UnLock;
|
||||
procedure CallModified(lst: TGPSObjList; Adding: boolean);
|
||||
property Items: TGPSObjList read FItems;
|
||||
// property Items: TGPSObjList read FItems;
|
||||
procedure IdsToObj(const Ids: TIdArray; out objs: TGPSObjArray; IdOwner: integer);
|
||||
public
|
||||
constructor Create;
|
||||
@@ -149,6 +150,7 @@ type
|
||||
procedure EndUpdate;
|
||||
|
||||
property Count: integer read GetCount;
|
||||
property Items[AIndex: Integer]: TGpsObj read GetItem; default;
|
||||
property OnModified: TModifiedEvent read FOnModified write FOnModified;
|
||||
end;
|
||||
|
||||
@@ -279,6 +281,11 @@ begin
|
||||
Result := FItems.Count
|
||||
end;
|
||||
|
||||
function TGPSObjectList.GetItem(AIndex: Integer): TGpsObj;
|
||||
begin
|
||||
Result := FItems[AIndex];
|
||||
end;
|
||||
|
||||
procedure TGPSObjectList._Delete(Idx: Integer; var DelLst: TGPSObjList); // wp: was "out"
|
||||
var
|
||||
Item: TGpsObj;
|
||||
@@ -293,7 +300,7 @@ begin
|
||||
end;
|
||||
if not Assigned(FPending) then
|
||||
FPending := TObjectList.Create(true);
|
||||
Item := Items.Extract(Items[Idx]);
|
||||
Item := FItems.Extract(FItems[Idx]);
|
||||
FPending.Add(Item);
|
||||
finally
|
||||
UnLock;
|
||||
@@ -393,10 +400,10 @@ begin
|
||||
Area.TopLeft.lat := 0;
|
||||
Lock;
|
||||
try
|
||||
if Items.Count > 0 then
|
||||
if Count > 0 then
|
||||
begin
|
||||
Area := Items[0].BoundingBox;
|
||||
for i:=1 to pred(Items.Count) do
|
||||
for i:=1 to pred(Count) do
|
||||
begin
|
||||
ptArea := Items[i].BoundingBox;
|
||||
ExtendArea(Area, ptArea);
|
||||
@@ -416,7 +423,7 @@ begin
|
||||
Lock;
|
||||
try
|
||||
Inc(FRefCount);
|
||||
for i:=0 to pred(Items.Count) do
|
||||
for i:=0 to pred(Count) do
|
||||
begin
|
||||
ItemArea := Items[i].BoundingBox;
|
||||
if hasIntersectArea(Area,ItemArea) then
|
||||
@@ -560,7 +567,7 @@ begin
|
||||
aItem.FIdOwner := IdOwner;
|
||||
Lock;
|
||||
try
|
||||
Result := Items.Add(aItem);
|
||||
Result := FItems.Add(aItem);
|
||||
mList := TGPSObjList.Create(false);
|
||||
mList.Add(aItem);
|
||||
inc(FRefCount);
|
||||
@@ -594,7 +601,7 @@ begin
|
||||
DelLst := nil;
|
||||
Lock;
|
||||
try
|
||||
for i:=Pred(Items.Count) downto 0 do
|
||||
for i:=pred(Count) downto 0 do
|
||||
begin
|
||||
if Assigned(Items[i].ExtraData) then
|
||||
begin
|
||||
|
||||
299
components/lazmapviewer/source/mvgpx.pas
Normal file
299
components/lazmapviewer/source/mvgpx.pas
Normal file
@@ -0,0 +1,299 @@
|
||||
{ Reads/writes GPX files }
|
||||
|
||||
unit mvGPX;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, laz2_DOM, laz2_XMLRead, DateUtils,
|
||||
mvTypes, mvGpsObj;
|
||||
|
||||
type
|
||||
TGpxReader = class
|
||||
private
|
||||
ID: Integer;
|
||||
protected
|
||||
function ReadPoint(ANode: TDOMNode): TGpsPoint;
|
||||
procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
|
||||
procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
procedure ReadTracks(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
procedure ReadTrackSegment(ANode: TDOMNode; ATrack: TGpsTrack);
|
||||
procedure ReadWayPoints(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
public
|
||||
procedure LoadFromFile(AFileName: String; AList: TGpsObjectList);
|
||||
procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList);
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
var
|
||||
PointSettings: TFormatSettings;
|
||||
|
||||
function ExtractISODateTime(AText: String): TDateTime;
|
||||
type
|
||||
TISODateRec = packed record
|
||||
Y: array[0..3] of ansichar;
|
||||
SepYM: ansichar;
|
||||
M: array[0..1] of ansichar;
|
||||
SepMD: ansichar;
|
||||
D: array[0..1] of ansichar;
|
||||
end;
|
||||
PISODateRec = ^TISODateRec;
|
||||
TISOTimeRec = packed record
|
||||
H: array[0..1] of ansichar;
|
||||
SepHM: ansichar;
|
||||
M: array[0..1] of ansichar;
|
||||
SepMS: ansiChar;
|
||||
S: array[0..1] of ansichar;
|
||||
DecSep: ansichar;
|
||||
MS: array[0..2] of ansichar;
|
||||
end;
|
||||
PISOTimeRec = ^TISOTimeRec;
|
||||
const
|
||||
NUMBER: array['0'..'9'] of Integer = (0, 1, 2, 3, 4, 5, 6, 7, 8, 9);
|
||||
const
|
||||
ZERO = ord('0');
|
||||
var
|
||||
yr,mon,dy, hr,mn,sec,s1000: Integer;
|
||||
begin
|
||||
if Pos('T', AText) = 11 then begin
|
||||
with PISODateRec(PChar(@AText[1]))^ do begin
|
||||
yr := 1000*NUMBER[Y[0]] + 100*NUMBER[Y[1]] + 10*NUMBER[Y[2]] + NUMBER[Y[3]];
|
||||
mon := 10*NUMBER[M[0]] + NUMBER[M[1]];
|
||||
dy := 10*NUMBER[D[0]] + NUMBER[D[1]];
|
||||
end;
|
||||
with PISOTimeRec(PChar(@AText[12]))^ do begin
|
||||
hr := 10*NUMBER[H[0]] + NUMBER[H[1]];
|
||||
mn := 10*NUMBER[M[0]] + NUMBER[M[1]];
|
||||
sec := 10*NUMBER[S[0]] + NUMBER[S[1]];
|
||||
s1000 := 100*NUMBER[MS[0]] + 10*NUMBER[MS[1]] + NUMBER[MS[2]];
|
||||
end;
|
||||
Result := EncodeDate(yr, mon, dy) + EncodeTime(hr, mn, sec, s1000);
|
||||
end else
|
||||
if not TryStrToDateTime(AText, Result) then
|
||||
Result := NO_DATE;
|
||||
end;
|
||||
|
||||
function GetAttrValue(ANode: TDOMNode; AAttrName: string) : string;
|
||||
var
|
||||
i: LongWord;
|
||||
Found: Boolean;
|
||||
begin
|
||||
Result := '';
|
||||
if (ANode = nil) or (ANode.Attributes = nil) then
|
||||
exit;
|
||||
|
||||
Found := false;
|
||||
i := 0;
|
||||
while not Found and (i < ANode.Attributes.Length) do begin
|
||||
if ANode.Attributes.Item[i].NodeName = AAttrName then begin
|
||||
Found := true;
|
||||
Result := ANode.Attributes.Item[i].NodeValue;
|
||||
end;
|
||||
inc(i);
|
||||
end;
|
||||
end;
|
||||
|
||||
function GetNodeValue(ANode: TDOMNode): String;
|
||||
var
|
||||
child: TDOMNode;
|
||||
begin
|
||||
Result := '';
|
||||
child := ANode.FirstChild;
|
||||
if Assigned(child) and (child.NodeName = '#text') then
|
||||
Result := child.NodeValue;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList);
|
||||
var
|
||||
stream: TStream;
|
||||
begin
|
||||
stream := TFileStream.Create(AFileName, fmOpenRead + fmShareDenyNone);
|
||||
try
|
||||
LoadFromStream(stream, AList);
|
||||
finally
|
||||
stream.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.LoadFromStream(AStream: TStream; AList: TGpsObjectList);
|
||||
var
|
||||
doc: TXMLDocument = nil;
|
||||
node: TDOMNode;
|
||||
begin
|
||||
try
|
||||
ID := random(MaxInt - 1000) + 1000;
|
||||
ReadXMLFile(doc, AStream);
|
||||
ReadWayPoints(doc.DocumentElement.FindNode('wpt'), AList);
|
||||
ReadTracks(doc.DocumentElement.FindNode('trk'), AList);
|
||||
ReadRoute(doc.DocumentElement.FindNode('rte'), AList);
|
||||
finally
|
||||
doc.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint;
|
||||
var
|
||||
s, slon, slat, sName: String;
|
||||
lon, lat, ele: Double;
|
||||
dt: TDateTime;
|
||||
node: TDOMNode;
|
||||
nodeName: String;
|
||||
begin
|
||||
Result := nil;
|
||||
if ANode = nil then
|
||||
exit;
|
||||
|
||||
slon := GetAttrValue(ANode, 'lon');
|
||||
slat := GetAttrValue(ANode, 'lat');
|
||||
if (slon = '') or (slat = '') then
|
||||
exit;
|
||||
|
||||
if not TryStrToFloat(slon, lon, PointSettings) then
|
||||
exit;
|
||||
if not TryStrToFloat(slat, lat, PointSettings) then
|
||||
exit;
|
||||
|
||||
sName := '';
|
||||
dt := NO_DATE;
|
||||
ele := NO_ELE;
|
||||
node := ANode.FirstChild;
|
||||
while node <> nil do begin
|
||||
nodeName := node.NodeName;
|
||||
case nodeName of
|
||||
'ele' :
|
||||
begin
|
||||
s := GetNodeValue(node);
|
||||
if s <> '' then
|
||||
TryStrToFloat(s, ele, PointSettings);
|
||||
end;
|
||||
'name':
|
||||
sName := GetNodeValue(node);
|
||||
'time':
|
||||
begin
|
||||
s := GetNodeValue(node);
|
||||
if s <> '' then
|
||||
dt := ExtractISODateTime(s);
|
||||
end;
|
||||
end;
|
||||
node := node.NextSibling;
|
||||
end;
|
||||
Result := TGpsPoint.Create(lon, lat, ele, dt);
|
||||
Result.Name := sname;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
|
||||
var
|
||||
trk: TGpsTrack;
|
||||
nodeName: string;
|
||||
pt: TGpsPoint;
|
||||
trkName: String;
|
||||
begin
|
||||
if ANode = nil then
|
||||
exit;
|
||||
ANode := ANode.FirstChild;
|
||||
if ANode = nil then
|
||||
exit;
|
||||
trk := TGpsTrack.Create;
|
||||
while ANode <> nil do begin
|
||||
nodeName := ANode.NodeName;
|
||||
case nodeName of
|
||||
'name':
|
||||
trkName := GetNodeValue(ANode);
|
||||
'rtept':
|
||||
begin
|
||||
pt := ReadPoint(ANode);
|
||||
if pt <> nil then trk.Points.Add(pt);
|
||||
end;
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
trk.Name := trkName;
|
||||
AList.Add(trk, ID);
|
||||
end;
|
||||
|
||||
procedure TGpxReader.ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
var
|
||||
trk: TGpsTrack;
|
||||
nodeName: string;
|
||||
pt: TGpsPoint;
|
||||
trkName: String = '';
|
||||
begin
|
||||
if ANode = nil then
|
||||
exit;
|
||||
ANode := ANode.FirstChild;
|
||||
if ANode = nil then
|
||||
exit;
|
||||
|
||||
trk := TGpsTrack.Create;
|
||||
while ANode <> nil do begin
|
||||
nodeName := ANode.NodeName;
|
||||
case nodeName of
|
||||
'name':
|
||||
trkName := GetNodeValue(ANode);
|
||||
'trkseg':
|
||||
ReadTrackSegment(ANode.FirstChild, trk);
|
||||
'trkpt':
|
||||
begin
|
||||
pt := ReadPoint(ANode);
|
||||
if pt <> nil then trk.Points.Add(pt);
|
||||
end;
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
trk.Name := trkName;
|
||||
AList.Add(trk, ID);
|
||||
end;
|
||||
|
||||
procedure TGpxReader.ReadTracks(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
var
|
||||
nodeName: String;
|
||||
begin
|
||||
while ANode <> nil do begin
|
||||
nodeName := ANode.NodeName;
|
||||
if nodeName = 'trk' then
|
||||
ReadTrack(ANode, AList);
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.ReadTrackSegment(ANode: TDOMNode; ATrack: TGpsTrack);
|
||||
var
|
||||
gpsPt: TGpsPoint;
|
||||
nodeName: String;
|
||||
begin
|
||||
while ANode <> nil do begin
|
||||
nodeName := ANode.NodeName;
|
||||
if nodeName = 'trkpt' then begin
|
||||
gpsPt := ReadPoint(ANode);
|
||||
if gpsPt <> nil then
|
||||
ATrack.Points.Add(gpsPt);
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TGpxReader.ReadWayPoints(ANode: TDOMNode; AList: TGpsObjectList);
|
||||
var
|
||||
nodeName: String;
|
||||
gpsPt: TGpsPoint;
|
||||
begin
|
||||
while ANode <> nil do begin
|
||||
nodeName := ANode.NodeName;
|
||||
if nodeName = 'wpt' then begin
|
||||
gpsPt := ReadPoint(ANode);
|
||||
if gpsPt <> nil then
|
||||
AList.Add(gpsPt, ID);
|
||||
end;
|
||||
ANode := ANode.NextSibling;
|
||||
end;
|
||||
end;
|
||||
|
||||
initialization
|
||||
PointSettings := DefaultFormatSettings;
|
||||
PointSettings.DecimalSeparator := '.';
|
||||
|
||||
end.
|
||||
|
||||
@@ -63,7 +63,7 @@ Type
|
||||
procedure CallAsyncInvalidate;
|
||||
procedure DoAsyncInvalidate({%H-}Data: PtrInt);
|
||||
procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
|
||||
procedure DrawPt(const {%H-}Area: TRealArea;aPOI: TGPSPoint);
|
||||
procedure DrawPt(const {%H-}Area: TRealArea; aPOI: TGPSPoint);
|
||||
procedure DrawTrack(const Area: TRealArea; trk: TGPSTrack);
|
||||
function GetCacheOnDisk: boolean;
|
||||
function GetCachePath: String;
|
||||
|
||||
Reference in New Issue
Block a user