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

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'

components/lazmapviewer/source/mvextradata.pas

@@ -5,7 +5,7 @@ unit mvExtraData;
 interface
 
 uses
-  Classes, SysUtils, graphics;
+  Classes, SysUtils, Graphics;
 
 type
 
@@ -20,24 +20,41 @@ type
     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.
 

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;

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}