FastReport_2022_VCL/Source/frxMapShape.pas

{******************************************}
{                                          }
{             FastReport VCL               }
{                Map Shape                 }
{                                          }
{         Copyright (c) 1998-2021          }
{            by Fast Reports Inc.          }
{                                          }
{******************************************}

unit frxMapShape;

interface

{$I frx.inc}

uses
{$IFDEF FPC}
  LCLType, LMessages, LazHelper, LCLIntf, LConvEncoding, LazUTF8,
{$ELSE}
  Windows,
{$ENDIF}
  Classes, Contnrs, frxClass, Graphics, Types, frxMapHelpers, frxOSMFileFormat,
  frxGPXFileFormat, frxERSIShapeFileFormat, frxAnaliticGeometry;

type
  TShapeStyle = class(TPersistent)
  private
    FBorderColor: TColor;
    FBorderStyle: TPenStyle;
    FBorderWidth: Integer;
    FFillColor: TColor;
    FPointSize: Extended;
  public
    constructor Create;
    procedure TunePen(Pen: TPen);
  published
    property BorderColor: TColor read FBorderColor write FBorderColor;
    property BorderStyle: TPenStyle read FBorderStyle write FBorderStyle;
    property BorderWidth: Integer read FBorderWidth write FBorderWidth;
    property FillColor: TColor read FFillColor write FFillColor;
    property PointSize: Extended read FPointSize write FPointSize; // Diameter
  end;
(******************************************************************************)
  TShape = class(TPersistent)
  private
    FZoom: Extended;
    FCenterOffsetX: Extended;
    FCenterOffsetY: Extended;
    FOffsetX: Extended;
    FOffsetY: Extended;
    FValue: Extended;
    function GetShapeType: TShapeType;
    function GetLegend(const Name: String): String;
    function GetPartCount: integer;
    function GetShapeCenter: TfrxPoint;
    function GetShapeTags: TStringList;
  protected
    FShapeData: TShapeData;

    procedure Clear; virtual;
  public
    procedure Write(Writer: TWriter);
    procedure WriteData(Writer: TWriter);
    procedure Read(Reader: TReader);
    procedure ReadData(Reader: TReader);

    constructor CreateClear;
    destructor Destroy; override;
    function IsValueEmpty: Boolean;
    function IsMercatorSuitable: Boolean;

    property Value: Extended read FValue write FValue;
    property ShapeType: TShapeType read GetShapeType;
    property Legend[const Name: String]: String read GetLegend;
    property PartCount: integer read GetPartCount;
    property ShapeCenter: TfrxPoint read GetShapeCenter;
    property ShapeData: TShapeData read FShapeData;

    property OffsetX: Extended read FOffsetX write FOffsetX;
    property OffsetY: Extended read FOffsetY write FOffsetY;
    property Zoom: Extended read FZoom write FZoom;
  published
    property CenterOffsetX: Extended read FCenterOffsetX write FCenterOffsetX;
    property CenterOffsetY: Extended read FCenterOffsetY write FCenterOffsetY;
    property ShapeTags: TStringList read GetShapeTags;
  end;

  TAdjustableShape = class(TShape)
  published
    property OffsetX;
    property OffsetY;
    property Zoom;
  end;

