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

LazMapViewer: Calculation of bearing, target point by bearing, midpoint, intermediate point. First, Last of TMapCollection, TMapPoint.ToScreen property. TGPSTrack draw event and ConnectColor/Width properties. Better GPX import/export.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9292 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110 2024-03-28 14:28:13 +00:00
parent 6995a6c863
commit 0c1a27965b
4 changed files with 264 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -208,11 +208,18 @@ type
end;
function RealPoint(Lat, Lon: Double): TRealPoint;
function NormalizeLon(const Lon: Double): Double; inline;
function HaversineDist(Lat1, Lon1, Lat2, Lon2, Radius: Double): Double;
function CalcGeoDistance(Lat1, Lon1, Lat2, Lon2: double;
AUnits: TDistanceUnits = duKilometers): double;
function CalcBearing(Lat1, Lon1, Lat2, Lon2: Double): Double;
procedure CalcLatLon(const Lat1, Lon1, ADist, ABearing: Double; out Lat2, Lon2: Double);
procedure CalcMidpoint(const Lat1, Lon1, Lat2, Lon2: Double; out Lat, Lon: Double);
procedure CalcIntermedPoint(const Lat1, Lon1, Lat2, Lon2, AFrac: Double; out Lat, Lon: Double);
function DMSToDeg(Deg, Min: Word; Sec: Double): Double;
function GPSToDMS(Angle: Double): string;
function GPSToDMS(Angle: Double; AFormatSettings: TFormatSettings): string;
@ -1817,6 +1824,96 @@ begin
end;
end;
{ Calculate initial bearing (in °) from the start point Lat1,Lon1 to
the end point Lat2,Lon2. No parameter checks, result normalized to 0°..360°.
}
function CalcBearing(Lat1, Lon1, Lat2, Lon2: Double): Double;
var
latFrom, latTo, lonDiff: Double;
begin
lonDiff := DegToRad(Lon2 - Lon1);
latFrom := DegToRad(Lat1);
latTo := DegToRad(Lat2);
Result := ArcTan2(Sin(lonDiff) * Cos(latTo),
Cos(latFrom) * Sin(latTo) - Sin(latFrom) * Cos(latTo) * Cos(lonDiff));
Result := RadToDeg(Result);
if Result < 0.0 then
Result := Result + 360.0;
end;
{ Calculate end point Lat2,Lon2 by given start point Lat1,Lon1, distance
ADist (in meters) and bearing ABearing (in °). No parameter checks,
result Lon2 normalized to -180°..180°.
}
procedure CalcLatLon(const Lat1, Lon1, ADist, ABearing: Double; out Lat2,
Lon2: Double);
var
latFrom, lonFrom, brng, aD: Double;
begin
latFrom := DegToRad(Lat1);
lonFrom := DegToRad(Lon1);
brng := DegToRad(ABearing);
aD := ADist / EARTH_EQUATORIAL_RADIUS;
Lat2 := ArcSin(Sin(latFrom) * Cos(aD) + Cos(latFrom) * Sin(aD) * Cos(brng));
Lon2 := lonFrom + ArcTan2(Sin(brng) * Sin(aD) * Cos(latFrom),
Cos(aD) - Sin(latFrom) * Sin(Lat2));
Lat2 := RadToDeg(Lat2);
Lon2 := NormalizeLon(RadToDeg(Lon2));
end;
{ Calculate midpoint Lat,Lon by given start point Lat1,Lon1 and end point
Lat2,Lon2. No parameter checks, result Lon normalized to -180°..180°.
}
procedure CalcMidpoint(const Lat1, Lon1, Lat2, Lon2: Double; out Lat,
Lon: Double);
var
latFrom, lonDiff, latTo, lonTo, Bx, By: Double;
begin
lonDiff := DegToRad(Lon2 - Lon1);
latFrom := DegToRad(Lat1);
latTo := DegToRad(Lat2);
lonTo := DegToRad(Lon2);
Bx := Cos(latTo) * Cos(lonDiff);
By := Cos(latTo) * Sin(lonDiff);
Lat := ArcTan2(Sin(latFrom) + Sin(latTo), Sqrt(Sqr(Cos(latFrom) + Bx) + Sqr(By)));
Lon := lonTo + ArcTan2(By, Cos(latFrom) + By);
Lat := RadToDeg(Lat);
Lon := NormalizeLon(RadToDeg(Lon));
end;
{ Calculate intermediate point Lat,Lon by given start point Lat1,Lon1, end point
Lat2,Lon2 and fraction AFrac (0.0-1.0). No parameter checks, result Lon
normalized to -180°..180°.
}
procedure CalcIntermedPoint(const Lat1, Lon1, Lat2, Lon2, AFrac: Double; out
Lat, Lon: Double);
var
latFrom, lonFrom, latTo, lonTo: Double;
A, B, aD, X, Y, Z: Double;
begin
aD := CalcGeoDistance(Lat1, Lon1, Lat2, Lon2) / EARTH_EQUATORIAL_RADIUS;
latFrom := DegToRad(Lat1);
lonFrom := DegToRad(Lon1);
latTo := DegToRad(Lat2);
lonTo := DegToRad(Lon2);
A := Sin((1.0 - AFrac) * aD) / Sin(aD);
B := Sin(AFrac * aD) / Sin(aD);
X := A * Cos(latFrom) * Cos(lonFrom) + B * Cos(latTo) * Cos(lonTo);
Y := A * Cos(latFrom) * Sin(lonFrom) + B * Cos(latTo) * Sin(lonTo);
Z := A * Sin(latFrom) + B * Sin(latTo);
Lat := ArcTan2(Z, Sqrt(Sqr(X) + Sqr(Y)));
Lon := ArcTan2(Y, X);
Lat := RadToDeg(Lat);
Lon := NormalizeLon(RadToDeg(Lon));
end;
function NormalizeLon(const Lon: Double): Double;
begin
if InRange(Lon, -180.0, 180.0)
then Result := Lon
else Result := FMod(Lon + 540.0, 360.0) - 180.0;
end;
{ Converts an angle given as degrees, minutes and seconds to a single
floating point degrees value. }
function DMSToDeg(Deg, Min: Word; Sec: Double): Double;

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

