LazMapViewer: Read track color and linewidth from gpx extensions node. Add properties DefaultTrackColor and DefaultTrackWidth.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@6916 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2019-05-16 21:37:34 +00:00
parent 303eea9e94
commit 3d061ebeb1
4 changed files with 138 additions and 10 deletions

View File

@ -632,6 +632,8 @@ object MainForm: TMainForm
Align = alClient Align = alClient
CacheOnDisk = True CacheOnDisk = True
CachePath = 'cache/' CachePath = 'cache/'
DefaultTrackColor = clBlue
DefaultTrackWidth = 3
DownloadEngine = MapView.BuiltIn DownloadEngine = MapView.BuiltIn
InactiveColor = clWhite InactiveColor = clWhite
MapProvider = 'OpenStreetMap Mapnik' MapProvider = 'OpenStreetMap Mapnik'

View File

@ -5,7 +5,7 @@ unit mvExtraData;
interface interface
uses uses
Classes, SysUtils, graphics; Classes, SysUtils, Graphics;
type type
@ -20,24 +20,41 @@ type
constructor Create(aId: integer); virtual; constructor Create(aId: integer); virtual;
property Color: TColor read FColor write SetColor; property Color: TColor read FColor write SetColor;
property Id: integer read FId; property Id: integer read FId;
End; end;
TTrackExtraData = class(TDrawingExtraData)
private
FWidth: Double;
procedure SetWidth(AValue: Double);
public
property Width: Double read FWidth write SetWidth; // Line width in mm
end;
implementation implementation
{ TDrawingExtraData } { TDrawingExtraData }
procedure TDrawingExtraData.SetColor(AValue: TColor);
begin
if FColor = AValue then Exit;
FColor := AValue;
end;
constructor TDrawingExtraData.Create(aId: integer); constructor TDrawingExtraData.Create(aId: integer);
begin begin
FId := aId; FId := aId;
FColor := clRed; FColor := clRed;
end; end;
procedure TDrawingExtraData.SetColor(AValue: TColor);
begin
if FColor = AValue then Exit;
FColor := AValue;
end;
{ TTrackExtraData }
procedure TTrackExtraData.SetWidth(AValue: Double);
begin
if AValue = FWidth then Exit;
FWidth := abs(AValue);
end;
end. end.

View File

@ -15,6 +15,7 @@ type
private private
ID: Integer; ID: Integer;
protected protected
procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
function ReadPoint(ANode: TDOMNode): TGpsPoint; function ReadPoint(ANode: TDOMNode): TGpsPoint;
procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist); procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist);
procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList); procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList);
@ -26,8 +27,12 @@ type
procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList); procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList);
end; end;
implementation implementation
uses
mvExtraData;
var var
PointSettings: TFormatSettings; PointSettings: TFormatSettings;
@ -106,6 +111,36 @@ begin
Result := child.NodeValue; Result := child.NodeValue;
end; 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;
begin
Result := false;
if Length(AGpxText) <> 6 then
exit;
for ch in AGpxText do
if not (ch in ['0'..'9', 'A'..'F', 'a'..'f']) then exit;
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;
Result := true;
end;
{ TGpxReader }
procedure TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList); procedure TGpxReader.LoadFromFile(AFileName: String; AList: TGpsObjectList);
var var
stream: TStream; stream: TStream;
@ -134,6 +169,49 @@ begin
end; end;
end; end;
procedure TGpxReader.ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack);
var
linenode: TDOMNode;
childNode: TDOMNode;
nodeName: string;
color: LongInt;
w: Double = -1;
colorUsed: Boolean = false;
s: String;
begin
if ANode = nil then
exit;
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;
end;
function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint; function TGpxReader.ReadPoint(ANode: TDOMNode): TGpsPoint;
var var
s, slon, slat, sName: String; s, slon, slat, sName: String;
@ -240,6 +318,8 @@ begin
pt := ReadPoint(ANode); pt := ReadPoint(ANode);
if pt <> nil then trk.Points.Add(pt); if pt <> nil then trk.Points.Add(pt);
end; end;
'extensions':
ReadExtensions(ANode, trk);
end; end;
ANode := ANode.NextSibling; ANode := ANode.NextSibling;
end; end;

View File