(******************************************************************************)
  TShapeList = class(TObjectList)
  private
    FEmbeddedData: Boolean;
    FAdjustableShape: Boolean;

    function GetShape(Index: Integer): TShape;
    procedure SetShape(Index: Integer; const AShape: TShape);
  protected
    FXMin, FXMax, FYMin, FYMax: Extended;
    FConverter: TMapToCanvasCoordinateConverter;
    FValidMapRect: Boolean;

    procedure SetMapRect(XMin, XMax, YMin, YMax: Extended);
    function Data(iRecord, iPart, iPoint: Integer): TDoublePoint;
  public
    constructor Create(Converter: TMapToCanvasCoordinateConverter);
    function AddShapeData(const AShapeData: TShapeData): integer;
    procedure ReplaceShapeData(iRecord: Integer; const AShapeData: TShapeData);

    procedure ReadDFM(Stream: TStream);
    procedure WriteDFM(Stream: TStream);
    procedure Read(Reader: TReader);
    procedure Write(Writer: TWriter);

    function IsGetValues(var Values: TDoubleArray): boolean;
    procedure ClearValues;

    function IsCanvasPolyPoints(iRecord, iPart: Integer;  MapAccuracy, PixelAccuracy: Extended; var PolyPoints: TPointArray): boolean;
    function CanvasPoint(iRecord: Integer): TfrxPoint;
    function CanvasRect(iRecord: Integer): TDoubleRect;
    function CanvasPoly(iRecord: Integer): TDoublePointArray;
    function CanvasMatrix(iRecord: Integer): TDoublePointMatrix;
    function CanvasWidestPartBounds(iRecord: Integer): TfrxRect;
    procedure GetColumnList(List: TStrings);
    function IsValidMapRect(out MapRect: TfrxRect): boolean;
    procedure SetMapRectByData;
    function IsHasLegend(FieldName: String; Legend: String; out iRecord: Integer): boolean;
    function CanvasDistance(iRecord: Integer; P: TfrxPoint): Extended;
    function IsInside(iRecord: Integer; P: TfrxPoint): Boolean; // Canvas Point
    procedure SaveToTextFile(FileName: String);
    function IsMercatorSuitable: Boolean;

    property Items[Index: Integer]: TShape read GetShape write SetShape; default;
    property EmbeddedData: Boolean read FEmbeddedData write FEmbeddedData;
    property AdjustableShape: Boolean read FAdjustableShape write FAdjustableShape;
  end;
(******************************************************************************)
  TOSMFileList = class (TStringList)
  public
    constructor Create;
    destructor Destroy; override;
    procedure AddFile(FileName: String);
    procedure AddLink(Link: String; Stream: TStream);
    function FileByName(FileName: String): TOSMFile;
  end;

  TOSMShapeList = class (TShapeList)
  protected
    procedure LoadData(OSMFile: TOSMFile; LayerTags: TStrings);
  public
    constructor CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter;
      FileList: TOSMFileList; LayerTags: TStrings);
  end;
(******************************************************************************)
  TGPXShapeList = class (TShapeList)
  protected
    procedure LoadData(GPXFile: TGPXFile);
  public
    constructor CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter);
  end;
(******************************************************************************)
  TERSIShapeList = class (TShapeList)
  protected
    procedure LoadData(ERSIFile: TERSIShapeFile);
  public
    constructor CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter);
  end;
(******************************************************************************)

implementation

uses
  Math, SysUtils, frxUtils, frxMapShapeTags {Editor}, frxMapLayerTags;

{ TShape }

procedure TShape.Clear;
begin
  FZoom := 1;
  FCenterOffsetX := 0;
  FCenterOffsetY := 0;
  FOffsetX := 0;
  FOffsetY := 0;
  FValue := NaN;
end;

constructor TShape.CreateClear;
begin
  inherited Create;

  Clear;
end;

destructor TShape.Destroy;
begin
  FShapeData.Free;

  inherited;
end;

function TShape.GetLegend(const Name: String): String;
begin
  Result := FShapeData.Legend[Name];
end;

function TShape.GetPartCount: integer;
begin
  Result := FShapeData.PartCount;
end;

function TShape.GetShapeCenter: TfrxPoint;
begin
  Result := FShapeData.ShapeCenter;
end;

function TShape.GetShapeTags: TStringList;
begin
  Result := FShapeData.Tags;
end;

function TShape.GetShapeType: TShapeType;
begin
  Result := FShapeData.ShapeType;
end;

function TShape.IsMercatorSuitable: Boolean;
begin
  Result := (FShapeData <> nil) and FShapeData.IsMercatorSuitable;