@ -150,6 +150,8 @@ type
TGPSTrack = class(TGPSPolyLine)
private
FConnectColor: TColor;
FConnectWidth: Double;
FDateTime: TDateTime;
FLineWidth: Double; // Line width in mm
FLineColor: TColor;
@ -163,6 +165,8 @@ type
property DateTime: TDateTime read GetDateTime write FDateTime;
property LineColor: TColor read FLineColor write FLineColor;
property LineWidth: Double read FLineWidth write FLineWidth;
property ConnectColor: TColor read FConnectColor write FConnectColor;
property ConnectWidth: Double read FConnectWidth write FConnectWidth;
end;
{ TGPSArea }
@ -933,12 +937,16 @@ begin
inherited;
FLineColor := clDefault; // --> use MapView.DefaultTrackColor
FLineWidth := -1; // --> use MapView.DefaultTrackWidth
FConnectColor := clNone; // --> None, clDefault for LineColor
FConnectWidth := -1; // --> use LineWidth
end;
procedure TGPSTrack.Draw(AView: TObject; Area: TRealArea);
begin
TMapView(AView).DrawTrack(Area, Self);
if Assigned(FOnDrawObj)
then FOnDrawObj(AView, Self, Area)
else TMapView(AView).DrawTrack(Area, Self);
end;
function TGPSTrack.TrackLengthInKm(UseEle: Boolean): double;

227
components/lazmapviewer/source/mvgpx.pas
View File

