diff --git a/components/lazmapviewer/example/MapViewer_Demo.lpi b/components/lazmapviewer/example/MapViewer_Demo.lpi
index cfca6c097..e91860a98 100644
--- a/components/lazmapviewer/example/MapViewer_Demo.lpi
+++ b/components/lazmapviewer/example/MapViewer_Demo.lpi
@@ -82,7 +82,7 @@
-
+
@@ -92,6 +92,9 @@
+
+
+
diff --git a/components/lazmapviewer/example/gpslistform.lfm b/components/lazmapviewer/example/gpslistform.lfm
index 32228f02e..fcdb89696 100644
--- a/components/lazmapviewer/example/gpslistform.lfm
+++ b/components/lazmapviewer/example/gpslistform.lfm
@@ -243,14 +243,16 @@ object GPSListViewer: TGPSListViewer
end
end
object SaveDialog: TSaveDialog
+ Title = 'Save gps points as'
DefaultExt = '.*.gps'
Filter = 'GPS points (*.gps)|*.gps|All files (*.*)|*.*'
left = 472
top = 256
end
object OpenDialog: TOpenDialog
+ Title = 'Open gps points file'
DefaultExt = '.gps'
- Filter = 'GPS points (*.gps)|*.gps|All files (*.*)|*.*'
+ Filter = 'GPS files (*.gps)|*.gps|All files (*.*)|*.*'
left = 560
top = 256
end
diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm
index 7cae215a7..d6dac7241 100644
--- a/components/lazmapviewer/example/main.lfm
+++ b/components/lazmapviewer/example/main.lfm
@@ -1,23 +1,23 @@
object MainForm: TMainForm
Left = 345
- Height = 581
+ Height = 640
Top = 121
- Width = 869
+ Width = 883
Caption = 'MainForm'
- ClientHeight = 581
- ClientWidth = 869
+ ClientHeight = 640
+ ClientWidth = 883
OnCreate = FormCreate
OnDestroy = FormDestroy
OnShow = FormShow
ShowHint = True
LCLVersion = '2.1.0.0'
object ControlPanel: TPanel
- Left = 592
- Height = 581
+ Left = 606
+ Height = 640
Top = 0
Width = 277
Align = alRight
- ClientHeight = 581
+ ClientHeight = 640
ClientWidth = 277
TabOrder = 1
object CbProviders: TComboBox
@@ -299,7 +299,7 @@ object MainForm: TMainForm
TabOrder = 7
end
object CbFoundLocations: TComboBox
- AnchorSideLeft.Control = CbLocations
+ AnchorSideLeft.Control = LblProviders
AnchorSideTop.Control = Label8
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnGoTo
@@ -352,10 +352,10 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = BtnGoTo
AnchorSideRight.Side = asrBottom
- Left = 8
+ Left = 9
Height = 52
- Top = 450
- Width = 260
+ Top = 483
+ Width = 259
Anchors = [akTop, akLeft, akRight]
AutoSize = False
BorderSpacing.Top = 8
@@ -364,11 +364,12 @@ object MainForm: TMainForm
WordWrap = True
end
object BtnGPSPoints: TButton
- AnchorSideTop.Control = CbFoundLocations
+ AnchorSideLeft.Control = LblProviders
+ AnchorSideTop.Control = BtnSaveToFile
AnchorSideTop.Side = asrBottom
- Left = 8
+ Left = 9
Height = 25
- Top = 417
+ Top = 450
Width = 92
AutoSize = True
BorderSpacing.Top = 8
@@ -382,10 +383,10 @@ object MainForm: TMainForm
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = InfoBtnGPSPoints
AnchorSideRight.Side = asrBottom
- Left = 8
+ Left = 9
Height = 64
- Top = 502
- Width = 260
+ Top = 535
+ Width = 259
Anchors = [akTop, akLeft, akRight]
AutoSize = False
Caption = 'GPSPointInfo'
@@ -493,15 +494,15 @@ object MainForm: TMainForm
OnClick = BtnSaveMapProvidersClick
end
object BtnSaveToFile: TButton
- AnchorSideLeft.Control = BtnGPSPoints
- AnchorSideLeft.Side = asrBottom
- AnchorSideTop.Control = BtnGPSPoints
- Left = 108
+ AnchorSideLeft.Control = LblProviders
+ AnchorSideTop.Control = CbFoundLocations
+ AnchorSideTop.Side = asrBottom
+ Left = 9
Height = 25
Top = 417
Width = 110
AutoSize = True
- BorderSpacing.Left = 8
+ BorderSpacing.Top = 8
Caption = 'Save map to file'
OnClick = BtnSaveToFileClick
TabOrder = 11
@@ -606,13 +607,27 @@ object MainForm: TMainForm
TabOrder = 13
Text = 'km'
end
+ object BtnLoadGPXFile: TButton
+ AnchorSideLeft.Control = BtnSaveToFile
+ AnchorSideLeft.Side = asrBottom
+ AnchorSideTop.Control = BtnSaveToFile
+ Left = 127
+ Height = 25
+ Top = 417
+ Width = 105
+ AutoSize = True
+ BorderSpacing.Left = 8
+ Caption = 'Load GPX file...'
+ OnClick = BtnLoadGPXFileClick
+ TabOrder = 14
+ end
end
object MapView: TMapView
Left = 0
- Height = 581
+ Height = 640
Hint = 'Displays the map'
Top = 0
- Width = 592
+ Width = 606
Active = False
Align = alClient
CacheOnDisk = True
@@ -634,4 +649,10 @@ object MainForm: TMainForm
left = 328
top = 224
end
+ object OpenDialog: TOpenDialog
+ DefaultExt = '.pgx'
+ Filter = 'GPX files (*.gpx)|*.gpx|All files (*.*)|*.*'
+ left = 832
+ top = 424
+ end
end
diff --git a/components/lazmapviewer/example/main.pas b/components/lazmapviewer/example/main.pas
index e71ac2d11..b0a19efc2 100644
--- a/components/lazmapviewer/example/main.pas
+++ b/components/lazmapviewer/example/main.pas
@@ -18,6 +18,7 @@ type
BtnGoTo: TButton;
BtnGPSPoints: TButton;
BtnSaveToFile: TButton;
+ BtnLoadGPXFile: TButton;
CbDoubleBuffer: TCheckBox;
CbFoundLocations: TComboBox;
CbLocations: TComboBox;
@@ -49,8 +50,10 @@ type
ControlPanel: TPanel;
BtnLoadMapProviders: TSpeedButton;
BtnSaveMapProviders: TSpeedButton;
+ OpenDialog: TOpenDialog;
ZoomTrackBar: TTrackBar;
procedure BtnGoToClick(Sender: TObject);
+ procedure BtnLoadGPXFileClick(Sender: TObject);
procedure BtnSearchClick(Sender: TObject);
procedure BtnGPSPointsClick(Sender: TObject);
procedure BtnSaveToFileClick(Sender: TObject);
@@ -98,7 +101,7 @@ implementation
uses
LCLType, IniFiles, Math, FPCanvas, FPImage, IntfGraphics,
- mvEngine, mvExtraData,
+ mvEngine, mvExtraData, mvGPX,
globals, gpslistform;
type
@@ -189,6 +192,31 @@ begin
MapView.Invalidate;
end;
+procedure TMainForm.BtnLoadGPXFileClick(Sender: TObject);
+var
+ reader: TGpxReader;
+ pt: TGpsPoint;
+ item: TGpsObj;
+begin
+ if OpenDialog.FileName <> '' then
+ OpenDialog.InitialDir := ExtractFileDir(OpenDialog.Filename);
+ if OpenDialog.Execute then begin
+ reader := TGpxReader.Create;
+ try
+ reader.LoadFromFile(OpenDialog.FileName, MapView.GPSItems);
+ item := MapView.GPSItems.Items[MapView.GPSItems.Count-1];
+ if item is TGpsPoint then
+ pt := TGpsPoint(item)
+ else
+ if item is TGpsTrack then
+ pt := TGpsTrack(item).Points[0];
+ MapView.Center := pt.RealPoint;
+ finally
+ reader.Free;
+ end;
+ end;
+end;
+
procedure TMainForm.BtnSaveToFileClick(Sender: TObject);
begin
MapView.SaveToFile(TPortableNetworkGraphic, 'mapview.png');
diff --git a/components/lazmapviewer/lazmapviewerpkg.lpk b/components/lazmapviewer/lazmapviewerpkg.lpk
index 022bf2a14..ef9e47cb1 100644
--- a/components/lazmapviewer/lazmapviewerpkg.lpk
+++ b/components/lazmapviewer/lazmapviewerpkg.lpk
@@ -14,7 +14,7 @@
-
+
@@ -72,6 +72,10 @@ This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/c
+
+
+
+
diff --git a/components/lazmapviewer/lazmapviewerpkg.pas b/components/lazmapviewer/lazmapviewerpkg.pas
index 9b44a94bd..b3d2a2d5f 100644
--- a/components/lazmapviewer/lazmapviewerpkg.pas
+++ b/components/lazmapviewer/lazmapviewerpkg.pas
@@ -4,12 +4,13 @@
unit lazMapViewerPkg;
+{$warn 5023 off : no warning about unused units}
interface
uses
mvCache, mvDownloadEngine, mvDragObj, mvEngine, mvGeoNames, mvGpsObj,
mvJobQueue, mvJobs, mvMapProvider, mvTypes, mvMapViewer, mvExtraData,
- mvDLEFpc, mvMapViewerReg, LazarusPackageIntf;
+ mvDLEFpc, mvMapViewerReg, mvGPX, LazarusPackageIntf;
implementation
diff --git a/components/lazmapviewer/source/mvgpsobj.pas b/components/lazmapviewer/source/mvgpsobj.pas
index 5356397c6..f111e905e 100644
--- a/components/lazmapviewer/source/mvgpsobj.pas
+++ b/components/lazmapviewer/source/mvgpsobj.pas
@@ -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
diff --git a/components/lazmapviewer/source/mvgpx.pas b/components/lazmapviewer/source/mvgpx.pas
new file mode 100644
index 000000000..80feb2379
--- /dev/null
+++ b/components/lazmapviewer/source/mvgpx.pas
@@ -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.
+
diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas
index 9bc95eee5..d6858592b 100644
--- a/components/lazmapviewer/source/mvmapviewer.pas
+++ b/components/lazmapviewer/source/mvmapviewer.pas
@@ -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;