end;

function TShape.IsValueEmpty: Boolean;
begin
  Result := IsNaN(Value);
end;

procedure TShape.Read(Reader: TReader);
begin
  FZoom := Reader.ReadFloat;
  FCenterOffsetX := Reader.ReadFloat;
  FCenterOffsetY := Reader.ReadFloat;
  FOffsetX := Reader.ReadFloat;
  FOffsetY := Reader.ReadFloat;
  FValue := Reader.ReadFloat;

  if FShapeData = nil then
    FShapeData := TShapeData.Create;
  FShapeData.ReadTags(Reader);
end;

procedure TShape.ReadData(Reader: TReader);
begin
  FShapeData.ReadData(Reader);
end;

procedure TShape.Write(Writer: TWriter);
begin
  Writer.WriteFloat(FZoom);
  Writer.WriteFloat(FCenterOffsetX);
  Writer.WriteFloat(FCenterOffsetY);
  Writer.WriteFloat(FOffsetX);
  Writer.WriteFloat(FOffsetY);
  Writer.WriteFloat(FValue);

  FShapeData.WriteTags(Writer);
end;

procedure TShape.WriteData(Writer: TWriter);
begin
  FShapeData.WriteData(Writer);
end;

{ TShapeList }

function TShapeList.AddShapeData(const AShapeData: TShapeData): integer;
begin
  if AdjustableShape then
    Result := Add(TAdjustableShape.CreateClear)
  else
    Result := Add(TShape.CreateClear);
  AShapeData.CalcBounds;
  Items[Count - 1].FShapeData := AShapeData;
end;

function TShapeList.CanvasDistance(iRecord: Integer; P: TfrxPoint): Extended;
begin
  case Items[iRecord].ShapeType of
    stPoint:
      Result := Distance(CanvasPoint(iRecord), P);
    stPolyLine:
      Result := DistancePolyline(CanvasPoly(iRecord), P);
    stPolygon:
      Result := DistancePolygon(CanvasPoly(iRecord), P);
    stRect:
      Result := DistanceRect(CanvasRect(iRecord), P);
    stDiamond:
      Result := DistanceDiamond(CanvasRect(iRecord), P);
    stEllipse:
      Result := DistanceEllipse(CanvasRect(iRecord), P);
    stPicture, stLegend:
      Result := DistancePicture(CanvasRect(iRecord), P);
    stTemplate:
      Result := DistanceTemplate(CanvasPoly(iRecord), P);
    stMultiPoint:
      Result := DistanceMultiPoint(CanvasMatrix(iRecord), P);
    stMultiPolyLine:
      Result := DistanceMultiPolyline(CanvasMatrix(iRecord), P);
    stMultiPolygon:
      Result := DistanceMultiPolygon(CanvasMatrix(iRecord), P);
  else
    raise Exception.Create('Unknown ShapeType');
  end;
end;

function TShapeList.CanvasMatrix(iRecord: Integer): TDoublePointMatrix;
var
  iPart, iPoint : Integer;
begin
  SetLength(Result, Items[iRecord].FShapeData.PartCount);
  for iPart := 0 to High(Result) do
  begin
    SetLength(Result[iPart], Items[iRecord].FShapeData.MultiLineCount[iPart]);
    for iPoint := 0 to High(Result[iPart]) do
      Result[iPart, iPoint] :=
        DoublePoint(FConverter.Transform(Data(iRecord, iPart, iPoint)));
  end;
end;

function TShapeList.CanvasPoint(iRecord: Integer): TfrxPoint;
begin
  Result := FConverter.Transform(Items[iRecord].FShapeData.Point);
end;

function TShapeList.CanvasPoly(iRecord: Integer): TDoublePointArray;
var
  i: Integer;
