You've already forked lazarus-ccr
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:
@ -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'
|
||||
|
@ -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.
|
||||
|
||||
|
@ -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;
|
||||
|
@ -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}
|
||||
|
Reference in New Issue
Block a user