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
|
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'
|
||||||
|
@ -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.
|
||||||
|
|
||||||
|
@ -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;
|
||||||
|
@ -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}
|
||||||
|
Reference in New Issue
Block a user