begin
  SetLength(Result, Items[iRecord].FShapeData.MultiLineCount[0]);
  for i := 0 to High(Result) do
    Result[i] := DoublePoint(FConverter.Transform(Data(iRecord, 0, i)));
end;

function TShapeList.CanvasRect(iRecord: Integer): TDoubleRect;
begin
  Result := Items[iRecord].FShapeData.Rect;
  Result.TopLeft := DoublePoint(FConverter.Transform(Result.TopLeft));
  Result.BottomRight := DoublePoint(FConverter.Transform(Result.BottomRight));
end;

function TShapeList.CanvasWidestPartBounds(iRecord: Integer): TfrxRect;
begin
  Result := FConverter.TransformRect(Items[iRecord].FShapeData.WidestPartBounds);
end;

procedure TShapeList.ClearValues;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    Items[i].Value := NaN;
end;

constructor TShapeList.Create(Converter: TMapToCanvasCoordinateConverter);
begin
  FConverter := Converter;
  OwnsObjects := True;
  FValidMapRect := False;
  FAdjustableShape := False;
  inherited Create;
end;

function TShapeList.Data(iRecord, iPart, iPoint: Integer): TDoublePoint;
begin
  Result := Items[iRecord].FShapeData.MultiLine[iPart, iPoint];
end;

procedure TShapeList.GetColumnList(List: TStrings);
var
  iRecord: Integer;
begin
  for iRecord := 0 to Count - 1 do
    Items[iRecord].FShapeData.IsGetColumnList(List);
end;

function TShapeList.GetShape(Index: Integer): TShape;
begin
  Result := (inherited Items[Index]) as TShape;
end;

function TShapeList.IsCanvasPolyPoints(iRecord, iPart: Integer; MapAccuracy, PixelAccuracy: Extended; var PolyPoints: TPointArray): boolean;
var
  iPoint, UsedCount: Integer;
  Points: TDoublePointArray;
begin
  Result := False;

  Items[iRecord].FShapeData.GetPolyPoints(Points, iPart); // Get Map points
  UsedCount := Length(Points);

  Simplify(Points, MapAccuracy, UsedCount);
  if UsedCount < 2 then
    Exit;

  for iPoint := 0 to UsedCount - 1 do // Get Canvas points
    with FConverter.Transform(Points[iPoint]) do
      Points[iPoint] := DoublePoint(X, Y);

  Simplify(Points, PixelAccuracy, UsedCount);
  if UsedCount < 2 then
    Exit;

  SetLength(PolyPoints, UsedCount);
  for iPoint := 0 to UsedCount - 1 do
    with Points[iPoint] do
      PolyPoints[iPoint] := Point(Round(X), Round(Y));

  Finalize(Points);
  Result := True;
end;

function TShapeList.IsGetValues(var Values: TDoubleArray): boolean;
var
  i, ValuesCount: Integer;
begin
  SetLength(Values, Count);
  ValuesCount := 0;
  for i := 0 to Count - 1 do
    if not Items[i].IsValueEmpty then
    begin
      Values[ValuesCount] := Items[i].Value;
      ValuesCount := ValuesCount + 1;
    end;
  SetLength(Values, ValuesCount);
  Result := ValuesCount <> 0;
end;

function TShapeList.IsHasLegend(FieldName, Legend: String; out iRecord: Integer): boolean;
begin
  iRecord := 0;
  while iRecord <= Count - 1 do
    if Legend = Items[iRecord].FShapeData.Legend[FieldName] then
      Break
    else
      iRecord := iRecord + 1;
  Result := iRecord <= Count - 1;
end;

