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;