1820 lines
52 KiB
ObjectPascal
1820 lines
52 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastReport VCL }
|
|
{ Map Layer }
|
|
{ }
|
|
{ Copyright (c) 1998-2021 }
|
|
{ by Fast Reports Inc. }
|
|
{ }
|
|
{******************************************}
|
|
|
|
unit frxMapLayer;
|
|
|
|
interface
|
|
|
|
{$I frx.inc}
|
|
|
|
uses
|
|
frxClass, Contnrs,
|
|
{$IFNDEF FPC}
|
|
Windows,
|
|
{$ELSE}
|
|
LCLType, LCLIntf, LCLProc, LazHelper,
|
|
{$ENDIF}
|
|
Graphics, Classes, frxMapShape, frxMapHelpers, frxDsgnIntf,
|
|
frxMapColorRangeForm, frxMapSizeRangeForm, frxMapRanges, frxAnaliticGeometry, frxProtocolFactory;
|
|
|
|
type
|
|
TMapOperation = (opSum, opAverage, opMin, opMax, opCount);
|
|
TMapLabelKind = (mlNone, mlName, mlValue, mlNameAndValue);
|
|
TMapPalette = (mpNone, mpLight, mpPastel, mpGrayScale, mpEarth, mpSea, mpBrightPastel);
|
|
(******************************************************************************)
|
|
TOperationCalculator = class
|
|
private
|
|
FValue: Extended;
|
|
FCount: Integer;
|
|
FOperation: TMapOperation;
|
|
public
|
|
constructor Create(AOperation: TMapOperation); reintroduce;
|
|
procedure Add(AValue: Extended);
|
|
function Get: Extended;
|
|
end;
|
|
(******************************************************************************)
|
|
TValuesList = class(TStringList)
|
|
private
|
|
FOperation: TMapOperation;
|
|
function GetOperationCalculator(Index: integer): TOperationCalculator;
|
|
public
|
|
constructor Create(AOperation: TMapOperation); reintroduce;
|
|
destructor Destroy; override;
|
|
procedure AddValue(SpatialValue: String; AnalyticalValue: Extended);
|
|
function MinValue: Extended;
|
|
function MaxValue: Extended;
|
|
|
|
property OperationCalculator[Index: integer]: TOperationCalculator read GetOperationCalculator;
|
|
end;
|
|
(******************************************************************************)
|
|
TfrxCustomLayer = class(TfrxComponent)
|
|
private
|
|
FLabelKind: TMapLabelKind;
|
|
FHighlightColor: TColor;
|
|
FSelectedShapeIndex: Integer;
|
|
FAnalyticalValue: String;
|
|
FSpatialValue: String;
|
|
FMapPalette: TMapPalette;
|
|
FOperation: TMapOperation;
|
|
FDataSet: TfrxDataSet;
|
|
FColorRanges: TfrxColorRanges;
|
|
FValueFormat: String;
|
|
FFilter: String;
|
|
FDefaultShapeStyle: TShapeStyle;
|
|
FSizeRanges: TfrxSizeRanges;
|
|
FPointLabelsVisibleAtZoom: Extended;
|
|
FActive: Boolean;
|
|
FShowLines: Boolean;
|
|
FShowPoints: Boolean;
|
|
FShowPolygons: Boolean;
|
|
|
|
function GetSelectedShape: TShape;
|
|
function GetColorRangeData: TColorRangeCollection;
|
|
function GetSizeRangeData: TSizeRangeCollection;
|
|
protected
|
|
FLabelColumn: String;
|
|
FSpatialColumn: String;
|
|
FMapAccuracy: Extended;
|
|
FPixelAccuracy: Extended;
|
|
FPreviousSelectedShapeIndex: Integer;
|
|
|
|
FValuesList: TValuesList;
|
|
FShapes: TShapeList;
|
|
FConverter: TMapToCanvasCoordinateConverter;
|
|
FMapView: TComponent;
|
|
FActiveHyperlink: Boolean;
|
|
FVectorGraphic: TGraphic;
|
|
FClippingRect: TfrxClippingRect;
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FClippingMapRect: TfrxClippingRect;
|
|
{$ENDIF}
|
|
procedure Draw(Canvas: TCanvas);
|
|
|
|
procedure DrawClippedPoint(Canvas: TCanvas; X, Y, Radius: Extended);
|
|
procedure DrawPoint(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawMultiPoint(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawPointLegend(Canvas: TCanvas; iRecord: Integer);
|
|
|
|
procedure DrawPolyLine(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawPolygon(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawPolyLegend(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawTemplate(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawRect(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawDiamond(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawEllipse(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawPicture(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawLegend(Canvas: TCanvas; iRecord: Integer);
|
|
procedure DrawHighlightFrame(Canvas: TCanvas; iRecord: Integer);
|
|
|
|
procedure TunePoint(Canvas: TCanvas; iRecord: Integer; out Radius: Extended);
|
|
procedure TuneBrush(Brush: TBrush; iRecord: Integer);
|
|
procedure TunePen(Pen: TPen; iRecord: Integer);
|
|
procedure SetParent(AParent: TfrxComponent); override;
|
|
procedure InitTransform(iRecord: Integer); virtual; // Empty
|
|
function GetShapeValue(iRecord: Integer): String;
|
|
function GetShapeName(FieldName: String; iRecord: Integer): String;
|
|
function GetShapeLegeng(FieldName: String; iRecord: Integer): String;
|
|
function GetSelectedShapeName: String; virtual;
|
|
function GetSelectedShapeValue: String; virtual;
|
|
function IsHighlightSelectedShape: boolean; virtual;
|
|
function IsHiddenShape(iRecord: Integer): Boolean; virtual; // False;
|
|
procedure GetDesigningData;
|
|
procedure InitialiseData; virtual;
|
|
function IsCanGetData: Boolean; virtual;
|
|
procedure FinaliseData;
|
|
procedure FillRanges(const Values: TDoubleArray);
|
|
procedure ExpandVariables; virtual;
|
|
procedure AddValueList(vaAnalyticalValue: Variant); virtual; abstract;
|
|
function IsIncludeAsRegion(P: TfrxPoint): Boolean; virtual;
|
|
function IsSpecialBorderColor(iRecord: Integer; out SpecialColor: TColor): Boolean; virtual; // False;
|
|
function IsSpecialFillColor(iRecord: Integer; out SpecialColor: TColor): Boolean; virtual; // False;
|
|
procedure DefineProperties(Filer: TFiler); override;
|
|
procedure DefinePrimeProperties(Filer: TFiler); virtual; // Empty
|
|
function GetMetaFile(CanvasSize: TfrxPoint; ActiveHyperlink: Boolean): TMetaFile;
|
|
|
|
property SelectedShapeIndex: Integer read FSelectedShapeIndex write FSelectedShapeIndex;
|
|
property MapAccuracy: Extended read FMapAccuracy write FMapAccuracy;
|
|
property PixelAccuracy: Extended read FPixelAccuracy write FPixelAccuracy;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure DrawOn(Canvas: TCanvas; ActiveHyperlink: Boolean; aClipRect: TfrxRect);
|
|
procedure BuildGraphic(CanvasSize: TfrxPoint; ActiveHyperlink: Boolean);
|
|
function IsInclude(P: TfrxPoint): Boolean; virtual;
|
|
procedure GetData;
|
|
function IsHasMapRect(out MapRect: TfrxRect): boolean;
|
|
function IsHasZoomRect(out ZoomRect: TfrxRect): boolean; virtual;
|
|
function IsSelectedShapeChanded: Boolean;
|
|
procedure GetColumnList(List: TStrings); virtual;
|
|
procedure ClearSelectedShape;
|
|
function IsMercatorSuitable: Boolean;
|
|
procedure SwapShapes(EditedLayer: TfrxCustomLayer);
|
|
procedure CopyDatasets(CustomLayer: TfrxCustomLayer); virtual;
|
|
|
|
property ClippingRect: TfrxClippingRect read FClippingRect;
|
|
property SelectedShape: TShape read GetSelectedShape;
|
|
property SelectedShapeName: String read GetSelectedShapeName;
|
|
property SelectedShapeValue: String read GetSelectedShapeValue;
|
|
property VectorGraphic: TGraphic read FVectorGraphic;
|
|
property MapView: TComponent read FMapView;
|
|
|
|
property ShowLines: Boolean read FShowLines write FShowLines default True;
|
|
property ShowPoints: Boolean read FShowPoints write FShowPoints default True;
|
|
property ShowPolygons: Boolean read FShowPolygons write FShowPolygons default True;
|
|
property LabelColumn: String read FLabelColumn write FLabelColumn;
|
|
property SpatialColumn: String read FSpatialColumn write FSpatialColumn;
|
|
property SpatialValue: String read FSpatialValue write FSpatialValue;
|
|
published
|
|
property Active: Boolean read FActive write FActive;
|
|
property Visible;
|
|
property Font;
|
|
property AnalyticalValue: String read FAnalyticalValue write FAnalyticalValue;
|
|
property ColorRanges: TfrxColorRanges read FColorRanges;
|
|
property ColorRangesData: TColorRangeCollection read GetColorRangeData;
|
|
property DataSet: TfrxDataSet read FDataSet write FDataSet;
|
|
property DefaultShapeStyle: TShapeStyle read FDefaultShapeStyle;
|
|
property Filter: String read FFilter write FFilter;
|
|
property HighlightColor: TColor read FHighlightColor write FHighlightColor;
|
|
property Operation: TMapOperation read FOperation write FOperation; // function
|
|
property ValueFormat: String read FValueFormat write FValueFormat; // LabelFormat
|
|
property LabelKind: TMapLabelKind read FLabelKind write FLabelKind;
|
|
property MapPalette: TMapPalette read FMapPalette write FMapPalette; // Palette
|
|
property SizeRanges: TfrxSizeRanges read FSizeRanges;
|
|
property SizeRangesData: TSizeRangeCollection read GetSizeRangeData;
|
|
property PointLabelsVisibleAtZoom: Extended read FPointLabelsVisibleAtZoom write FPointLabelsVisibleAtZoom;
|
|
end;
|
|
(******************************************************************************)
|
|
TMapLayerList = class
|
|
private
|
|
FObjects: TList;
|
|
FSelectedLayerIndex: Integer;
|
|
function GetSelectedLayer: TfrxCustomLayer;
|
|
function GetCount: Integer;
|
|
function GetLayer(Index: Integer): TfrxCustomLayer;
|
|
protected
|
|
FPreviousSelectedLayerIndex: Integer;
|
|
public
|
|
constructor Create(AObjects: TList);
|
|
procedure Exchange(Index1, Index2: Integer);
|
|
function IndexOf(Item: Pointer): Integer;
|
|
|
|
function IsSelectedShapeChanded: Boolean;
|
|
function IsInclude(P: TfrxPoint): Boolean;
|
|
procedure GetData;
|
|
function IsMercatorSuitable: Boolean;
|
|
|
|
property Count: Integer read GetCount;
|
|
property Items[Index: Integer]: TfrxCustomLayer read GetLayer; default;
|
|
property SelectedLayer: TfrxCustomLayer read GetSelectedLayer;
|
|
end;
|
|
(******************************************************************************)
|
|
TfrxMapFileLayer = class(TfrxCustomLayer, IfrxDataLinkObject)
|
|
private
|
|
FZoomPolygon: String;
|
|
procedure SetLayerTags(const Value: TStringList);
|
|
function GetFileTags: TfrxSumStringList;
|
|
function LoadDataStream(Stream: TStream; const NewLink: String): Boolean;
|
|
function GetLink(LoadMethod: TfrxDataLinkLoadMethod): String;
|
|
function IsExpressionLink: Boolean;
|
|
function GetDataLink: TfrxDataLink;
|
|
procedure SetDataLink(const Value: TfrxDataLink);
|
|
function IsDataLinkStored: Boolean;
|
|
protected
|
|
FMapFileName: String;
|
|
FLayerTags: TStringList;
|
|
FFirstReading: Boolean;
|
|
FDataLink: TfrxDataLink;
|
|
|
|
function GetSelectedShapeName: String; override;
|
|
function GetSelectedShapeValue: String; override;
|
|
procedure InitTransform(iRecord: Integer); override;
|
|
procedure InitialiseData; override;
|
|
function IsCanGetData: Boolean; override;
|
|
function IsHighlightSelectedShape: boolean; override;
|
|
|
|
procedure SetMapFileName(AMapFileName: String);
|
|
function GetFileExtension: string;
|
|
|
|
procedure ExpandVariables; override;
|
|
procedure AddValueList(vaAnalyticalValue: Variant); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function IsHasZoomRect(out ZoomRect: TfrxRect): boolean; override;
|
|
procedure Embed;
|
|
procedure ReRead;
|
|
procedure JustAdded;
|
|
|
|
property FileTags: TfrxSumStringList read GetFileTags;
|
|
published
|
|
property DataLink: TfrxDataLink read GetDataLink write SetDataLink stored IsDataLinkStored;
|
|
property ShowLines;
|
|
property ShowPoints;
|
|
property ShowPolygons;
|
|
property LabelColumn;
|
|
property SpatialColumn;
|
|
property LayerTags: TStringList read FLayerTags write SetLayerTags;
|
|
property MapAccuracy;
|
|
property MapFileName: String read FMapFileName write SetMapFileName;
|
|
property PixelAccuracy;
|
|
property SpatialValue;
|
|
property ZoomPolygon: String read FZoomPolygon write FZoomPolygon;
|
|
end;
|
|
(******************************************************************************)
|
|
TfrxApplicationLayer = class(TfrxCustomLayer)
|
|
private
|
|
FLabelValue: String;
|
|
FLatitudeValue: String;
|
|
FLongitudeValue: String;
|
|
protected
|
|
procedure InitialiseData; override;
|
|
function IsCanGetData: Boolean; override;
|
|
|
|
procedure ExpandVariables; override;
|
|
procedure AddValueList(vaAnalyticalValue: Variant); override;
|
|
function ApplicationShapeData(X, Y: Extended; Name, Location: String): TShapeData;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
function IsInclude(P: TfrxPoint): Boolean; override; // False
|
|
published
|
|
property LabelValue: String read FLabelValue write FLabelValue;
|
|
property LatitudeValue: String read FLatitudeValue write FLatitudeValue;
|
|
property LongitudeValue: String read FLongitudeValue write FLongitudeValue;
|
|
end;
|
|
(******************************************************************************)
|
|
type
|
|
TfrxLabelColumnProperty = class(TfrxPropertyEditor)
|
|
public
|
|
function GetValue: String; override;
|
|
function GetAttributes: TfrxPropertyAttributes; override;
|
|
procedure GetValues; override;
|
|
procedure SetValue(const Value: String); override;
|
|
end;
|
|
(******************************************************************************)
|
|
procedure OperationGetList(List: TStrings);
|
|
procedure PaletteGetList(List: TStrings);
|
|
procedure PenStyleGetList(List: TStrings);
|
|
procedure MapLabelKindGetList(List: TStrings);
|
|
procedure GeoDataKindList(List: TStrings);
|
|
(******************************************************************************)
|
|
implementation
|
|
|
|
uses
|
|
SysUtils, Math, frxMap,
|
|
Types, Variants, frxUtils, frxRes, frxMapLayerTags {Editor},
|
|
frxPictureGraphics, frxBaseGraphicsTypes,
|
|
frxOSMFileFormat, frxPolygonTemplate
|
|
{$IFDEF DELPHI16}
|
|
, UITypes
|
|
{$ENDIF} {It is necessary to prevent H2443}
|
|
;
|
|
|
|
const
|
|
AppLabelColumn = 'NAME';
|
|
AppSpatialColumn = 'LOCATION';
|
|
|
|
PaletteSize = 8;
|
|
FullPalette: array[TMapPalette] of array[0..PaletteSize - 1] of TColor =
|
|
((clNone, clNone, clNone, clNone, clNone, clNone, clNone, clNone),
|
|
($fae6e6, $f5f0ff, $b9daff, $cdfaff, $e1e4ff, $f0fff0, $fff8f0, $f5f5f5),
|
|
($89e0bf, $b7bdc8, $9cfaff, $8ac5f4, $e2ce87, $96a0e6, $dca0a0, $9595ff),
|
|
($c8c8c8, $bcbcbc, $b2b2b2, $a8a8a8, $9d9d9d, $939393, $888888, $7d7d7d),
|
|
($0080ff, $0b86b8, $0040c0, $238e6b, $3f85cd, $00c0c0, $228b22, $1e69d2),
|
|
($578b2e, $aacd66, $b48246, $8b8b00, $a09e5f, $71b33c, $ccd148, $8bbc8f),
|
|
($f08c41, $41b4fa, $0a40e0, $926405, $a8b9f1, $816350, $82e3ff, $dd9c12));
|
|
|
|
{ Utilities }
|
|
procedure MapLabelKindGetList(List: TStrings);
|
|
begin
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
List.Add(frxResources.Get('mlNone'));
|
|
List.Add(frxResources.Get('mlName'));
|
|
List.Add(frxResources.Get('mlValue'));
|
|
List.Add(frxResources.Get('mlNameAndValue'));
|
|
List.EndUpdate;
|
|
end;
|
|
|
|
procedure PenStyleGetList(List: TStrings);
|
|
begin
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
List.Add(frxResources.Get('psSolid'));
|
|
List.Add(frxResources.Get('psDash'));
|
|
List.Add(frxResources.Get('psDot'));
|
|
List.Add(frxResources.Get('psDashDot'));
|
|
List.Add(frxResources.Get('psDashDotDot'));
|
|
List.Add(frxResources.Get('psClear'));
|
|
List.Add(frxResources.Get('psInsideFrame'));
|
|
List.Add(frxResources.Get('psUserStyle'));
|
|
List.Add(frxResources.Get('psAlternate'));
|
|
List.EndUpdate;
|
|
end;
|
|
|
|
procedure PaletteGetList(List: TStrings);
|
|
begin
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
List.Add(frxResources.Get('mpNone'));
|
|
List.Add(frxResources.Get('mpLight'));
|
|
List.Add(frxResources.Get('mpPastel'));
|
|
List.Add(frxResources.Get('mpGrayScale'));
|
|
List.Add(frxResources.Get('mpEarth'));
|
|
List.Add(frxResources.Get('mpSea'));
|
|
List.Add(frxResources.Get('mpBrightPastel'));
|
|
List.EndUpdate;
|
|
end;
|
|
|
|
procedure OperationGetList(List: TStrings);
|
|
begin
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
List.Add(frxResources.Get('opSum'));
|
|
List.Add(frxResources.Get('opAverage'));
|
|
List.Add(frxResources.Get('opMin'));
|
|
List.Add(frxResources.Get('opMax'));
|
|
List.Add(frxResources.Get('opCount'));
|
|
List.EndUpdate;
|
|
end;
|
|
|
|
procedure GeoDataKindList(List: TStrings);
|
|
begin
|
|
List.BeginUpdate;
|
|
List.Clear;
|
|
List.Add(frxResources.Get('gdWKT'));
|
|
List.Add(frxResources.Get('gdWKB'));
|
|
List.EndUpdate;
|
|
end;
|
|
{ TfrxCustomLayer }
|
|
|
|
procedure TfrxCustomLayer.BuildGraphic(CanvasSize: TfrxPoint; ActiveHyperlink: Boolean);
|
|
begin
|
|
FVectorGraphic.Free;
|
|
FVectorGraphic := GetMetaFile(CanvasSize, ActiveHyperlink);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.ClearSelectedShape;
|
|
begin
|
|
FSelectedShapeIndex := Unknown;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.CopyDatasets(CustomLayer: TfrxCustomLayer);
|
|
begin
|
|
DataSet := CustomLayer.DataSet;
|
|
end;
|
|
|
|
constructor TfrxCustomLayer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FShowLines := True;
|
|
FShowPoints := True;
|
|
FShowPolygons := True;
|
|
FSelectedShapeIndex := Unknown;
|
|
FPreviousSelectedShapeIndex := Unknown;
|
|
FLabelKind := mlNone;
|
|
FHighlightColor := clLime;
|
|
FAnalyticalValue := '';
|
|
FSpatialValue := '';
|
|
FMapPalette := mpNone;
|
|
FOperation := opSum;
|
|
FDataSet := nil;
|
|
FColorRanges := TfrxColorRanges.Create(TfrxMapView(AOwner).ColorScale);
|
|
FSizeRanges := TfrxSizeRanges.Create(TfrxMapView(AOwner).SizeScale);
|
|
FValueFormat := '%1.2f';
|
|
FDefaultShapeStyle := TShapeStyle.Create;
|
|
FPointLabelsVisibleAtZoom := 1;
|
|
FClippingRect := TfrxClippingRect.Create;
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FClippingMapRect := TfrxClippingRect.Create;
|
|
{$ENDIF}
|
|
FShapes := nil;
|
|
|
|
FValuesList := nil;
|
|
FConverter := TfrxMapView(AOwner).Converter;
|
|
FMapView := AOwner;
|
|
FVectorGraphic := nil;
|
|
FActive := True;
|
|
frComponentStyle := frComponentStyle + [csDefaultDiff];
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DefinePrimeProperties(Filer: TFiler);
|
|
begin
|
|
// Empty
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DefineProperties(Filer: TFiler);
|
|
var
|
|
CRC: TColorRangeCollection;
|
|
SRC: TSizeRangeCollection;
|
|
begin
|
|
inherited;
|
|
DefinePrimeProperties(Filer);
|
|
|
|
CRC := ColorRanges.ColorRangeCollection;
|
|
SRC := SizeRanges.SizeRangeCollection;
|
|
if [csDesigning, csLoading] * ComponentState <> [] then // dfm
|
|
begin
|
|
Filer.DefineBinaryProperty('Shapes', FShapes.ReadDFM, FShapes.WriteDFM, FShapes <> nil);
|
|
Filer.DefineBinaryProperty('ColorRangeCollection', CRC.ReadDFM, CRC.WriteDFM, CRC <> nil);
|
|
Filer.DefineBinaryProperty('SizeRangeCollection', SRC.ReadDFM, SRC.WriteDFM, SRC <> nil);
|
|
end
|
|
else // fr3
|
|
begin
|
|
Filer.DefineProperty('Shapes', FShapes.Read, FShapes.Write, FShapes <> nil);
|
|
Filer.DefineProperty('ColorRangeCollection', CRC.Read, CRC.Write, CRC <> nil);
|
|
Filer.DefineProperty('SizeRangeCollection', SRC.Read, SRC.Write, SRC <> nil);
|
|
end;
|
|
|
|
end;
|
|
|
|
destructor TfrxCustomLayer.Destroy;
|
|
begin
|
|
FColorRanges.Free;
|
|
FDefaultShapeStyle.Free;
|
|
FShapes.Free;
|
|
FValuesList.Free;
|
|
FVectorGraphic.Free;
|
|
FSizeRanges.Free;
|
|
FClippingRect.Free;
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FClippingMapRect.Free;
|
|
{$ENDIF}
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.Draw(Canvas: TCanvas);
|
|
var
|
|
iRecord: Integer;
|
|
begin
|
|
DefaultShapeStyle.TunePen(Canvas.Pen);
|
|
|
|
Canvas.Lock;
|
|
try
|
|
Canvas.Brush.Style := bsClear;
|
|
for iRecord := 0 to FShapes.Count - 1 do
|
|
if not IsHiddenShape(iRecord) then
|
|
case FShapes[iRecord].ShapeType of
|
|
stPoint:
|
|
if ShowPoints then
|
|
DrawPoint(Canvas, iRecord);
|
|
stPolyLine, stMultiPolyLine:
|
|
if ShowLines then
|
|
DrawPolyLine(Canvas, iRecord);
|
|
stPolygon, stMultiPolygon:
|
|
if ShowPolygons then
|
|
DrawPolygon(Canvas, iRecord);
|
|
stRect:
|
|
DrawRect(Canvas, iRecord);
|
|
stDiamond:
|
|
DrawDiamond(Canvas, iRecord);
|
|
stEllipse:
|
|
DrawEllipse(Canvas, iRecord);
|
|
stPicture:
|
|
DrawPicture(Canvas, iRecord);
|
|
stLegend:
|
|
DrawLegend(Canvas, iRecord);
|
|
stTemplate:
|
|
DrawTemplate(Canvas, iRecord);
|
|
stMultiPoint:
|
|
if ShowPoints then
|
|
DrawMultiPoint(Canvas, iRecord);
|
|
else
|
|
raise Exception.Create('Unknown ShapeType');
|
|
end;
|
|
for iRecord := 0 to FShapes.Count - 1 do
|
|
if not IsHiddenShape(iRecord) then
|
|
case FShapes[iRecord].ShapeType of
|
|
stPoint, stMultiPoint:
|
|
if ShowPoints then
|
|
if TfrxMapView(FMapView).Zoom >= PointLabelsVisibleAtZoom then
|
|
DrawPointLegend(Canvas, iRecord);
|
|
stPolyLine, stMultiPolyLine:
|
|
if ShowLines then
|
|
DrawPolyLegend(Canvas, iRecord);
|
|
stPolygon, stMultiPolygon:
|
|
if ShowPolygons then
|
|
DrawPolyLegend(Canvas, iRecord);
|
|
stRect, stDiamond, stEllipse, stPicture, stLegend, stTemplate:
|
|
DrawPolyLegend(Canvas, iRecord);
|
|
else
|
|
raise Exception.Create('Unknown ShapeType');
|
|
end;
|
|
finally
|
|
Canvas.Unlock;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawClippedPoint(Canvas: TCanvas; X, Y, Radius: Extended);
|
|
begin
|
|
if FClippingRect.IsCircleInside(Circle(X, Y, Radius)) then
|
|
Canvas.Ellipse(Round(X - Radius), Round(Y - Radius),
|
|
Round(X + Radius), Round(Y + Radius));
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawDiamond(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Rect: TRect;
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
Rect := ToRect(FShapes.CanvasRect(iRecord));
|
|
if FClippingRect.IsDiamondInside(Rect) then
|
|
with Rect do
|
|
Canvas.Polygon([Point((Left + Right) div 2, Top), Point(Right, (Top + Bottom) div 2),
|
|
Point((Left + Right) div 2, Bottom), Point(Left, (Top + Bottom) div 2)]);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawEllipse(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Rect: TRect;
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
Rect := ToRect(FShapes.CanvasRect(iRecord));
|
|
if FClippingRect.IsRectInside(Rect) then
|
|
with Rect do
|
|
Canvas.Ellipse(Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawHighlightFrame(Canvas: TCanvas; iRecord: Integer);
|
|
begin
|
|
Canvas.Pen.Color := HighlightColor;
|
|
Canvas.Brush.Style := bsClear;
|
|
Canvas.Pen.Width := 2;
|
|
with ToRect(FShapes.CanvasRect(iRecord)) do
|
|
Canvas.Rectangle(Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
{$IFNDEF FRX_DONT_USE_METAFILE_MAP}
|
|
procedure TfrxCustomLayer.DrawLegend(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Metafile: TMetafile;
|
|
MetafileCanvas: TMetafileCanvas;
|
|
Rect: TRect;
|
|
i, hStep: Integer;
|
|
begin
|
|
InitTransform(iRecord);
|
|
|
|
Rect := ToRect(FShapes.CanvasRect(iRecord));
|
|
if not FClippingRect.IsRectInside(Rect) then
|
|
Exit;
|
|
|
|
Metafile := TMetafile.Create;
|
|
Metafile.Width := Rect.Right - Rect.Left;
|
|
Metafile.Height := Rect.Bottom - Rect.Top;
|
|
MetafileCanvas := TMetafileCanvas.Create(Metafile, 0);
|
|
MetafileCanvas.Font.Assign(FShapes[iRecord].ShapeData.Font);
|
|
MetafileCanvas.Brush.Style := bsClear;
|
|
hStep := MetafileCanvas.TextHeight('Wy');
|
|
for i := 0 to FShapes[iRecord].ShapeData.LegendText.Count - 1 do
|
|
MetafileCanvas.TextOut(0, i * hStep, FShapes[iRecord].ShapeData.LegendText[i]);
|
|
MetafileCanvas.Free;
|
|
|
|
Canvas.CopyMode := cmSrcCopy;
|
|
Canvas.Draw(Rect.Left, Rect.Top, Metafile);
|
|
if IsHighlightSelectedShape and (FSelectedShapeIndex = iRecord) then
|
|
DrawHighlightFrame(Canvas, iRecord);
|
|
Metafile.Free;
|
|
end;
|
|
{$ELSE}
|
|
procedure TfrxCustomLayer.DrawLegend(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Rect: TRect;
|
|
i, hStep: Integer;
|
|
oldBS: TBrushStyle;
|
|
oldFont: TFont;
|
|
begin
|
|
InitTransform(iRecord);
|
|
|
|
Rect := ToRect(FShapes.CanvasRect(iRecord));
|
|
if not FClippingRect.IsRectInside(Rect) then
|
|
Exit;
|
|
|
|
oldFont := Canvas.Font;
|
|
oldBS := Canvas.Brush.Style;
|
|
Canvas.Font.Assign(FShapes[iRecord].ShapeData.Font);
|
|
Canvas.Brush.Style := bsClear;
|
|
Canvas.CopyMode := cmSrcCopy;
|
|
try
|
|
hStep := Canvas.TextHeight('Wy');
|
|
for i := 0 to FShapes[iRecord].ShapeData.LegendText.Count - 1 do
|
|
Canvas.TextOut(Rect.Left, Rect.Top + i * hStep, FShapes[iRecord].ShapeData.LegendText[i]);
|
|
|
|
if IsHighlightSelectedShape and (FSelectedShapeIndex = iRecord) then
|
|
DrawHighlightFrame(Canvas, iRecord);
|
|
|
|
finally
|
|
Canvas.Font.Assign(oldFont);
|
|
Canvas.Brush.Style := oldBS;
|
|
end;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
procedure TfrxCustomLayer.DrawMultiPoint(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Radius: Extended;
|
|
iPoint: Integer;
|
|
CP: TDoublePointArray;
|
|
OldStyle: TBrushStyle;
|
|
begin
|
|
TunePoint(Canvas, iRecord, Radius);
|
|
OldStyle := Canvas.Brush.Style;
|
|
if Canvas.Brush.Color = clNone then
|
|
Canvas.Brush.Style := bsClear;
|
|
try
|
|
CP := FShapes.CanvasPoly(iRecord);
|
|
for iPoint := 0 to High(CP) do
|
|
with CP[iPoint] do
|
|
DrawClippedPoint(Canvas, X, Y, Radius);
|
|
finally
|
|
Canvas.Brush.Style := OldStyle;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawOn(Canvas: TCanvas; ActiveHyperlink: Boolean; aClipRect: TfrxRect);
|
|
var
|
|
aMap: TfrxMapView;
|
|
begin
|
|
aMap := TfrxMapView(FMapView);
|
|
Canvas.Font := Font;
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FClippingMapRect.Init(aMap.ClipMap,
|
|
aMap.MapViewport);
|
|
{$ENDIF}
|
|
FClippingRect.Init(aMap.ClipMap,
|
|
aClipRect);
|
|
|
|
if IsDesigning and (FShapes <> nil) then
|
|
GetDesigningData;
|
|
|
|
FActiveHyperlink := ActiveHyperlink;
|
|
|
|
if Assigned(FShapes) then
|
|
Draw(Canvas);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPicture(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
SourceGrapic: TGraphic;
|
|
DR: TDoubleRect;
|
|
DestRect: TRect;
|
|
begin
|
|
InitTransform(iRecord);
|
|
|
|
SourceGrapic := FShapes[iRecord].ShapeData.Picture.Graphic;
|
|
DR := FShapes.CanvasRect(iRecord);
|
|
if FShapes[iRecord].ShapeData.ConstrainProportions then
|
|
DR := ConstrainedDR(DR, SourceGrapic.Width, SourceGrapic.Height);
|
|
DestRect := ToRect(DR);
|
|
|
|
if not FClippingRect.IsRectInside(DestRect) then
|
|
Exit;
|
|
|
|
Canvas.CopyMode := cmSrcCopy;
|
|
frxSetBkMode(Canvas,TRANSPARENT);
|
|
SourceGrapic.Transparent := False;
|
|
GetGraphicFormats.Draw(Canvas, SourceGrapic, DestRect, gqDefault);
|
|
|
|
// Canvas.StretchDraw(DestRect, SourceGrapic);
|
|
if IsHighlightSelectedShape and (FSelectedShapeIndex = iRecord) then
|
|
DrawHighlightFrame(Canvas, iRecord);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPoint(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Radius: Extended;
|
|
OldStyle: TBrushStyle;
|
|
begin
|
|
TunePoint(Canvas, iRecord, Radius);
|
|
OldStyle := Canvas.Brush.Style;
|
|
if Canvas.Brush.Color = clNone then
|
|
Canvas.Brush.Style := bsClear;
|
|
|
|
try
|
|
with FShapes.CanvasPoint(iRecord) do
|
|
DrawClippedPoint(Canvas, X, Y, Radius);
|
|
finally
|
|
Canvas.Brush.Style := OldStyle;
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPointLegend(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Legend: String;
|
|
Rect: TRect;
|
|
dX, dY: Integer;
|
|
P: TfrxPoint;
|
|
begin
|
|
Canvas.Brush.Style := bsClear;
|
|
|
|
Legend := Trim(GetShapeLegeng(LabelColumn, iRecord));
|
|
if Legend = '' then
|
|
Exit;
|
|
|
|
Rect := Bounds(0, 0, 0, 0);
|
|
DrawText(Canvas.Handle, PChar(Legend), Length(Legend), Rect, DT_CALCRECT);
|
|
|
|
InitTransform(iRecord);
|
|
|
|
P := FConverter.Transform(DoublePoint(FShapes[iRecord].ShapeCenter));
|
|
|
|
dX := Round(P.X - (Rect.Right + Rect.Left) / 2 + FShapes[iRecord].CenterOffsetX);
|
|
dY := Round(P.Y - Rect.Bottom - Canvas.Font.Size / 2 + FShapes[iRecord].CenterOffsetY);
|
|
OffsetRect(Rect, dX, dY);
|
|
if FClippingRect.IsRectInside(Rect) then
|
|
DrawText(Canvas.Handle, PChar(Legend), Length(Legend), Rect, DT_CENTER + DT_NOCLIP);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPolygon(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
iPart: Integer;
|
|
PolyPoints: TPointArray;
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
for iPart := 0 to FShapes[iRecord].PartCount - 1 do
|
|
begin
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
if TfrxMapView(FMapView).ClipMap and not FClippingMapRect.IsPolygonInside(FShapes.Items[iRecord].ShapeData, iPart) then
|
|
continue;
|
|
{$ENDIF}
|
|
if FShapes.IsCanvasPolyPoints(iRecord, iPart, MapAccuracy, PixelAccuracy, PolyPoints)
|
|
and FClippingRect.IsPolygonInside(PolyPoints) then
|
|
if Canvas.Brush.Color = clNone then // Transparent
|
|
begin
|
|
if not PointsEqual(PolyPoints[0], PolyPoints[High(PolyPoints)]) then
|
|
begin
|
|
SetLength(PolyPoints, Length(PolyPoints) + 1);
|
|
PolyPoints[High(PolyPoints)] := PolyPoints[0];
|
|
end;
|
|
Canvas.Polyline(PolyPoints);
|
|
end
|
|
else
|
|
Canvas.Polygon(PolyPoints);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPolyLegend(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Text: String;
|
|
TextHeight: Integer;
|
|
dHeight: Extended;
|
|
Rect: TRect;
|
|
R: TfrxRect;
|
|
begin
|
|
Canvas.Brush.Style := bsClear;
|
|
|
|
Text := Trim(GetShapeLegeng(LabelColumn, iRecord));
|
|
if Text = '' then
|
|
Exit;
|
|
|
|
Rect := Bounds(0, 0, 0, 0);
|
|
TextHeight := DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, DT_CALCRECT);
|
|
InitTransform(iRecord);
|
|
R := FShapes.CanvasWidestPartBounds(iRecord);
|
|
if (TextHeight <= R.Bottom - R.Top) and (Rect.Right - Rect.Left <= R.Right - R.Left) then
|
|
with FShapes[iRecord] do
|
|
begin
|
|
R.Left := R.Left + CenterOffsetX;
|
|
R.Right := R.Right + CenterOffsetX;
|
|
dHeight := (R.Bottom - R.Top - TextHeight) / 2;
|
|
R.Top := R.Top + dHeight + CenterOffsetY;
|
|
R.Bottom := R.Bottom - dHeight + CenterOffsetY;
|
|
Rect := Types.Rect(Round(R.Left), Round(R.Top), Round(R.Right), Round(R.Bottom));
|
|
if FClippingRect.IsRectInside(Rect) then
|
|
DrawText(Canvas.Handle, PChar(Text), Length(Text), Rect, DT_CENTER + DT_NOCLIP);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawPolyLine(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
iPart: Integer;
|
|
PolyPoints: TPointArray;
|
|
begin
|
|
InitTransform(iRecord);
|
|
|
|
TunePen(Canvas.Pen, iRecord);
|
|
|
|
for iPart := 0 to FShapes[iRecord].PartCount - 1 do
|
|
begin
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
if TfrxMapView(FMapView).ClipMap and not FClippingMapRect.IsPolyLineInside(FShapes.Items[iRecord].ShapeData, iPart) then
|
|
continue;
|
|
{$ENDIF}
|
|
if FShapes.IsCanvasPolyPoints(iRecord, iPart, MapAccuracy, PixelAccuracy, PolyPoints)
|
|
and FClippingRect.IsPolyLineInside(PolyPoints) then
|
|
Canvas.PolyLine(PolyPoints);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawRect(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
Rect: TRect;
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
Rect := ToRect(FShapes.CanvasRect(iRecord));
|
|
if FClippingRect.IsRectInside(Rect) then
|
|
with Rect do
|
|
Canvas.Rectangle(Left, Top, Right, Bottom);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.DrawTemplate(Canvas: TCanvas; iRecord: Integer);
|
|
var
|
|
PolygonTemplate: TfrxPolygonTemplate;
|
|
Points: TPointArray;
|
|
begin
|
|
PolygonTemplate := PolygonTemplateList.ItemsByName[FShapes[iRecord].ShapeData.TemplateName];
|
|
if PolygonTemplate <> nil then
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
|
|
FShapes.IsCanvasPolyPoints(iRecord, 0, 0, 0, Points);
|
|
PolygonTemplate.Draw(Canvas, Points);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.ExpandVariables;
|
|
begin
|
|
with TfrxMapView(FMapView) do
|
|
begin
|
|
ExpandVar(FAnalyticalValue);
|
|
ExpandVar(FSpatialValue);
|
|
ExpandVar(FFilter);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.FillRanges(const Values: TDoubleArray);
|
|
begin
|
|
if FColorRanges.RangeCount > 0 then
|
|
FColorRanges.Fill(Values);
|
|
if FSizeRanges.RangeCount > 0 then
|
|
FSizeRanges.Fill(Values);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.FinaliseData;
|
|
var
|
|
Values: TDoubleArray;
|
|
begin
|
|
if FShapes <> nil then
|
|
if FShapes.IsGetValues(Values) then
|
|
FillRanges(Values);
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetColorRangeData: TColorRangeCollection;
|
|
begin
|
|
Result := FColorRanges.ColorRangeCollection;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.GetColumnList(List: TStrings);
|
|
var
|
|
ColumnList: TStringList;
|
|
begin
|
|
ColumnList := TStringList.Create;
|
|
ColumnList.Sorted := True;
|
|
ColumnList.Duplicates := dupIgnore;
|
|
if FShapes <> nil then
|
|
FShapes.GetColumnList(ColumnList);
|
|
List.Assign(ColumnList);
|
|
ColumnList.Free;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.GetData;
|
|
var
|
|
vaAnalyticalValue: Variant;
|
|
stSpatialValue, sLink: String;
|
|
Index, iRecord: Integer;
|
|
DataLink: IfrxDataLinkObject;
|
|
|
|
procedure AddValues;
|
|
begin
|
|
if (Trim(Filter) = '') or
|
|
(Report.Calc(Filter) = True { Since Report.Calc: Variant } ) then
|
|
begin
|
|
vaAnalyticalValue := Report.Calc(AnalyticalValue);
|
|
|
|
if not VarIsNull(vaAnalyticalValue) then
|
|
AddValueList(vaAnalyticalValue);
|
|
end;
|
|
end;
|
|
begin
|
|
ExpandVariables;
|
|
InitialiseData;
|
|
|
|
if IsCanGetData then
|
|
begin
|
|
if (DataSet <> nil) then
|
|
begin
|
|
DataSet.First;
|
|
while not DataSet.Eof do
|
|
begin
|
|
AddValues;
|
|
DataSet.Next;
|
|
end;
|
|
end
|
|
else
|
|
AddValues;
|
|
|
|
for iRecord := 0 to FShapes.Count - 1 do
|
|
begin
|
|
stSpatialValue := FShapes[iRecord].Legend[SpatialColumn];
|
|
if FValuesList.Find(stSpatialValue, Index) then
|
|
FShapes[iRecord].Value := FValuesList.OperationCalculator[Index].Get;
|
|
end;
|
|
end;
|
|
|
|
FinaliseData;
|
|
if Supports(Self, IfrxDataLinkObject, DataLink) then
|
|
begin
|
|
sLink := DataLink.GetLink(dlmOnGetData);
|
|
if DataLink.IsExpressionLink then
|
|
TfrxMapView(FMapView).ExpandVar(sLink);
|
|
if sLink <> '' then
|
|
frxDataProtocols.LoadToObject(sLink, DataLink);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.GetDesigningData;
|
|
const
|
|
MinValue = 1.0;
|
|
MaxValue = 1000.0;
|
|
var
|
|
iRecord: Integer;
|
|
begin
|
|
InitialiseData;
|
|
for iRecord := 0 to FShapes.Count - 1 do
|
|
begin
|
|
RandSeed := iRecord + 1;
|
|
FShapes[iRecord].Value := MinValue + (MaxValue - MinValue) * Random;
|
|
end;
|
|
FinaliseData;
|
|
end;
|
|
|
|
{$IFNDEF FRX_DONT_USE_METAFILE_MAP}
|
|
function TfrxCustomLayer.GetMetaFile(CanvasSize: TfrxPoint; ActiveHyperlink: Boolean): TMetaFile;
|
|
var
|
|
Canvas: TCanvas;
|
|
begin
|
|
Result := TMetaFile.Create;
|
|
Result.Width := Round(CanvasSize.X);
|
|
Result.Height := Round(CanvasSize.Y);
|
|
|
|
Canvas := TMetafileCanvas.Create(Result, 0);
|
|
Canvas.Font := Font;
|
|
|
|
with TfrxMapView(FMapView) do
|
|
FClippingRect.Init(ClipMap,
|
|
frxRect(-OffSetX, -OffSetY, -OffSetX + Width, -OffSetY + Height));
|
|
|
|
if IsDesigning and (FShapes <> nil) then
|
|
GetDesigningData;
|
|
|
|
FActiveHyperlink := ActiveHyperlink;
|
|
|
|
if Assigned(FShapes) then
|
|
Draw(Canvas);
|
|
|
|
Canvas.Free;
|
|
end;
|
|
{$ELSE}
|
|
function TfrxCustomLayer.GetMetaFile(CanvasSize: TfrxPoint; ActiveHyperlink: Boolean): TMetaFile;
|
|
begin
|
|
Result := nil;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
function TfrxCustomLayer.GetSelectedShape: TShape;
|
|
begin
|
|
if FSelectedShapeIndex = Unknown then
|
|
Result := nil
|
|
else
|
|
Result := FShapes[FSelectedShapeIndex];
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetSelectedShapeName: String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetSelectedShapeValue: String;
|
|
begin
|
|
Result := '';
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetShapeLegeng(FieldName: String; iRecord: Integer): String;
|
|
var
|
|
stValue: String;
|
|
begin
|
|
case LabelKind of
|
|
mlNone:
|
|
Result := '';
|
|
mlName:
|
|
Result := GetShapeName(FieldName, iRecord);
|
|
mlValue:
|
|
Result := GetShapeValue(iRecord);
|
|
mlNameAndValue:
|
|
begin
|
|
Result := GetShapeName(FieldName, iRecord);
|
|
stValue := GetShapeValue(iRecord);
|
|
Result := Result + IfStr((Result <> '') and (stValue <> ''), #13#10) + stValue;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetShapeName(FieldName: String; iRecord: Integer): String;
|
|
begin
|
|
Result := FShapes[iRecord].Legend[FieldName];
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetShapeValue(iRecord: Integer): String;
|
|
begin
|
|
with FShapes[iRecord] do
|
|
Result := IfStr(IsValueEmpty, '', Format(ValueFormat, [Value]));
|
|
end;
|
|
|
|
function TfrxCustomLayer.GetSizeRangeData: TSizeRangeCollection;
|
|
begin
|
|
Result := FSizeRanges.SizeRangeCollection;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.InitialiseData;
|
|
begin
|
|
FValuesList.Free;
|
|
FValuesList := TValuesList.Create(Operation);
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.InitTransform(iRecord: Integer);
|
|
begin
|
|
// Empty
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsCanGetData: Boolean;
|
|
begin
|
|
{ can handle static expression }
|
|
Result := {(DataSet <> nil) and }(Trim(AnalyticalValue) <> '');
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsHasMapRect(out MapRect: TfrxRect): boolean;
|
|
begin
|
|
Result := (FShapes <> nil) and FShapes.IsValidMapRect(MapRect);
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsHasZoomRect(out ZoomRect: TfrxRect): boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsHiddenShape(iRecord: Integer): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsHighlightSelectedShape: boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsInclude(P: TfrxPoint): Boolean;
|
|
var
|
|
iRecord: Integer;
|
|
MD: TMinDistance;
|
|
CanvasDist: Extended;
|
|
NearToPointOrLine: Boolean;
|
|
begin
|
|
Result := False;
|
|
if FShapes = nil then
|
|
Exit;
|
|
FPreviousSelectedShapeIndex := SelectedShapeIndex;
|
|
ClearSelectedShape;
|
|
MD := TMinDistance.Create(MinSelectDistance);
|
|
for iRecord := FShapes.Count - 1 downto 0 do // In reverse order of drawing
|
|
begin
|
|
InitTransform(iRecord);
|
|
CanvasDist := FShapes.CanvasDistance(iRecord, P);
|
|
NearToPointOrLine := (CanvasDist < MinSelectDistance) and
|
|
(FShapes[iRecord].ShapeType in [stPoint, stPolyLine, stMultiPoint, stMultiPolyLine]);
|
|
if NearToPointOrLine or FShapes.IsInside(iRecord, P) then
|
|
MD.Add(0.0, iRecord)
|
|
else
|
|
MD.Add(CanvasDist, iRecord);
|
|
if MD.IsZero then
|
|
Break;
|
|
end;
|
|
Result := MD.IsNear;
|
|
if Result then
|
|
SelectedShapeIndex := MD.Index
|
|
else
|
|
Result := IsIncludeAsRegion(P);
|
|
MD.Free;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsIncludeAsRegion(P: TfrxPoint): Boolean;
|
|
|
|
function IsPointInRecordRegion(iRecord: Integer): boolean;
|
|
var
|
|
iPart: Integer;
|
|
PolyPoints: TPointArray;
|
|
RGN: hRGN;
|
|
begin
|
|
Result := False;
|
|
for iPart := 0 to FShapes[iRecord].PartCount - 1 do
|
|
if FShapes.IsCanvasPolyPoints(iRecord, iPart, MapAccuracy, PixelAccuracy, PolyPoints) then
|
|
begin
|
|
{$IFNDEF FPC}
|
|
RGN := CreatePolygonRgn(PolyPoints[0], Length(PolyPoints), WINDING);
|
|
{$ELSE}
|
|
RGN := CreatePolygonRgn(@PolyPoints[0], Length(PolyPoints), WINDING);
|
|
{$ENDIF}
|
|
Result := PtInRegion(RGN, Round(P.X), Round(P.Y));
|
|
DeleteObject(RGN);
|
|
if Result then
|
|
Break;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
iRecord: Integer;
|
|
begin
|
|
FPreviousSelectedShapeIndex := SelectedShapeIndex;
|
|
ClearSelectedShape;
|
|
for iRecord := 0 to FShapes.Count - 1 do
|
|
if (FShapes[iRecord].ShapeType in [stPolygon, stMultiPolygon]) or
|
|
(FShapes[iRecord].ShapeType in [stPolyLine, stMultiPolyLine]) and
|
|
FShapes[iRecord].ShapeData.IsClosed then
|
|
begin
|
|
InitTransform(iRecord);
|
|
if IsPointInRecordRegion(iRecord) then
|
|
begin
|
|
FSelectedShapeIndex := iRecord;
|
|
Break;
|
|
end;
|
|
end;
|
|
Result := FSelectedShapeIndex <> Unknown;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsMercatorSuitable: Boolean;
|
|
begin
|
|
Result := FShapes.IsMercatorSuitable;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsSelectedShapeChanded: Boolean;
|
|
begin
|
|
Result := FPreviousSelectedShapeIndex <> FSelectedShapeIndex;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsSpecialBorderColor(iRecord: Integer; out SpecialColor: TColor): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
function TfrxCustomLayer.IsSpecialFillColor(iRecord: Integer; out SpecialColor: TColor): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.SetParent(AParent: TfrxComponent);
|
|
begin
|
|
if (AParent = nil) or (AParent is TfrxMapView) then
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.SwapShapes(EditedLayer: TfrxCustomLayer);
|
|
var
|
|
TempShapes: TShapeList;
|
|
begin
|
|
TempShapes := FShapes;
|
|
FShapes := EditedLayer.FShapes;
|
|
EditedLayer.FShapes := TempShapes;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.TuneBrush(Brush: TBrush; iRecord: Integer);
|
|
var
|
|
SpecialColor: TColor;
|
|
begin
|
|
Brush.Style := bsSolid;
|
|
if IsHighlightSelectedShape and (FSelectedShapeIndex = iRecord) then
|
|
Brush.Color := HighlightColor
|
|
else if IsSpecialFillColor(iRecord, SpecialColor) then
|
|
Brush.Color := SpecialColor
|
|
else if ColorRanges.RangeCount > 0 then
|
|
Brush.Color := ColorRanges.GetColor(FShapes[iRecord].Value)
|
|
else if MapPalette <> mpNone then
|
|
Brush.Color := FullPalette[MapPalette, iRecord mod PaletteSize]
|
|
else
|
|
Brush.Color := DefaultShapeStyle.FillColor;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.TunePen(Pen: TPen; iRecord: Integer);
|
|
var
|
|
SpecialColor: TColor;
|
|
begin
|
|
if IsHighlightSelectedShape and (FSelectedShapeIndex = iRecord) then
|
|
Pen.Color := HighlightColor
|
|
else if IsSpecialBorderColor(iRecord, SpecialColor) then
|
|
Pen.Color := SpecialColor
|
|
else
|
|
Pen.Color := DefaultShapeStyle.BorderColor;
|
|
end;
|
|
|
|
procedure TfrxCustomLayer.TunePoint(Canvas: TCanvas; iRecord: Integer; out Radius: Extended);
|
|
begin
|
|
TunePen(Canvas.Pen, iRecord);
|
|
TuneBrush(Canvas.Brush, iRecord);
|
|
InitTransform(iRecord);
|
|
Radius := DefaultShapeStyle.PointSize / 2;
|
|
if SizeRanges.RangeCount > 0 then
|
|
Radius := SizeRanges.GetSize(FShapes[iRecord].Value) / 2;
|
|
end;
|
|
|
|
{ TfrxLabelColumnProperty }
|
|
|
|
function TfrxLabelColumnProperty.GetAttributes: TfrxPropertyAttributes;
|
|
begin
|
|
Result := [paMultiSelect, paValueList];
|
|
end;
|
|
|
|
function TfrxLabelColumnProperty.GetValue: String;
|
|
begin
|
|
Result := GetStrValue;
|
|
end;
|
|
|
|
procedure TfrxLabelColumnProperty.GetValues;
|
|
begin
|
|
inherited;
|
|
(Component as TfrxCustomLayer).GetColumnList(Values);
|
|
end;
|
|
|
|
procedure TfrxLabelColumnProperty.SetValue(const Value: String);
|
|
begin
|
|
SetStrValue(Value);
|
|
end;
|
|
|
|
{ TOperationCalculator }
|
|
|
|
procedure TOperationCalculator.Add(AValue: Extended);
|
|
begin
|
|
FCount := FCount + 1;
|
|
case FOperation of
|
|
opAverage, opSum:
|
|
FValue := FValue + AValue;
|
|
opMin:
|
|
FValue := Min(FValue, AValue);
|
|
opMax:
|
|
FValue := Max(FValue, AValue);
|
|
end;
|
|
end;
|
|
|
|
constructor TOperationCalculator.Create(AOperation: TMapOperation);
|
|
begin
|
|
FOperation := AOperation;
|
|
FCount := 0;
|
|
case FOperation of
|
|
opAverage, opSum:
|
|
FValue := 0;
|
|
opMin:
|
|
FValue := 1e+38;
|
|
opMax:
|
|
FValue := -1e+38;
|
|
end;
|
|
end;
|
|
|
|
function TOperationCalculator.Get: Extended;
|
|
begin
|
|
case FOperation of
|
|
opAverage:
|
|
Result := IfReal(FCount > 0, FValue / FCount);
|
|
opMin, opMax, opSum:
|
|
Result := IfReal(FCount > 0, FValue);
|
|
else // opCount:
|
|
Result := FCount;
|
|
end;
|
|
end;
|
|
|
|
{ TValuesList }
|
|
|
|
procedure TValuesList.AddValue(SpatialValue: String; AnalyticalValue: Extended);
|
|
var
|
|
Index: Integer;
|
|
begin
|
|
if not Find(SpatialValue, Index) then
|
|
Index := AddObject(SpatialValue, TOperationCalculator.Create(FOperation));
|
|
|
|
OperationCalculator[Index].Add(AnalyticalValue);
|
|
end;
|
|
|
|
constructor TValuesList.Create(AOperation: TMapOperation);
|
|
begin
|
|
inherited Create;
|
|
|
|
FOperation := AOperation;
|
|
|
|
Duplicates := dupError;
|
|
Sorted := True;
|
|
end;
|
|
|
|
destructor TValuesList.Destroy;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
OnChange := nil;
|
|
OnChanging := nil;
|
|
for i := 0 to Count - 1 do
|
|
Objects[i].Free;
|
|
|
|
inherited;
|
|
end;
|
|
|
|
function TValuesList.GetOperationCalculator(Index: integer): TOperationCalculator;
|
|
begin
|
|
Result := TOperationCalculator(Objects[Index]);
|
|
end;
|
|
|
|
function TValuesList.MaxValue: Extended;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := IfReal(Count > 0, OperationCalculator[0].Get);
|
|
for i := 1 to Count - 1 do
|
|
Result := Max(Result, OperationCalculator[i].Get);
|
|
end;
|
|
|
|
function TValuesList.MinValue: Extended;
|
|
var
|
|
i: integer;
|
|
begin
|
|
Result := IfReal(Count > 0, OperationCalculator[0].Get);
|
|
for i := 1 to Count - 1 do
|
|
Result := Min(Result, OperationCalculator[i].Get);
|
|
end;
|
|
|
|
{ TfrxApplicationLayer }
|
|
|
|
procedure TfrxApplicationLayer.AddValueList(vaAnalyticalValue: Variant);
|
|
var
|
|
vaLatitudeValue, vaLongitudeValue, vaLabelValue: Variant;
|
|
stSpatialValue: String;
|
|
Index: Integer;
|
|
begin
|
|
vaLabelValue := Report.Calc(LabelValue);
|
|
vaLatitudeValue := Report.Calc(LatitudeValue);
|
|
vaLongitudeValue := Report.Calc(LongitudeValue);
|
|
if not (VarIsNull(vaLatitudeValue) or VarIsNull(vaLongitudeValue) or VarIsNull(vaLabelValue)) then
|
|
begin
|
|
stSpatialValue := VarToStr(vaLatitudeValue) + ':' + VarToStr(vaLongitudeValue);
|
|
if not FValuesList.Find(stSpatialValue, Index) then
|
|
FShapes.AddShapeData(ApplicationShapeData(vaLongitudeValue, vaLatitudeValue, vaLabelValue, stSpatialValue));
|
|
FValuesList.AddValue(stSpatialValue, vaAnalyticalValue);
|
|
end;
|
|
end;
|
|
|
|
function TfrxApplicationLayer.ApplicationShapeData(X, Y: Extended; Name, Location: String): TShapeData;
|
|
var
|
|
Tags: TStringList;
|
|
begin
|
|
Tags := TStringList.Create;
|
|
Tags.Add(AppLabelColumn + Tags.NameValueSeparator + Name);
|
|
Tags.Add(AppSpatialColumn + Tags.NameValueSeparator + Location);
|
|
Result := TShapeData.CreatePoint(Tags, X, Y);
|
|
Tags.Free;
|
|
Result.CalcBounds;
|
|
end;
|
|
|
|
constructor TfrxApplicationLayer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FLatitudeValue := '';
|
|
FLongitudeValue := '';
|
|
FLabelValue := '';
|
|
|
|
FLabelColumn := AppLabelColumn;
|
|
FSpatialColumn := AppSpatialColumn;
|
|
|
|
FShapes := TShapeList.Create(FConverter);
|
|
FShapes.EmbeddedData := True;
|
|
end;
|
|
|
|
procedure TfrxApplicationLayer.ExpandVariables;
|
|
begin
|
|
inherited;
|
|
|
|
with TfrxMapView(FMapView) do
|
|
begin
|
|
ExpandVar(FLabelValue);
|
|
ExpandVar(FLatitudeValue);
|
|
ExpandVar(FLongitudeValue);
|
|
end;
|
|
end;
|
|
|
|
procedure TfrxApplicationLayer.InitialiseData;
|
|
begin
|
|
inherited InitialiseData;
|
|
FShapes.Clear;
|
|
end;
|
|
|
|
function TfrxApplicationLayer.IsCanGetData: Boolean;
|
|
begin
|
|
Result := inherited IsCanGetData
|
|
and (Trim(LabelValue) <> '')
|
|
and (Trim(LatitudeValue) <> '')
|
|
and (Trim(LongitudeValue) <> '');
|
|
end;
|
|
|
|
function TfrxApplicationLayer.IsInclude(P: TfrxPoint): Boolean;
|
|
begin
|
|
Result := False;
|
|
end;
|
|
|
|
{ TfrxMapFileLayer }
|
|
|
|
procedure TfrxMapFileLayer.AddValueList(vaAnalyticalValue: Variant);
|
|
var
|
|
vaSpatialValue: Variant;
|
|
begin
|
|
vaSpatialValue := Report.Calc(SpatialValue);
|
|
if not VarIsNull(vaSpatialValue) then
|
|
FValuesList.AddValue(VarToStr(vaSpatialValue), vaAnalyticalValue);
|
|
end;
|
|
|
|
constructor TfrxMapFileLayer.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FLabelColumn := '';
|
|
FSpatialColumn := '';
|
|
FSpatialValue := '';
|
|
FMapFileName := '';
|
|
FMapAccuracy := 0.0;
|
|
FPixelAccuracy := 0.0;
|
|
|
|
FShapes := TShapeList.Create(FConverter);
|
|
FShapes.AdjustableShape := True;
|
|
FLayerTags := TStringList.Create;
|
|
FLayerTags.Sorted := True;
|
|
|
|
FFirstReading := False;
|
|
end;
|
|
|
|
destructor TfrxMapFileLayer.Destroy;
|
|
begin
|
|
FLayerTags.Free;
|
|
FreeAndNil(FDataLink);
|
|
inherited;
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.Embed;
|
|
begin
|
|
FMapFileName := '';
|
|
FShapes.EmbeddedData := True;
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.ExpandVariables;
|
|
begin
|
|
inherited;
|
|
|
|
with TfrxMapView(FMapView) do
|
|
begin
|
|
ExpandVar(FZoomPolygon);
|
|
end;
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetDataLink: TfrxDataLink;
|
|
begin
|
|
if not Assigned(FDataLink) then
|
|
FDataLink := TfrxDataLink.Create;
|
|
Result := FDataLink;
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetFileExtension: string;
|
|
begin
|
|
Result := AnsiLowerCase(Copy(FMapFileName, Length(FMapFileName) - 3, 4));
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetFileTags: TfrxSumStringList;
|
|
var
|
|
OSMFile: TOSMFile;
|
|
begin
|
|
OSMFile := TfrxMapView(FMapView).OSMFileList.FileByName(MapFileName);
|
|
if OSMFile <> nil then
|
|
Result := OSMFile.SumTags
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetLink(LoadMethod: TfrxDataLinkLoadMethod): String;
|
|
begin
|
|
Result := TfrxDataLink.GetLink(FDataLink, LoadMethod);
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetSelectedShapeName: String;
|
|
begin
|
|
if (SelectedShapeIndex = Unknown) or (FShapes = nil) or (LabelColumn = '') then
|
|
Result := inherited GetSelectedShapeName
|
|
else
|
|
Result := GetShapeName(LabelColumn, SelectedShapeIndex);
|
|
end;
|
|
|
|
function TfrxMapFileLayer.GetSelectedShapeValue: String;
|
|
begin
|
|
if (SelectedShapeIndex = Unknown) or (FShapes = nil) then
|
|
Result := inherited GetSelectedShapeValue
|
|
else
|
|
Result := GetShapeValue(SelectedShapeIndex);
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.InitialiseData;
|
|
begin
|
|
inherited InitialiseData;
|
|
FShapes.ClearValues;
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.InitTransform(iRecord: Integer);
|
|
begin
|
|
with FShapes[iRecord] do
|
|
FConverter.InitShape(OffsetX, OffsetY, Zoom, FShapes[iRecord].ShapeCenter);
|
|
end;
|
|
|
|
function TfrxMapFileLayer.IsCanGetData: Boolean;
|
|
begin
|
|
Result := inherited IsCanGetData
|
|
and (Trim(SpatialValue) <> '');
|
|
end;
|
|
|
|
function TfrxMapFileLayer.IsDataLinkStored: Boolean;
|
|
begin
|
|
Result := TfrxDataLink.IsDataLinkStored(FDataLink, frComponentState);
|
|
end;
|
|
|
|
function TfrxMapFileLayer.IsExpressionLink: Boolean;
|
|
begin
|
|
Result := TfrxDataLink.IsExpressionLink(FDataLink);
|
|
end;
|
|
|
|
function TfrxMapFileLayer.IsHasZoomRect(out ZoomRect: TfrxRect): boolean;
|
|
var
|
|
iRecord: Integer;
|
|
begin
|
|
Result := (FShapes <> nil) and (LabelColumn <> '') and (ZoomPolygon <> '')
|
|
and FShapes.IsHasLegend(SpatialColumn, ZoomPolygon, iRecord)
|
|
and (FShapes[iRecord].ShapeType in [stPolyLine, stPolygon, stMultiPoint, stMultiPolyLine, stMultiPolygon]);
|
|
if Result then
|
|
begin
|
|
InitTransform(iRecord);
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FConverter.UseOffset := False;
|
|
{$ENDIF}
|
|
ZoomRect := FShapes.CanvasWidestPartBounds(iRecord);
|
|
{$IFDEF FRX_USE_BITMAP_MAP}
|
|
FConverter.UseOffset := True;
|
|
{$ENDIF}
|
|
end;
|
|
end;
|
|
|
|
function TfrxMapFileLayer.IsHighlightSelectedShape: boolean;
|
|
begin
|
|
Result := IsDesigning
|
|
or FActiveHyperlink;
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.JustAdded;
|
|
begin
|
|
FFirstReading := True;
|
|
end;
|
|
|
|
function TfrxMapFileLayer.LoadDataStream(Stream: TStream;
|
|
const NewLink: String): Boolean;
|
|
var
|
|
sLink: String;
|
|
begin
|
|
Result := True;
|
|
sLink := '';
|
|
try
|
|
if NewLink <> '' then
|
|
sLink := NewLink
|
|
else if Assigned(FDataLink) then
|
|
sLink := FDataLink.Link;
|
|
FShapes.Free;
|
|
TfrxMapView(FMapView).OSMFileList.AddLink(sLink, Stream);
|
|
if FFirstReading then
|
|
EditLayerTags(FileTags, LayerTags);
|
|
FShapes := TOSMShapeList.CreateFromFile(sLink, FConverter,
|
|
TfrxMapView(FMapView).OSMFileList, LayerTags);
|
|
if Assigned(FDataLink) and (dltOnGetData in FDataLink.LoadingType) then
|
|
FShapes.EmbeddedData := True;
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TfrxMapFileLayer.ReRead;
|
|
var
|
|
FileExtension: String;
|
|
begin
|
|
if (FMapFileName <> '') and FileExists(PlatformFileName(FMapFileName)) then
|
|
begin
|
|
FShapes.Free;
|
|
FileExtension := GetFileExtension;
|
|
if FileExtension = '.osm' then
|
|
begin
|
|
TfrxMapView(FMapView).OSMFileList.AddFile(FMapFileName);
|
|
if FFirstReading then
|
|
EditLayerTags(FileTags, LayerTags);
|
|
FShapes := TOSMShapeList.CreateFromFile(FMapFileName, FConverter,
|
|
TfrxMapView(FMapView).OSMFileList, LayerTags)
|
|
end
|
|
else if FileExtension = '.gpx' then
|
|
FShapes := TGPXShapeList.CreateFromFile(FMapFileName, FConverter)
|
|
else if FileExtension = '.shp' then
|
|
try
|
|
FShapes := TERSIShapeList.CreateFromFile(FMapFileName, FConverter)
|
|
except
|
|
FreeAndNil(FShapes);
|
|
end
|
|
else
|
|
raise Exception.Create('Unknown File Format');
|
|
FShapes.EmbeddedData := False;
|
|
end
|
|
else
|
|
FShapes.Clear;
|
|
FFirstReading := False;
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.SetDataLink(const Value: TfrxDataLink);
|
|
begin
|
|
if not Assigned(FDataLink) then
|
|
GetDataLink;
|
|
FDataLink.Assign(Value);
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.SetLayerTags(const Value: TStringList);
|
|
begin
|
|
FLayerTags.Assign(Value);
|
|
end;
|
|
|
|
procedure TfrxMapFileLayer.SetMapFileName(AMapFileName: String);
|
|
begin
|
|
{$IFDEF LINUX}
|
|
AMapFileName := StringReplace(AMapFileName, '\', '/', [rfReplaceAll]);
|
|
FMapFileName := StringReplace(FMapFileName, '\', '/', [rfReplaceAll]);
|
|
{$ENDIF}
|
|
if SafeFileName(FMapFileName) <> SafeFileName(AMapFileName) then
|
|
begin
|
|
FFirstReading := FFirstReading or (FMapFileName <> '');
|
|
FMapFileName := Trim(AMapFileName);
|
|
ReRead;
|
|
end
|
|
else if FMapFileName <> AMapFileName then
|
|
FMapFileName := Trim(AMapFileName);
|
|
{$IFDEF LINUX}
|
|
FMapFileName := StringReplace(FMapFileName, '/', '\', [rfReplaceAll]);
|
|
{$ENDIF}
|
|
end;
|
|
|
|
{ TMapLayerList }
|
|
|
|
constructor TMapLayerList.Create(AObjects: TList);
|
|
begin
|
|
FObjects := AObjects;
|
|
|
|
FSelectedLayerIndex := Unknown;
|
|
FPreviousSelectedLayerIndex := Unknown;
|
|
end;
|
|
|
|
procedure TMapLayerList.Exchange(Index1, Index2: Integer);
|
|
begin
|
|
FObjects.Exchange(Index1, Index2);
|
|
end;
|
|
|
|
function TMapLayerList.GetCount: Integer;
|
|
begin
|
|
Result := FObjects.Count;
|
|
end;
|
|
|
|
procedure TMapLayerList.GetData;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i := 0 to Count - 1 do
|
|
Items[i].GetData;
|
|
|
|
end;
|
|
|
|
function TMapLayerList.GetLayer(Index: Integer): TfrxCustomLayer;
|
|
begin
|
|
Result := TfrxCustomLayer(FObjects[Index]);
|
|
end;
|
|
|
|
function TMapLayerList.GetSelectedLayer: TfrxCustomLayer;
|
|
begin
|
|
if FSelectedLayerIndex = Unknown then
|
|
Result := nil
|
|
else
|
|
Result := Items[FSelectedLayerIndex];
|
|
end;
|
|
|
|
function TMapLayerList.IndexOf(Item: Pointer): Integer;
|
|
begin
|
|
Result := FObjects.IndexOf(Item);
|
|
end;
|
|
|
|
function TMapLayerList.IsInclude(P: TfrxPoint): Boolean;
|
|
var
|
|
i, j: Integer;
|
|
begin
|
|
FPreviousSelectedLayerIndex := FSelectedLayerIndex;
|
|
FSelectedLayerIndex := Unknown;
|
|
for i := Count - 1 downto 0 do
|
|
if Items[i].IsInclude(P) then
|
|
begin
|
|
FSelectedLayerIndex := i;
|
|
for j := i - 1 downto 0 do
|
|
Items[j].ClearSelectedShape;
|
|
Break;
|
|
end
|
|
else
|
|
Items[i].ClearSelectedShape;
|
|
Result := FSelectedLayerIndex <> Unknown;
|
|
end;
|
|
|
|
function TMapLayerList.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 TMapLayerList.IsSelectedShapeChanded: Boolean;
|
|
begin
|
|
Result := (FPreviousSelectedLayerIndex <> FSelectedLayerIndex) or
|
|
(FSelectedLayerIndex <> Unknown) and SelectedLayer.IsSelectedShapeChanded;
|
|
end;
|
|
|
|
initialization
|
|
|
|
frxPropertyEditors.Register(TypeInfo(String), TfrxComponent, 'LabelColumn', TfrxLabelColumnProperty);
|
|
frxPropertyEditors.Register(TypeInfo(String), TfrxComponent, 'SpatialColumn', TfrxLabelColumnProperty);
|
|
|
|
RegisterClasses([TfrxMapFileLayer, TfrxApplicationLayer]);
|
|
|
|
end.
|