function TShapeList.IsInside(iRecord: Integer; P: TfrxPoint): Boolean;
begin
  case Items[iRecord].ShapeType of
    stPoint:
      Result := False;
    stPolyLine:
      Result := IsInsidePolyline(CanvasPoly(iRecord), P);
    stPolygon:
      Result := IsInsidePolygon(CanvasPoly(iRecord), P);
    stRect, stPicture, stLegend:
      Result := IsInsideRect(CanvasRect(iRecord), P);
    stDiamond:
      Result := IsInsideDiamond(CanvasRect(iRecord), P);
    stEllipse:
      Result := IsInsideEllipse(CanvasRect(iRecord), P);
    stTemplate:
      Result := IsInsidePolygon(CanvasPoly(iRecord), P);
    stMultiPoint:
      Result := False;
    stMultiPolyLine:
      Result := IsInsideMultiPolyline(CanvasMatrix(iRecord), P);
    stMultiPolygon:
      Result := IsInsideMultiPolygon(CanvasMatrix(iRecord), P);
  else
    raise Exception.Create('Unknown ShapeType');
  end;
end;

function TShapeList.IsMercatorSuitable: Boolean;
var
  i: Integer;
begin
  Result := False;
  for i := 0 to Count - 1 do
    if not Items[i].IsMercatorSuitable then
      Exit;
  Result := True;
end;

function TShapeList.IsValidMapRect(out MapRect: TfrxRect): boolean;
begin
  Result := FValidMapRect;
  if Result then
    MapRect := frxRect(FXMin, FYMin, FXMax, FYMax);
end;

procedure TShapeList.Read(Reader: TReader);
var
  SavedCount, i: Integer;
  Shape: TShape;
begin
  FValidMapRect := Reader.ReadBoolean;
  FXMin := Reader.ReadFloat;
  FXMax := Reader.ReadFloat;
  FYMin := Reader.ReadFloat;
  FYMax := Reader.ReadFloat;
  EmbeddedData := Reader.ReadBoolean;
  SavedCount := Reader.ReadInteger;

  if EmbeddedData then
  begin
    Clear;

    for i := 0 to SavedCount - 1 do
    begin
      if AdjustableShape then
        Shape := TAdjustableShape.CreateClear
      else
        Shape := TShape.CreateClear;
      Shape.Read(Reader);
      Shape.ReadData(Reader);
      Add(Shape);
    end;
  end
  else
    for i := 0 to Count - 1 do
      Items[i].Read(Reader);
end;

procedure TShapeList.ReadDFM(Stream: TStream);
var
  Reader: TReader;
begin
  Reader := TReader.Create(Stream, 4096);
  Read(Reader);
  Reader.Free;
end;

procedure TShapeList.ReplaceShapeData(iRecord: Integer; const AShapeData: TShapeData);
begin
  AShapeData.CalcBounds;
  Items[iRecord].FShapeData.Free;
  Items[iRecord].FShapeData := AShapeData;
end;

procedure TShapeList.SaveToTextFile(FileName: String);
  function ShapeTypeName(ShapeType: TShapeType): String;
  begin
    case ShapeType of
      stNone: Result := 'Unknown';
      stPoint: Result := 'Point';
      stPolyLine: Result := 'PolyLine';
      stPolygon: Result := 'Polygon';
      stRect: Result := 'Rect';
      stDiamond: Result := 'Diamond';
      stEllipse: Result := 'Ellipse';
      stPicture: Result := 'Picture';
      stLegend: Result := 'Legend';
      stTemplate: Result := 'Template';
      stMultiPoint: Result := 'MultiPoint';
      stMultiPolyLine: Result := 'MultiPolyLine';
      stMultiPolygon: Result := 'MultiPolygon';
    end;
  end;
var
  F: TextFile;
  iShape, iPart, iPoint: Integer;
