paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

LazMapViewer: Add support of GPX files.

Browse Source 
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 2019-05-15 09:36:08 +00:00
parent d650914a3f
commit b1b663cbbe
9 changed files with 402 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
components/lazmapviewer/example/MapViewer_Demo.lpi
View File

@ -82,7 +82,7 @@
</Linking>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Exceptions Count="4">
<Item1>
<Name Value="EAbort"/>
</Item1>
@ -92,6 +92,9 @@
<Item3>
<Name Value="EFOpenError"/>
</Item3>
<Item4>
<Name Value="EHTTPClient"/>
</Item4>
</Exceptions>
</Debugging>
</CONFIG>

4
components/lazmapviewer/example/gpslistform.lfm
View File

@ -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

69
components/lazmapviewer/example/main.lfm
View File

@ -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

30
components/lazmapviewer/example/main.pas
View File

@ -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');

6
components/lazmapviewer/lazmapviewerpkg.lpk
View File

@ -14,7 +14,7 @@
<Description Value="Component for viewing maps (Google, OpenStreetMap, etc).
This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/ci/master/tree/mapviewer/) which itself is based on the MapViewer by Maciej Kaczkowski (https://github.com/maciejkaczkowski/mapviewer)."/>
<License Value="GPL2 or later"/>
<Files Count="14">
<Files Count="15">
<Item1>
<Filename Value="source/mvcache.pas"/>
<UnitName Value="mvCache"/>
@ -72,6 +72,10 @@ This is a fork of MapViewer by ti_dic (https://sourceforge.net/p/roadbook/code/c
<HasRegisterProc Value="True"/>
<UnitName Value="mvMapViewerReg"/>
</Item14>
<Item15>
<Filename Value="source/mvgpx.pas"/>
<UnitName Value="mvgpx"/>
</Item15>
</Files>
<RequiredPkgs Count="1">
<Item1>

3
components/lazmapviewer/lazmapviewerpkg.pas
View File

@ -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

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

@ -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
View 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.

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

@ -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;