@ -28,7 +28,8 @@ type
ID: Integer;
FMinLat, FMinLon, FMaxLat, FMaxLon: Double;
protected
procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack); overload;
procedure ReadExtensions(ANode: TDOMNode; APt: TGPSPoint); overload;
function ReadPoint(ANode: TDOMNode): TGpsPoint;
procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
@ -187,36 +188,26 @@ var
begin
Result := '';
child := ANode.FirstChild;
if Assigned(child) and (child.NodeName = '#text') then
if Assigned(child) and ((child.NodeName = '#text') or
(child.NodeName = '#cdata-section'))
then
Result := child.NodeValue;
end;
function TryStrToGpxColor(AGpxText: String; out AColor: LongInt): Boolean;
//type
// PGpxColorRec = ^TGpxColorRec;
// TGpxColorRec = record
// r: array[0..1] of char;
// g: array[0..1] of char;
// b: array[0..1] of char;
// end;
//var
// rv, gv, bv: Integer;
// ch: Char;
function TryStrToGpxColor(AGpxText: String; out AColor: TColor): Boolean;
begin
Result := false;
if AGpxText = 'default' then
begin
AColor := clDefault;
Exit(True);
end;
if AGpxText = 'none' then
begin
AColor := clNone;
Exit(True);
end;
if Length(AGpxText) <> 6 then
exit;
//for ch in AGpxText do
// if not (ch in ['0'..'9', 'A'..'F', 'a'..'f']) then exit;
(* Doesn't work for letters! *)
//with PGpxColorRec(@AGpxText[1])^ do begin
// rv := (ord(r[0]) - ord('0')) * 16 + ord(r[1]) - ord('0');
// gv := (ord(g[0]) - ord('0')) * 16 + ord(g[1]) - ord('0');
// bv := (ord(b[0]) - ord('0')) * 16 + ord(b[1]) - ord('0');
//end;
//AColor := rv + gv shl 8 + bv shl 16;
Exit;
Result := TryStrToInt('$' + AGpxText, AColor);
if Result then
AColor := ((AColor and $FF) shl 16) + (AColor and $FF00) + ((AColor and $FF0000) shr 16);
@ -277,6 +268,7 @@ class procedure TGpxWriter.SaveToStream(AStream: TStream; AList: TGpsObjectList
var
Doc: TXMLDocument;
RootNode: TDOMNode;
Ex, LineEx: TDOMElement;
I: Integer;
O: TGPSObj;
@ -287,23 +279,60 @@ var
Doc.CreateTextNode(AValue));
end;
function CreatePoint(AName: String; APOI: TGPSPoint): TDOMElement;
function ColorToGPXColor(C: TColor): LongInt;
begin
Result := ColorToRGB(C);
Result := ((Result and $FF) shl 16) + (Result and $FF00) + ((Result and $FF0000) shr 16);
end;
function ColorToGPXColorStr(C: TColor): String;
begin
if (C = clDefault)
then Result := 'default'
else if (C = clNone)
then Result := 'none'
else Result := ColorToGPXColor(C).ToHexString(6);
end;
function AddEx(AElm: TDOMElement): TDOMElement;
begin
if not Assigned(Ex) then
Ex := Doc.CreateElement('extensions');
Ex.AppendChild(AElm);
Result := AElm;
end;
function CreatePoint(AName: String; APt: TGPSPoint): TDOMElement;
var
Img: Integer = -1;
begin
Ex := Nil; LineEx := Nil;
Result := Doc.CreateElement(AName);
Result.SetAttribute('lat', APOI.Lat.ToString);
Result.SetAttribute('lon', APOI.Lon.ToString);
if APOI.Name <> '' then
CreateTextElement(Result, 'name', APOI.Name);
if APOI.Elevation <> NO_ELE then
CreateTextElement(Result, 'ele', APOI.Elevation.ToString);
if APOI.DateTime <> NO_DATE then
CreateTextElement(Result, 'time', DateToISO8601(APOI.DateTime));
Result.SetAttribute('lat', APt.Lat.ToString);
Result.SetAttribute('lon', APt.Lon.ToString);
if APt.Name <> '' then
CreateTextElement(Result, 'name', APt.Name);
if APt.Elevation <> NO_ELE then
CreateTextElement(Result, 'ele', APt.Elevation.ToString);
if APt.DateTime <> NO_DATE then
CreateTextElement(Result, 'time', DateToISO8601(APt.DateTime));
if (APt is TGPSPointOfInterest) then
Img := TGPSPointOfInterest(APt).ImageIndex;
if not APt.Visible or (Img <> -1) then
begin
LineEx := AddEx(Doc.CreateElement('misc'));
if not APt.Visible then
CreateTextElement(LineEx, 'visible', '0');
if Img <> -1 then
CreateTextElement(LineEx, 'image', Img.ToString);
end;
if Assigned(Ex) then
Result.AppendChild(Ex);
end;
function CreateTrack(AName: String; ATrack: TGPSTrack): TDOMElement;
var
Seg, LineEx, Ex: TDOMElement;
L: LongInt;
Seg: TDOMElement;
procedure CreateSegments;
var
@ -321,21 +350,29 @@ var
end;
begin
Ex := Nil;
Result := Doc.CreateElement(AName);
if ATrack.Name <> '' then
CreateTextElement(Result, 'name', ATrack.Name);
if Assigned(ATrack.ExtraData) and (ATrack.ExtraData is TTrackExtraData) then
with TTrackExtraData(ATrack.ExtraData) do
begin
Ex := Doc.CreateElement('extensions');
LineEx := Doc.CreateElement('line');
Ex.AppendChild(LineEx);
Result.AppendChild(Ex);
L := ColorToRGB(Color);
L := ((L and $FF) shl 16) + (L and $FF00) + ((L and $FF0000) shr 16);
CreateTextElement(LineEx, 'color', L.ToHexString(6));
CreateTextElement(LineEx, 'width', Width.ToString);
end;
if not ATrack.Visible then
begin
LineEx := AddEx(Doc.CreateElement('misc'));
CreateTextElement(LineEx, 'visible', '0');
end;
if (ATrack.LineColor <> clDefault) or (ATrack.LineWidth > 0) then
begin
LineEx := AddEx(Doc.CreateElement('line'));
CreateTextElement(LineEx, 'color', ColorToGPXColorStr(ATrack.LineColor));
CreateTextElement(LineEx, 'width', ATrack.LineWidth.ToString);
end;
if (ATrack.ConnectColor <> clNone) or (ATrack.ConnectWidth > 0) then
begin
LineEx := AddEx(Doc.CreateElement('segconn'));
CreateTextElement(LineEx, 'color', ColorToGPXColorStr(ATrack.ConnectColor));
CreateTextElement(LineEx, 'width', ATrack.ConnectWidth.ToString);
end;
if Assigned(Ex) then
Result.AppendChild(Ex);
if ATrack.Points.Count > 0 then
begin
Seg := Doc.CreateElement('trkseg');
@ -354,6 +391,7 @@ begin
TDOMElement(RootNode).SetAttribute('creator',
'LazMapViewer https://wiki.lazarus.freepascal.org/LazMapViewer');
Ex := Nil;
for I := 0 to Pred(AList.Count) do
begin
O := AList[I];
@ -392,47 +430,60 @@ begin
Result := LoadFromStream(AStream, AList, area);
end;
function FindChild(ANode: TDOMNode; APath: TStringArray): TDOMNode;
var
N: TDOMNode;
begin
Result := Nil;
if not Assigned(ANode) or (Length(APath) < 1) then
Exit;
N := ANode.FirstChild;
while Assigned(N) do
begin
if APath[0] = N.NodeName then
if Length(APath) > 1
then Exit(FindChild(N, Copy(APath, 1, Pred(Length(APath)))))
else Exit(N);
N := N.NextSibling;
end;
end;
procedure TGpxReader.ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
var
linenode: TDOMNode;
childNode: TDOMNode;
nodeName: string;
color: LongInt;
N: TDOMNode;
color: TColor;
inv: LongInt;
w: Double = -1;
colorUsed: Boolean = false;
s: String;
begin
if ANode = nil then
exit;
if ANode = Nil then
Exit;
N := FindChild(ANode, ['line', 'color']);
if Assigned(N) and TryStrToGpxColor(GetNodeValue(N), color) then
ATrack.LineColor := color;
N := FindChild(ANode, ['line', 'width']);
if Assigned(N) and TryStrToFloat(GetNodeValue(N), w, PointSettings) and (w > 0) then
ATrack.LineWidth := w;
N := FindChild(ANode, ['segconn', 'color']);
if Assigned(N) and TryStrToGpxColor(GetNodeValue(N), color) then
ATrack.ConnectColor := color;
N := FindChild(ANode, ['segconn', 'width']);
if Assigned(N) and TryStrToFloat(GetNodeValue(N), w, PointSettings) and (w > 0) then
ATrack.ConnectWidth := w;
N := FindChild(ANode, ['visible']);
if Assigned(N) and TryStrToInt(GetNodeValue(N), inv) then
ATrack.Visible := inv <> 0;
end;
lineNode := ANode.FirstChild;
while lineNode <> nil do begin
nodeName := lineNode.NodeName;
if nodeName = 'line' then begin
childNode := lineNode.FirstChild;
while childNode <> nil do begin
nodeName := childNode.NodeName;
s := GetNodeValue(childNode);
case nodeName of
'color':
if TryStrToGpxColor(s, color) then colorUsed := true;
'width':
TryStrToFloat(s, w, PointSettings);
end;
childNode := childNode.NextSibling;
end;
end;
lineNode := lineNode.NextSibling;
end;
if (w <> -1) or colorUsed then begin
if ATrack.ExtraData = nil then
ATrack.ExtraData := TTrackExtraData.Create(ID);
if (ATrack.ExtraData is TTrackExtraData) then begin
TTrackExtraData(ATrack.ExtraData).Width := w;
TTrackExtraData(ATrack.ExtraData).Color := color;
end;
end;
procedure TGpxReader.ReadExtensions(ANode: TDOMNode; APt: TGPSPoint);
var
N: TDOMNode;
inv: LongInt;
begin
if ANode = Nil then
Exit;
N := FindChild(ANode, ['visible']);
if Assigned(N) and TryStrToInt(GetNodeValue(N), inv) then
APt.Visible := inv <> 0;
end;
function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint;
@ -460,6 +511,7 @@ begin
sName := '';
dt := NO_DATE;
ele := NO_ELE;
Result := TGpsPoint.Create(lon, lat, ele, dt);
node := ANode.FirstChild;
while node <> nil do begin
nodeName := node.NodeName;
@ -478,11 +530,14 @@ begin
if s <> '' then
dt := ExtractISODateTime(s);
end;
'extensions':
ReadExtensions(node, Result);
end;
node := node.NextSibling;
end;
Result := TGpsPoint.Create(lon, lat, ele, dt);
Result.Name := sname;
Result.Elevation := ele;
Result.DateTime := dt;
FMinLon := Min(FMinLon, lon);
FMaxLon := Max(FMaxLon, lon);
FMinLat := Min(FMinLat, lat);

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

@ -167,8 +167,10 @@ type
{ TMapLayers }
TMapLayers = class(specialize TMapCollection<TMapLayer, TMapView>)
protected
function GetView: TMapView; override;
function GetLayer: TMapLayer; override;
procedure FixOrder(APrevIndex, AIndex: Integer); override;
end;
{ TMapCenter }
@ -1355,6 +1357,21 @@ begin
Result := Nil;
end;
procedure TMapLayers.FixOrder(APrevIndex, AIndex: Integer);
var
I, T, B: Integer;
begin
T := Min(APrevIndex, AIndex);
B := Max(APrevIndex, AIndex);
if APrevIndex < 0 then
begin
T := AIndex;
B := Pred(Count);
end;
for I := T to B do
View.GPSItems.ChangeZOrder(TMapItem(Items[I]).GPSObj, I + FBaseZ);
end;
{ TDrawObjJob }
function TDrawObjJob.pGetTask: integer;