@ -60,6 +60,8 @@ Type
FInactiveColor: TColor; FInactiveColor: TColor;
FPOIImage: TBitmap; FPOIImage: TBitmap;
FOnDrawGpsPoint: TDrawGpsPointEvent; FOnDrawGpsPoint: TDrawGpsPointEvent;
FDefaultTrackColor: TColor;
FDefaultTrackWidth: Integer;
procedure CallAsyncInvalidate; procedure CallAsyncInvalidate;
procedure DoAsyncInvalidate({%H-}Data: PtrInt); procedure DoAsyncInvalidate({%H-}Data: PtrInt);
procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer); procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer);
@ -79,6 +81,8 @@ Type
procedure SetCacheOnDisk(AValue: boolean); procedure SetCacheOnDisk(AValue: boolean);
procedure SetCachePath({%H-}AValue: String); procedure SetCachePath({%H-}AValue: String);
procedure SetCenter(AValue: TRealPoint); procedure SetCenter(AValue: TRealPoint);
procedure SetDefaultTrackColor(AValue: TColor);
procedure SetDefaultTrackWidth(AValue: Integer);
procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine);
procedure SetInactiveColor(AValue: TColor); procedure SetInactiveColor(AValue: TColor);
procedure SetMapProvider(AValue: String); procedure SetMapProvider(AValue: String);
@ -132,6 +136,8 @@ Type
property Align; property Align;
property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk; property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk;
property CachePath: String read GetCachePath write SetCachePath; property CachePath: String read GetCachePath write SetCachePath;
property DefaultTrackColor: TColor read FDefaultTrackColor write SetDefaultTrackColor default clRed;
property DefaultTrackWidth: Integer read FDefaultTrackWidth write SetDefaultTrackWidth default 1;
property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine; property DownloadEngine: TMvCustomDownloadEngine read GetDownloadEngine write SetDownloadEngine;
property Height default 150; property Height default 150;
property InactiveColor: TColor read FInactiveColor write SetInactiveColor; property InactiveColor: TColor read FInactiveColor write SetInactiveColor;
@ -398,6 +404,20 @@ begin
Engine.Center := AValue; Engine.Center := AValue;
end; end;
procedure TMapView.SetDefaultTrackColor(AValue: TColor);
begin
if FDefaultTrackColor = AValue then exit;
FDefaultTrackColor := AValue;
Invalidate;
end;
procedure TMapView.SetDefaultTrackWidth(AValue: Integer);
begin
if FDefaultTrackWidth = AValue then exit;
FDefaultTrackWidth := AValue;
Invalidate;
end;
procedure TMapView.SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure TMapView.SetDownloadEngine(AValue: TMvCustomDownloadEngine);
begin begin
FDownloadEngine := AValue; FDownloadEngine := AValue;
@ -565,15 +585,20 @@ var
aPt: TRealPoint; aPt: TRealPoint;
LastInside, IsInside: boolean; LastInside, IsInside: boolean;
trkColor: TColor; trkColor: TColor;
trkWidth: Integer;
begin begin
if trk.Points.Count>0 then if trk.Points.Count>0 then
begin begin
trkColor := clRed; trkColor := FDefaultTrackColor;
trkWidth := FDefaultTrackWidth;
if trk.ExtraData <> nil then if trk.ExtraData <> nil then
begin begin
if trk.ExtraData.InheritsFrom(TDrawingExtraData) then if trk.ExtraData.InheritsFrom(TDrawingExtraData) then
trkColor := TDrawingExtraData(trk.ExtraData).Color; trkColor := TDrawingExtraData(trk.ExtraData).Color;
if trk.ExtraData.InheritsFrom(TTrackExtraData) then
trkWidth := round(ScreenInfo.PixelsPerInchX * TTrackExtraData(trk.ExtraData).Width / 25.4);
end; end;
if trkWidth < 1 then trkWidth := 1;
LastInside := false; LastInside := false;
for i:=0 to pred(trk.Points.Count) do for i:=0 to pred(trk.Points.Count) do
begin begin
@ -588,10 +613,12 @@ begin
Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint); Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint);
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer.Canvas.OutlineColor := trkColor; Buffer.Canvas.OutlineColor := trkColor;
// --- no linewidth support in RGBGraphics ---
Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y); Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y);
{$ENDIF} {$ENDIF}
{$IFDEF USE_LAZINTFIMAGE} {$IFDEF USE_LAZINTFIMAGE}
BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor); BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor);
BufferCanvas.Pen.Width := trkWidth;
BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y); BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y);
{$ENDIF} {$ENDIF}
end; end;
@ -759,6 +786,8 @@ begin
FEngine := TMapViewerEngine.Create(self); FEngine := TMapViewerEngine.Create(self);
FBuiltinDownloadEngine := TMvDEFpc.Create(self); FBuiltinDownloadEngine := TMvDEFpc.Create(self);
FBuiltinDownLoadEngine.Name := 'BuiltIn'; FBuiltinDownLoadEngine.Name := 'BuiltIn';
FDefaultTrackColor := clRed;
FDefaultTrackWidth := 1;
{$IFDEF USE_RGBGRAPHICS} {$IFDEF USE_RGBGRAPHICS}
Buffer := TRGB32Bitmap.Create(Width, Height); Buffer := TRGB32Bitmap.Create(Width, Height);
{$ENDIF} {$ENDIF}