begin
  AssignFile(F, FileName);
  if FileExists(FileName) then
  begin
    Append(F)
  end
  else
    Rewrite(F);

  WriteLn(F, 'Count: ' + IntToStr(Count));
  for iShape := 0 to Count - 1 do
    with Items[iShape] do
    begin
      WriteLn(F, '  ' + ShapeTypeName(ShapeData.ShapeType) + ' PartCount: ' + IntToStr(ShapeData.PartCount));
      for iPart := 0 to ShapeData.PartCount - 1 do
      begin
        System.Write(F, '    MultiLineCount: ' + IntToStr(ShapeData.MultiLineCount[iPart]) + '  ');
        for iPoint := 0 to ShapeData.MultiLineCount[iPart] - 1 do
          with ShapeData.MultiLine[iPart, iPoint] do
            System.Write(F, FloatToStr(X) + ' ' + FloatToStr(Y) + ',');
        WriteLn(F);
      end;
    end;
  CloseFile(F);
end;

procedure TShapeList.SetMapRect(XMin, XMax, YMin, YMax: Extended);
begin
  FXMin := XMin;
  FXMax := XMax;
  FYMin := YMin;
  FYMax := YMax;
  FValidMapRect := True;
end;

procedure TShapeList.SetMapRectByData;
const
  Margin = 0.05;
var
  TotalBounds: TfrxRect;
  iRecord, iPart, iPoint: Integer;
  dWidth, dHeight: Extended;
begin
  if Count > 0 then
  begin
    with Items[0].FShapeData.Point do
      TotalBounds := frxRect(X, Y, X, Y);
    for iRecord := 0 to Count - 1 do
      case Items[iRecord].FShapeData.ShapeType of
        stPoint:
          ExpandRect(TotalBounds, Items[iRecord].FShapeData.Point);
      else
        for iPart := 0 to Items[iRecord].FShapeData.PartCount - 1 do
          for iPoint := 0 to Items[iRecord].FShapeData.MultiLineCount[iPart] - 1 do
            ExpandRect(TotalBounds, Data(iRecord, iPart, iPoint));
      end;
    dWidth := RectWidth(TotalBounds) * Margin;
    dHeight := RectHeight(TotalBounds) * Margin;
    with TotalBounds do
      SetMapRect(Left - dWidth, Right + dWidth, Top - dHeight, Bottom + dHeight);
  end
  else
    FValidMapRect := False;
end;

procedure TShapeList.SetShape(Index: Integer; const AShape: TShape);
begin
  inherited Items[Index] := AShape;
end;

procedure TShapeList.Write(Writer: TWriter);
var
  i: Integer;
begin
  Writer.WriteBoolean(FValidMapRect);
  Writer.WriteFloat(FXMin);
  Writer.WriteFloat(FXMax);
  Writer.WriteFloat(FYMin);
  Writer.WriteFloat(FYMax);
  Writer.WriteBoolean(EmbeddedData);
  Writer.WriteInteger(Count);
  for i := 0 to Count - 1 do
  begin
    Items[i].Write(Writer);
    if EmbeddedData then
      Items[i].WriteData(Writer);
  end;
end;

procedure TShapeList.WriteDFM(Stream: TStream);
var
  Writer: TWriter;
begin
  Writer := TWriter.Create(Stream, 4096);
  Write(Writer);
  Writer.Free;
end;

{ TShapeStyle }

constructor TShapeStyle.Create;
begin
  FBorderColor := clBlack;
  FBorderStyle := psSolid;
  FBorderWidth := 1;
  FFillColor := clWhite;
  FPointSize := 10;
end;

procedure TShapeStyle.TunePen(Pen: TPen);
begin
  Pen.Color := BorderColor;
  Pen.Width := BorderWidth;
  Pen.Style := BorderStyle;
end;

{ TOSMShapeList }

constructor TOSMShapeList.CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter;
  FileList: TOSMFileList; LayerTags: TStrings);
var
  OSMFile: TOSMFile;
begin
  inherited Create(Converter);
  FAdjustableShape := True;

  OSMFile := FileList.FileByName(FileName);

  LoadData(OSMFile, LayerTags);

  if OSMFile.IsValidBounds then
    SetMapRect(OSMFile.Xmin, OSMFile.Xmax, OSMFile.Ymin, OSMFile.Ymax)
  else
    SetMapRectByData;
end;

