diff --git a/components/lazmapviewer/example/main.lfm b/components/lazmapviewer/example/main.lfm index d6dac7241..1ffa1481f 100644 --- a/components/lazmapviewer/example/main.lfm +++ b/components/lazmapviewer/example/main.lfm @@ -632,6 +632,8 @@ object MainForm: TMainForm Align = alClient CacheOnDisk = True CachePath = 'cache/' + DefaultTrackColor = clBlue + DefaultTrackWidth = 3 DownloadEngine = MapView.BuiltIn InactiveColor = clWhite MapProvider = 'OpenStreetMap Mapnik' diff --git a/components/lazmapviewer/source/mvextradata.pas b/components/lazmapviewer/source/mvextradata.pas index 29c6f0e1d..b42a75d50 100644 --- a/components/lazmapviewer/source/mvextradata.pas +++ b/components/lazmapviewer/source/mvextradata.pas @@ -5,7 +5,7 @@ unit mvExtraData; interface uses - Classes, SysUtils, graphics; + Classes, SysUtils, Graphics; type @@ -17,27 +17,44 @@ type FId: integer; procedure SetColor(AValue: TColor); public - constructor Create(aId: integer);virtual; + constructor Create(aId: integer); virtual; property Color: TColor read FColor write SetColor; 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 { TDrawingExtraData } -procedure TDrawingExtraData.SetColor(AValue: TColor); -begin - if FColor = AValue then Exit; - FColor := AValue; -end; - constructor TDrawingExtraData.Create(aId: integer); begin FId := aId; FColor := clRed; 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. diff --git a/components/lazmapviewer/source/mvgpx.pas b/components/lazmapviewer/source/mvgpx.pas index 80feb2379..022805d36 100644 --- a/components/lazmapviewer/source/mvgpx.pas +++ b/components/lazmapviewer/source/mvgpx.pas @@ -15,6 +15,7 @@ type private ID: Integer; protected + procedure ReadExtensions(ANode: TDOMNode; ATrack: TGpsTrack); function ReadPoint(ANode: TDOMNode): TGpsPoint; procedure ReadRoute(ANode: TDOMNode; AList: TGpsObjectlist); procedure ReadTrack(ANode: TDOMNode; AList: TGpsObjectList); @@ -26,8 +27,12 @@ type procedure LoadFromStream(AStream: TStream; AList: TGpsObjectList); end; + implementation +uses + mvExtraData; + var PointSettings: TFormatSettings; @@ -106,6 +111,36 @@ begin 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; +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); var stream: TStream; @@ -134,6 +169,49 @@ begin 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; var s, slon, slat, sName: String; @@ -240,6 +318,8 @@ begin pt := ReadPoint(ANode); if pt <> nil then trk.Points.Add(pt); end; + 'extensions': + ReadExtensions(ANode, trk); end; ANode := ANode.NextSibling; end; diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index d6858592b..0b36500ac 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -60,6 +60,8 @@ Type FInactiveColor: TColor; FPOIImage: TBitmap; FOnDrawGpsPoint: TDrawGpsPointEvent; + FDefaultTrackColor: TColor; + FDefaultTrackWidth: Integer; procedure CallAsyncInvalidate; procedure DoAsyncInvalidate({%H-}Data: PtrInt); procedure DrawObjects(const {%H-}TileId: TTileId; aLeft, aTop, aRight,aBottom: integer); @@ -79,6 +81,8 @@ Type procedure SetCacheOnDisk(AValue: boolean); procedure SetCachePath({%H-}AValue: String); procedure SetCenter(AValue: TRealPoint); + procedure SetDefaultTrackColor(AValue: TColor); + procedure SetDefaultTrackWidth(AValue: Integer); procedure SetDownloadEngine(AValue: TMvCustomDownloadEngine); procedure SetInactiveColor(AValue: TColor); procedure SetMapProvider(AValue: String); @@ -132,6 +136,8 @@ Type property Align; property CacheOnDisk: boolean read GetCacheOnDisk write SetCacheOnDisk; 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 Height default 150; property InactiveColor: TColor read FInactiveColor write SetInactiveColor; @@ -398,6 +404,20 @@ begin Engine.Center := AValue; 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); begin FDownloadEngine := AValue; @@ -565,15 +585,20 @@ var aPt: TRealPoint; LastInside, IsInside: boolean; trkColor: TColor; + trkWidth: Integer; begin if trk.Points.Count>0 then begin - trkColor := clRed; + trkColor := FDefaultTrackColor; + trkWidth := FDefaultTrackWidth; if trk.ExtraData <> nil then begin if trk.ExtraData.InheritsFrom(TDrawingExtraData) then trkColor := TDrawingExtraData(trk.ExtraData).Color; + if trk.ExtraData.InheritsFrom(TTrackExtraData) then + trkWidth := round(ScreenInfo.PixelsPerInchX * TTrackExtraData(trk.ExtraData).Width / 25.4); end; + if trkWidth < 1 then trkWidth := 1; LastInside := false; for i:=0 to pred(trk.Points.Count) do begin @@ -588,10 +613,12 @@ begin Old := Engine.LonLatToScreen(trk.Points[pred(i)].RealPoint); {$IFDEF USE_RGBGRAPHICS} Buffer.Canvas.OutlineColor := trkColor; + // --- no linewidth support in RGBGraphics --- Buffer.Canvas.Line(Old.X, Old.y, New.X, New.Y); {$ENDIF} {$IFDEF USE_LAZINTFIMAGE} BufferCanvas.Pen.FPColor := TColorToFPColor(trkColor); + BufferCanvas.Pen.Width := trkWidth; BufferCanvas.Line(Old.X, Old.Y, New.X, New.Y); {$ENDIF} end; @@ -759,6 +786,8 @@ begin FEngine := TMapViewerEngine.Create(self); FBuiltinDownloadEngine := TMvDEFpc.Create(self); FBuiltinDownLoadEngine.Name := 'BuiltIn'; + FDefaultTrackColor := clRed; + FDefaultTrackWidth := 1; {$IFDEF USE_RGBGRAPHICS} Buffer := TRGB32Bitmap.Create(Width, Height); {$ENDIF}