FastReport_2022_VCL/Source/frxMap.pas

741 lines
22 KiB
ObjectPascal
Raw Normal View History

2024-01-01 16:13:08 +01:00
{******************************************}
{ }
{ FastReport VCL }
{ Map Object }
{ }
{ Copyright (c) 1998-2021 }
{ by Fast Reports Inc. }
{ }
{******************************************}
unit frxMap;
interface
{$I frx.inc}
uses
Types,
{$IFNDEF FPC}
Windows,
{$ELSE}
LCLType, LCLIntf, LCLProc,
{$ENDIF}
Graphics, Classes, Controls, frxClass, frxMapLayer,
frxMapHelpers, frxMapRanges, frxMapShape, frxMapLayerForm;
type
{$IFDEF DELPHI16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
TfrxMapObject = class(TComponent) // fake component
end;
{$IFDEF DELPHI16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
TfrxMapView = class(TfrxView)
private
FZoom: Extended;
FMinZoom: Extended;
FMaxZoom: Extended;
FMapOffsetX: Extended;
FMapOffsetY: Extended;
FKeepAspectRatio: Boolean;
FMercatorProjection: boolean;
{$IFDEF FRX_USE_BITMAP_MAP}
FBitmapCache: TBitmap;
FRepaintCache: Boolean;
{$ENDIF}
procedure SetZoom(const Value: Extended);
procedure SetMaxZoom(const Value: Extended);
procedure SetMinZoom(const Value: Extended);
procedure SetMercatorProjection(const Value: Boolean);
function GetSelectedShapeName: String;
protected
FLayers: TMapLayerList;
FHasPreviousOffset: Boolean;
FPreviousOffset: TfrxPoint;
FShowMoveArrow: Boolean;
FConverter: TMapToCanvasCoordinateConverter;
FFirstDraw: Boolean;
FPreviousHyperlinkKind: TfrxHyperlinkKind;
FNeedBuildVector: Boolean;
FColorScale: TMapScale;
FSizeScale: TMapScale;
FOSMFileList: TOSMFileList;
FClipMap: Boolean;
oldLeft, oldTop, oldWidth, oldHeight, oldOffsetX, oldOffsetY, oldZoom: Extended;
FModified: Boolean;
FAddingLayer: Boolean;
{$IFDEF FRX_USE_BITMAP_MAP}
FMapViewport: TfrxRect;
{$ENDIF}
procedure DrawMap(Canvas: TCanvas; ScaleX, ScaleY: Extended);
function IsMoveArrowArea(X, Y: Extended): Boolean;
function CanvasSize: TfrxPoint;
procedure DefineProperties(Filer: TFiler); override;
procedure InitConverter;
function IsAlignByZoomPolygon: Boolean;
procedure ZoomRecenter(CenterX, CenterY, Factor: Extended);
procedure EnableSupportedHyperlink;
procedure DisableSupportedHyperlink;
function ShowMoveArrow: Boolean;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
procedure DrawClipped(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended); override;
function GetContainerObjects: TList; override;
function IsContain(X, Y: Extended): Boolean; override;
procedure GetData; override;
procedure ExpandVar(var Expr: String);
procedure AddLayer(LayerType: TLayerType; IsEmbed: Boolean; AMapFileName: string; DefaultReport: TfrxReport = nil);
procedure GeometrySave;
procedure GeometryChange(ALeft, ATop, AWidth, AHeight: Extended);
procedure GeometryRestore;
procedure ZoomByRect(ZoomRect: TfrxRect);
procedure ZoomByFactor(Factor: Extended);
procedure SwapConverter(EditedMap: TfrxMapView);
function DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var EventParams: TfrxInteractiveEventsParams): Boolean; override;
function DoMouseDown(X, Y: Integer; Button: TMouseButton; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams): Boolean; override;
procedure DoMouseMove(X, Y: Integer; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams); override;
procedure DoMouseUp(X, Y: Integer; Button: TMouseButton; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams); override;
procedure DoMouseEnter(aPreviousObject: TfrxComponent; var EventParams: TfrxInteractiveEventsParams); override;
procedure DoMouseLeave(aNextObject: TfrxComponent; var EventParams: TfrxInteractiveEventsParams); override;
property Converter: TMapToCanvasCoordinateConverter read FConverter;
property SelectedShapeName: String read GetSelectedShapeName;
property Layers: TMapLayerList read FLayers;
property OSMFileList: TOSMFileList read FOSMFileList;
property ClipMap: Boolean read FClipMap write FClipMap;
property NeedBuildVector: Boolean read FNeedBuildVector write FNeedBuildVector;
{$IFDEF FRX_USE_BITMAP_MAP}
property MapViewport: TfrxRect read FMapViewport;
{$ENDIF}
published
property Font;
property FillType;
property Fill;
property Frame;
property Cursor;
property Editable default [ferAllowInPreview];
property Zoom: Extended read FZoom write SetZoom;
property MaxZoom: Extended read FMaxZoom write SetMaxZoom;
property MinZoom: Extended read FMinZoom write SetMinZoom;
property OffsetX: Extended read FMapOffsetX write FMapOffsetX;
property OffsetY: Extended read FMapOffsetY write FMapOffsetY;
property KeepAspectRatio: Boolean read FKeepAspectRatio write FKeepAspectRatio;
property MercatorProjection: Boolean read FMercatorProjection write SetMercatorProjection;
property ColorScale: TMapScale read FColorScale;
property SizeScale: TMapScale read FSizeScale;
end;
implementation
uses
Math, frxRes, frxUtils, frxDesgn, Forms,
frxDsgnIntf, Dialogs, Contnrs, frxMapRTTI, frxMapEditor,
frxMapInteractiveLayer, frxMapGeodataLayer, frxMapInPlaceEditor;
const
ZoomFactor = 1.1;
SupportedHyperlinkKind = [hkDetailReport, hkDetailPage];
{ TfrxMapView }
procedure TfrxMapView.AddLayer(LayerType: TLayerType; IsEmbed: Boolean; AMapFileName: string; DefaultReport: TfrxReport);
var
MapFileLayer: TfrxMapFileLayer;
begin
try
FAddingLayer := True;
case LayerType of
ltApplication:
with TfrxApplicationLayer.Create(Self) do
CreateUniqueName(DefaultReport);
ltInteractive:
with TfrxMapInteractiveLayer.Create(Self) do
CreateUniqueName(DefaultReport);
ltMapFile:
begin
with TfrxMapFileLayer.Create(Self) do
CreateUniqueName(DefaultReport);
if AMapFileName <> '' then
begin
MapFileLayer := TfrxMapFileLayer(FLayers[FLayers.Count - 1]);
MapFileLayer.JustAdded;
MapFileLayer.MapFileName := AMapFileName;
if IsEmbed then
MapFileLayer.Embed;
end;
end;
ltGeodata:
with TfrxMapGeodataLayer.Create(Self) do
CreateUniqueName(DefaultReport);
end;
finally
FAddingLayer := False;
end;
end;
function TfrxMapView.CanvasSize: TfrxPoint;
var
CanvasWidth, CanvasHeight: Extended;
begin
CanvasWidth := Width * Zoom * FScaleX;
CanvasHeight := Height * Zoom * FScaleY;
if KeepAspectRatio and FConverter.IsHasData then
if FConverter.AspectRatio > CanvasWidth / CanvasHeight then
CanvasHeight := CanvasWidth / FConverter.AspectRatio
else
CanvasWidth := CanvasHeight * FConverter.AspectRatio;
Result := frxPoint(CanvasWidth, CanvasHeight);
end;
constructor TfrxMapView.Create(AOwner: TComponent);
begin
inherited;
FZoom := 1;
FMinZoom := 1;
FMaxZoom := 50;
FMapOffsetX := 0.0;
FMapOffsetY := 0.0;
FKeepAspectRatio := True;
frComponentStyle := frComponentStyle + [csObjectsContainer];
FLayers := TMapLayerList.Create(Objects);
FConverter := TMapToCanvasCoordinateConverter.Create;
MercatorProjection := True;
FHasPreviousOffset := False;
FShowMoveArrow := False;
FFirstDraw := True;
FPreviousHyperlinkKind := hkCustom;
FNeedBuildVector := True;
FClipMap := False;
FAddingLayer := False;
FColorScale := TMapScale.Create;
FSizeScale := TMapScale.Create;
FOSMFileList := TOSMFileList.Create;
{$IFDEF FRX_USE_BITMAP_MAP}
FBitmapCache := TBitmap.Create;
FRepaintCache := True;
{$ENDIF}
Editable := [ferAllowInPreview];
end;
procedure TfrxMapView.DefineProperties(Filer: TFiler);
begin
inherited;
if [csDesigning, csLoading] * ComponentState <> [] then // dfm
Filer.DefineBinaryProperty('Converter', FConverter.ReadDFM, FConverter.WriteDFM, True)
else // fr3
Filer.DefineProperty('Converter', FConverter.Read, FConverter.Write, True);
end;
destructor TfrxMapView.Destroy;
begin
FLayers.Free;
FConverter.Free;
FColorScale.Free;
FSizeScale.Free;
FOSMFileList.Free;
{$IFDEF FRX_USE_BITMAP_MAP}
FBitmapCache.Free;
{$ENDIF}
inherited;
end;
procedure TfrxMapView.DisableSupportedHyperlink;
begin
if Hyperlink.Kind in SupportedHyperlinkKind then
begin
FPreviousHyperlinkKind := Hyperlink.Kind;
Hyperlink.Kind := hkCustom;
Screen.Cursor := crArrow;
end;
end;
function TfrxMapView.DoMouseDown(X, Y: Integer; Button: TMouseButton; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams): Boolean;
begin
Result := False;
FModified := False;
FNeedBuildVector:= False;
if (Button = mbLeft) and not IsMoveArrowArea(X / FScaleX, Y / FScaleY) then
begin
{$IFDEF FRX_USE_BITMAP_MAP}
FPreviousOffset := frxPoint(X - AbsLeft * FScaleX,
Y - AbsTop * FScaleY);
{$ELSE}
FPreviousOffset := frxPoint(X - OffsetX * FScaleX - AbsLeft * FScaleX,
Y - OffsetY * FScaleY - AbsTop * FScaleY);
{$ENDIF}
FHasPreviousOffset := True;
Result := True;
if EventParams.EventSender = esDesigner then
if FLayers.IsInclude(FPreviousOffset) and IsSelected then
begin
EventParams.SelectionList.ClearInspectorList;
EventParams.SelectionList.Add(FLayers.SelectedLayer.SelectedShape);
end
else
begin
EventParams.SelectionList.Clear;
EventParams.SelectionList.Add(Self);
end;
FPreviousOffset := frxPoint(X, Y);
end;
end;
procedure TfrxMapView.DoMouseEnter(aPreviousObject: TfrxComponent; var EventParams: TfrxInteractiveEventsParams);
begin
inherited;
FModified := False;
FShowMoveArrow := EventParams.EventSender = esDesigner;
end;
procedure TfrxMapView.DoMouseLeave(aNextObject: TfrxComponent; var EventParams: TfrxInteractiveEventsParams);
begin
if FHasPreviousOffset and IsDesigning then
Exit;
inherited;
FShowMoveArrow := False;
Screen.Cursor := crDefault;
EnableSupportedHyperlink;
EventParams.Modified := FModified;
FModified := False;
if not IsDesigning then
FHasPreviousOffset := False;
end;
procedure TfrxMapView.DoMouseMove(X, Y: Integer; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams);
var
Inner: TfrxPoint;
begin
Inner := frxPoint(X - AbsLeft * FScaleX, Y - AbsTop * FScaleY);
if FHasPreviousOffset then
begin
OffsetX := OffsetX + ((X - FPreviousOffset.X) / FScaleX);
OffsetY := OffsetY + ((Y - FPreviousOffset.Y) / FScaleY);
if (Report <> nil) and (Report.Designer <> nil) then
TfrxCustomDesigner(Report.Designer).UpdateInspector;
EventParams.Refresh := True;
FModified := True;
FNeedBuildVector:= False;
// FPreviousOffset := frxPoint(X - AbsLeft * FScaleX, Y - AbsTop * FScaleY);
FPreviousOffset := frxPoint(X, Y);
end
else if ([ssLeft, ssRight, ssMiddle] * Shift = []) then
case EventParams.EventSender of
esDesigner:
begin
if (Min(FScaleX, FScaleY) > 1e-3) and IsMoveArrowArea(X / FScaleX, Y / FScaleY) then
Screen.Cursor := crSizeAll
else
Screen.Cursor := crDefault;
EventParams.Refresh := False;
end;
esPreview:
begin
{$IFDEF FRX_USE_BITMAP_MAP}
if FLayers.IsInclude(frxPoint(Inner.X, Inner.Y))
{$ELSE}
if FLayers.IsInclude(frxPoint(Inner.X - OffsetX * FScaleX, Inner.Y - OffsetY * FScaleY))
{$ENDIF}
and (FLayers.SelectedLayer.SelectedShapeValue <> '') then
begin
EventParams.Refresh := FLayers.IsSelectedShapeChanded;
EnableSupportedHyperlink;
end
else
begin
EventParams.Refresh := EventParams.Refresh or FLayers.IsSelectedShapeChanded
and (Hyperlink.Kind in SupportedHyperlinkKind);
DisableSupportedHyperlink;
end;
end;
end;
end;
procedure TfrxMapView.DoMouseUp(X, Y: Integer; Button: TMouseButton; Shift: TShiftState; var EventParams: TfrxInteractiveEventsParams);
begin
if Button = mbLeft then
FHasPreviousOffset := False;
EventParams.Modified := FModified;
end;
function TfrxMapView.DoMouseWheel(Shift: TShiftState; WheelDelta: Integer; MousePos: TPoint; var EventParams: TfrxInteractiveEventsParams): Boolean;
begin
EventParams.Refresh := True;
Result := True;
ZoomByFactor(IfReal(WheelDelta > 0, ZoomFactor, 1 / ZoomFactor));
FModified := True;
if (Report <> nil) and (Report.Designer <> nil) then
TfrxCustomDesigner(Report.Designer).UpdateInspector;
end;
procedure TfrxMapView.Draw(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
{$IFDEF FRX_USE_BITMAP_MAP}
var
oldFX, oldFY: Integer;
{$ENDIF}
procedure StartDraw;
begin
BeginDraw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
DrawBackground;
InitConverter;
end;
begin
if FAddingLayer then
Exit;
{$IFDEF FRX_USE_BITMAP_MAP}
oldFX := FX;
oldFY := FY;
{$ENDIF}
StartDraw;
{$IFDEF FRX_USE_BITMAP_MAP}
{ do not refresh bitmap when moving object or scroll }
FRepaintCache := (FX = oldFX) and (FY = oldFY);
{$ENDIF}
if FFirstDraw and IsAlignByZoomPolygon then
StartDraw;
FFirstDraw := False;
DrawMap(Canvas, ScaleX, ScaleY);
if not FObjAsMetafile then
DrawFrame;
if ShowMoveArrow then
frxResources.MainButtonImages.Draw(Canvas, FX, FY - 6, 110);
end;
procedure TfrxMapView.DrawClipped(Canvas: TCanvas; ScaleX, ScaleY, OffsetX, OffsetY: Extended);
begin
CLipMap := True;
try
Draw(Canvas, ScaleX, ScaleY, OffsetX, OffsetY);
finally
CLipMap := False;
end;
end;
{$IFDEF FRX_USE_BITMAP_MAP}
procedure TfrxMapView.DrawMap(Canvas: TCanvas; ScaleX, ScaleY: Extended);
var
i, SavedDC: Integer;
Bmp: TBitmap;
p: TfrxPoint;
procedure DrawScale(MapRanges: TMapRanges);
begin
if MapRanges.Visible and (MapRanges.RangeCount > 0) then
begin
with MapRanges.MapScale.LeftTopPoint(Rect(0, 0, Bmp.Width - MapRanges.Width + 1, Bmp.Height - MapRanges.Height + 1)) do
try
Canvas.Lock;
MapRanges.Draw(Bmp.Canvas, x, y);
finally
Canvas.Unlock;
end;
end;
end;
begin
SavedDC := SaveDC(Canvas.Handle);
Bmp := FBitmapCache;
ClipMap := True;
try
if FRepaintCache or (Abs(Bmp.Width - (FX1 - FX)) > 1) or (Abs(Bmp.Height - (FY1 - FY)) > 1) then
begin
Bmp.Width := FX1 - FX;
Bmp.Height := FY1 - FY;
p := FConverter.CanvasToMap(frxPoint(0, 0));
FMapViewport.Left := p.X;
FMapViewport.Bottom := p.Y;
p := FConverter.CanvasToMap(frxPoint(Bmp.Width, Bmp.Height));
FMapViewport.Right := p.X;
FMapViewport.Top := p.Y;
Bmp.Canvas.Brush.Color := clWhite;
Bmp.Canvas.FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
Fill.Draw(Bmp.Canvas, 0, 0, Bmp.Width, Bmp.Height, 1, 1);
IntersectClipRect(Canvas.Handle, FX, FY, FX1, FY1);
for i := 0 to FLayers.Count - 1 do
if FLayers[i].Active then
begin
FLayers[i].IsDesigning := IsDesigning;
FLayers[i].DrawOn(Bmp.Canvas, Hyperlink.Kind in SupportedHyperlinkKind, frxRect(0, 0, Bmp.Width, Bmp.Height));
end;
if ColorScale.Visible then
for i := 0 to FLayers.Count - 1 do
DrawScale(FLayers[i].ColorRanges);
if SizeScale.Visible then
for i := 0 to FLayers.Count - 1 do
DrawScale(FLayers[i].SizeRanges);
end;
Canvas.Lock;
try
Canvas.Draw(FX, FY, Bmp);
finally
Canvas.Unlock;
end;
finally
RestoreDC(Canvas.Handle, SavedDC);
FNeedBuildVector:= True;
ClipMap := False;
end;
end;
{$ELSE}
procedure TfrxMapView.DrawMap(Canvas: TCanvas; ScaleX, ScaleY: Extended);
procedure DrawScale(MapRanges: TMapRanges);
var
VectorGraphic: TGraphic;
begin
if MapRanges.Visible and (MapRanges.RangeCount > 0) then
begin
VectorGraphic := MapRanges.GetGraphic;
with MapRanges.MapScale.LeftTopPoint(Rect(FX, FY, FX1 - VectorGraphic.Width + 1, FY1 - VectorGraphic.Height + 1)) do
try
Canvas.Lock;
Canvas.Draw(X, Y, VectorGraphic);
finally
Canvas.Unlock;
end;
VectorGraphic.Free;
end;
end;
var
i, SavedDC: Integer;
begin
SavedDC := SaveDC(Canvas.Handle);
try
IntersectClipRect(Canvas.Handle, FX, FY, FX1, FY1);
for i := 0 to FLayers.Count - 1 do
if FLayers[i].Active then
begin
FLayers[i].IsDesigning := IsDesigning;
if FNeedBuildVector or ClipMap then
FLayers[i].BuildGraphic(CanvasSize, Hyperlink.Kind in SupportedHyperlinkKind);
Canvas.Lock;
try
Canvas.Draw(FX + Round(OffsetX * ScaleX), FY + Round(OffsetY * ScaleY), FLayers[i].VectorGraphic);
finally
Canvas.Unlock;
end;
end;
if ColorScale.Visible then
for i := 0 to FLayers.Count - 1 do
DrawScale(FLayers[i].ColorRanges);
if SizeScale.Visible then
for i := 0 to FLayers.Count - 1 do
DrawScale(FLayers[i].SizeRanges);
finally
RestoreDC(Canvas.Handle, SavedDC);
FNeedBuildVector:= True;
end;
end;
{$ENDIF}
procedure TfrxMapView.EnableSupportedHyperlink;
begin
if FPreviousHyperlinkKind in SupportedHyperlinkKind then
Hyperlink.Kind := FPreviousHyperlinkKind;
Screen.Cursor := crDefault;
end;
procedure TfrxMapView.ExpandVar(var Expr: String);
begin
ExpandVariables(Expr);
end;
procedure TfrxMapView.GeometryChange(ALeft, ATop, AWidth, AHeight: Extended);
var
Factor: Extended;
begin
Factor := Max(Width / Max(AWidth, 1), Height / Max(AHeight, 1));
OffsetX := OffsetX / Factor;
OffsetY := OffsetY / Factor;
Left := ALeft;
Top := ATop;
Width := AWidth;
Height := AHeight;
end;
procedure TfrxMapView.GeometryRestore;
begin
Left := oldLeft;
Top := oldTop;
Width := oldWidth;
Height := oldHeight;
OffsetX := oldOffsetX;
OffsetY := oldOffsetY;
Zoom := oldZoom;
end;
procedure TfrxMapView.GeometrySave;
begin
oldLeft := Left;
oldTop := Top;
oldWidth := Width;
oldHeight := Height;
oldOffsetX := OffsetX;
oldOffsetY := OffsetY;
oldZoom := Zoom;
end;
function TfrxMapView.GetContainerObjects: TList;
begin
Result := Objects;
end;
procedure TfrxMapView.GetData;
begin
inherited;
FLayers.GetData;
end;
function TfrxMapView.GetSelectedShapeName: String;
begin
if Assigned(FLayers.SelectedLayer) then
Result := FLayers.SelectedLayer.SelectedShapeName
else
Result := '';
end;
procedure TfrxMapView.InitConverter;
var
i: integer;
MapRect: TfrxRect;
begin
FConverter.Init;
for i := 0 to FLayers.Count - 1 do
if FLayers[i].IsHasMapRect(MapRect) then
FConverter.IncludeRect(MapRect);
FConverter.SetCanvasSize(CanvasSize);
{$IFDEF FRX_USE_BITMAP_MAP}
FConverter.SetOffset(OffsetX * FScaleX, OffsetY * FScaleY);
FConverter.UseOffset := True;
{$ELSE}
FConverter.SetOffset(OffsetX, OffsetY);
FConverter.UseOffset := False;
{$ENDIF}
FConverter.MercatorProjection := MercatorProjection and FLayers.IsMercatorSuitable;
end;
function TfrxMapView.IsAlignByZoomPolygon: Boolean;
var
i: integer;
ZoomRect: TfrxRect;
begin
Result := False;
for i := 0 to FLayers.Count - 1 do
if FLayers[i].IsHasZoomRect(ZoomRect) then
begin
Result := True;
ZoomByRect(ZoomRect);
Break;
end;
end;
function TfrxMapView.IsContain(X, Y: Extended): Boolean;
begin
Result := IsMoveArrowArea(X, Y) or inherited IsContain(X, Y);
end;
function TfrxMapView.IsMoveArrowArea(X, Y: Extended): Boolean;
begin
Result := ShowMoveArrow and (AbsLeft <= X) and (AbsLeft + 16 >= X) and
(AbsTop - 6 <= Y) and (AbsTop + 16 >= Y);
end;
procedure TfrxMapView.SetMaxZoom(const Value: Extended);
begin
FMaxZoom := Max(1.0, Value);
end;
procedure TfrxMapView.SetMercatorProjection(const Value: Boolean);
begin
FMercatorProjection := Value;
FConverter.MercatorProjection := Value and FLayers.IsMercatorSuitable;
end;
procedure TfrxMapView.SetMinZoom(const Value: Extended);
begin
FMinZoom := Min(1.0, Value);
end;
procedure TfrxMapView.SetZoom(const Value: Extended);
begin
FZoom := Max(MinZoom, Min(MaxZoom, Value));
end;
function TfrxMapView.ShowMoveArrow: Boolean;
begin
Result := FShowMoveArrow or IsSelected;
end;
procedure TfrxMapView.SwapConverter(EditedMap: TfrxMapView);
var
TempConverter: TMapToCanvasCoordinateConverter;
begin
TempConverter := FConverter;
FConverter := EditedMap.FConverter;
EditedMap.FConverter := TempConverter;
end;
procedure TfrxMapView.ZoomByFactor(Factor: Extended);
begin
ZoomRecenter(- OffsetX + Width / 2, - OffsetY + Height / 2, Factor);
end;
procedure TfrxMapView.ZoomByRect(ZoomRect: TfrxRect);
var
Factor: Extended;
begin
Factor := Min(Width / Max(ZoomRect.Right - ZoomRect.Left, 1),
Height / Max(ZoomRect.Bottom - ZoomRect.Top, 1));
ZoomRecenter((ZoomRect.Left + ZoomRect.Right) / 2,
(ZoomRect.Top + ZoomRect.Bottom) / 2,
Factor);
end;
procedure TfrxMapView.ZoomRecenter(CenterX, CenterY, Factor: Extended);
var
OldZoom: Extended;
begin
OldZoom := Zoom;
Zoom := Zoom * Factor;
Factor := Zoom / OldZoom;
OffsetX := - CenterX * Factor + Width / 2;
OffsetY := - CenterY * Factor + Height / 2;
end;
initialization
frxObjects.RegisterObject1(TfrxMapView, nil, frxResources.Get('obMap'), '', 0, 69);
frxObjects.RegisterObject1(TfrxMapFileLayer, nil, '', '', 0, 74, [ctNone]);
frxObjects.RegisterObject1(TfrxApplicationLayer, nil, '', '', 0, 74, [ctNone]);
finalization
frxObjects.Unregister(TfrxMapView);
end.