procedure TOSMShapeList.LoadData(OSMFile: TOSMFile; LayerTags: TStrings);

  procedure LoadPoints(OSMFile: TOSMFile);
  var
    iNode: integer;
  begin
    for iNode := 0 to OSMFile.CountOfNodes - 1 do
      with OSMFile.Nodes[iNode] do
        if (Tags.Count > 0) and IsHaveAnyTag(LayerTags) then
          AddShapeData(TShapeData.CreatePoint(Tags, Longitude, Latitude));
  end;

  procedure LoadPolys(OSMFile: TOSMFile);
  var
    iWay, iNode, iCount: integer;
    FShapeData: TShapeData;
    DP: TDoublePoint;
  begin
    for iWay := 0 to OSMFile.CountOfWays - 1 do
      with OSMFile.Ways[iWay] do
        if IsHaveAnyTag(LayerTags) then
        begin
          FShapeData := TShapeData.CreatePoly(ShapeType, Tags, Count);
          iCount := 0;
          for iNode := 0 to Count - 1 do
            if OSMFile.IsGetNodeAsPoint(iWay, iNode, DP) then
            begin
              FShapeData.MultiLine[0, iCount] := DP;
              Inc(iCount);
            end;
          FShapeData.MultiLineCount[0] := iCount;
          AddShapeData(FShapeData);
        end;
  end;

begin
  LoadPolys(OSMFile);
  LoadPoints(OSMFile);
end;

{ TGPXShapeList }

constructor TGPXShapeList.CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter);
var
  GPXFile: TGPXFile;
begin
  inherited Create(Converter);
  FAdjustableShape := True;

  GPXFile := TGPXFile.Create(FileName);

  LoadData(GPXFile);

  if GPXFile.IsValidBounds then
    SetMapRect(GPXFile.Xmin, GPXFile.Xmax, GPXFile.Ymin, GPXFile.Ymax)
  else
    SetMapRectByData;

  GPXFile.Free;
end;

procedure TGPXShapeList.LoadData(GPXFile: TGPXFile);

  procedure LoadPoints(GPXFile: TGPXFile);
  var
    iWayPoint: integer;
  begin
    for iWayPoint := 0 to GPXFile.CountOfWayPoints - 1 do
      with GPXFile.WayPoints[iWayPoint] do
        AddShapeData(TShapeData.CreatePoint(Tags, Longitude, Latitude));
  end;

  procedure LoadPolys(GPXFile: TGPXFile);
  var
    iTrack, iTrackSegment, iPoint: integer;
    FShapeData: TShapeData;
    DPA: TDoublePointArray;
  begin
    for iTrack := 0 to GPXFile.CountOfTracks - 1 do
      with GPXFile.Tracks[iTrack] do
      begin
        FShapeData := TShapeData.CreateFull(Count, ShapeType, Tags);
        for iTrackSegment := 0 to Count - 1 do
        begin
          GetSegmentPoints(iTrackSegment, DPA);
          FShapeData.MultiLineCount[iTrackSegment] := Length(DPA);
          for iPoint := 0 to High(DPA) do
            FShapeData.MultiLine[iTrackSegment, iPoint] := DPA[iPoint];
        end;
        AddShapeData(FShapeData);
      end;
  end;

begin
  LoadPolys(GPXFile);
  LoadPoints(GPXFile);
end;

{ TERSIShapeList }

constructor TERSIShapeList.CreateFromFile(FileName: String; Converter: TMapToCanvasCoordinateConverter);
var
  ERSIShapeFile: TERSIShapeFile;
begin
  inherited Create(Converter);
  FAdjustableShape := True;

  ERSIShapeFile := TERSIShapeFile.Create(FileName);

  LoadData(ERSIShapeFile);

  SetMapRect(ERSIShapeFile.Xmin, ERSIShapeFile.Xmax, ERSIShapeFile.Ymin, ERSIShapeFile.Ymax);

  ERSIShapeFile.Free;
end;

procedure TERSIShapeList.LoadData(ERSIFile: TERSIShapeFile);

  procedure AddPoint(Tags: TStringList; X, Y: Double);
  begin
    AddShapeData(TShapeData.CreatePoint(Tags, X, Y));
  end;

  procedure AddMultiPoint(iRecord: Integer; Tags: TStringList);
  var
    iPoint: Integer;
    FShapeData: TShapeData;
  begin
    FShapeData := TShapeData.CreateFull(1, stMultiPoint, Tags);
    FShapeData.MultiPointCount := ERSIFile.MultiPointCount[iRecord];

    for iPoint := 0 to High(FShapeData.MultiPointCount) do
      FShapeData.MultiPoint[iPoint] := ERSIFile.MultiPoint[iRecord, iPoint];
    AddShapeData(FShapeData);
  end;

  procedure AddPoly(iRecord: Integer; ST: TShapeType; Tags: TStringList);
  var
    Count, iPart, iPoint: Integer;
    DPA: TDoublePointArray;
    FShapeData: TShapeData;
  begin
    Count := ERSIFile.PolyPartsCount[iRecord];
    FShapeData := TShapeData.CreateFull(Count, ST, Tags);
    for iPart := 0 to Count - 1 do
    begin
      ERSIFile.GetPartPoints(DPA, iRecord, iPart);
      FShapeData.MultiLineCount[iPart] := Length(DPA);
      for iPoint := 0 to High(DPA) do
        FShapeData.MultiLine[iPart, iPoint] := DPA[iPoint];
    end;
    AddShapeData(FShapeData);
  end;

var
  iRecord, iColumn: Integer;
  Tags, Columns: TStringList;
begin
  Columns := TStringList.Create;
  ERSIFile.GetColumnList(Columns);
  for iRecord := 0 to ERSIFile.RecordCount - 1 do
  begin
    Tags := TStringList.Create;
    for iColumn := 0 to Columns.Count - 1 do
      Tags.Add(Columns[iColumn] + Tags.NameValueSeparator + ERSIFile.LegendToString[iColumn, iRecord]);
    case ERSIFile.ERSIShapeType[iRecord] of
      ERSI_Point:
        with ERSIFile.Point[iRecord] do
          AddPoint(Tags, X, Y);
      ERSI_PolyLine:
        if Count > 1 then AddPoly(iRecord, stMultiPolyLine, Tags)
        else              AddPoly(iRecord, stPolyLine, Tags);
      ERSI_Polygon:
        if Count > 1 then AddPoly(iRecord, stMultiPolygon, Tags)
        else              AddPoly(iRecord, stPolygon, Tags);
      ERSI_MultiPoint:
        AddMultiPoint(iRecord, Tags);
    end;
    Tags.Free;
  end;
  Columns.Free;
end;

{ TOSMFileList }

procedure TOSMFileList.AddFile(FileName: String);
var
  i: Integer;
begin
  if not Find(SafeFileName(FileName), i) then
    AddObject(SafeFileName(FileName), TOSMFile.Create(FileName))
end;

procedure TOSMFileList.AddLink(Link: String; Stream: TStream);
var
  i: Integer;
begin
  if not Find(SafeFileName(Link), i) then
    AddObject(SafeFileName(Link), TOSMFile.Create(Link, Stream));
end;

constructor TOSMFileList.Create;
begin
  inherited;
  Sorted := True;
  Duplicates := dupError;
end;

destructor TOSMFileList.Destroy;
var
  i: integer;
begin
  for i := 0 to Count - 1 do
    Objects[i].Free;
  inherited;
end;

function TOSMFileList.FileByName(FileName: String): TOSMFile;
var
  Index: integer;
begin
  if Find(SafeFileName(FileName), Index) then
    Result := Objects[Index] as TOSMFile
  else
    Result := nil;
end;

end.