LazMapViewer: Scale property added to TMapView. The type is TMapScale. Issue #39081.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9512 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110
parent
e31e0c3983
commit
66ff282a1d
@ -229,6 +229,34 @@ type
|
||||
property Latitude: Double read FLatitude write SetLatitude;
|
||||
end;
|
||||
|
||||
{ TMapScale }
|
||||
|
||||
TMapScale = class(TPersistent)
|
||||
private
|
||||
FView: TMapView;
|
||||
FAlignSet: TAlignSet;
|
||||
FImperial: Boolean;
|
||||
FSpace: Integer;
|
||||
FVisible: Boolean;
|
||||
FWidthMax: Integer;
|
||||
FZoomMin: Integer;
|
||||
procedure SetAlignSet(AValue: TAlignSet);
|
||||
procedure SetImperial(AValue: Boolean);
|
||||
procedure SetSpace(AValue: Integer);
|
||||
procedure SetVisible(AValue: Boolean);
|
||||
procedure SetWidthMax(AValue: Integer);
|
||||
procedure SetZoomMin(AValue: Integer);
|
||||
public
|
||||
constructor Create(AView: TMapView);
|
||||
published
|
||||
property Visible: Boolean read FVisible write SetVisible default False;
|
||||
property ZoomMin: Integer read FZoomMin write SetZoomMin default 8;
|
||||
property WidthMax: Integer read FWidthMax write SetWidthMax default 250;
|
||||
property Space: Integer read FSpace write SetSpace default 10;
|
||||
property Imperial: Boolean read FImperial write SetImperial default False;
|
||||
property AlignSet: TAlignSet read FAlignSet write SetAlignSet default [alRight, alBottom];
|
||||
end;
|
||||
|
||||
{ TMapPoint }
|
||||
|
||||
TMapPoint = class(TMapItem)
|
||||
@ -438,6 +466,7 @@ type
|
||||
FCacheLocation: TCacheLocation;
|
||||
FCachePath, FCacheFullPath: String;
|
||||
FCenter: TMapCenter;
|
||||
FScale: TMapScale;
|
||||
FDownloadEngine: TMvCustomDownloadEngine;
|
||||
FBuiltinDownloadEngine: TMvCustomDownloadEngine;
|
||||
FOnEditDrag: TNotifyEvent;
|
||||
@ -552,6 +581,7 @@ type
|
||||
X, Y: Integer); override;
|
||||
procedure MouseMove(Shift: TShiftState; X,Y: Integer); override;
|
||||
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
|
||||
procedure DrawMapScale; virtual;
|
||||
procedure Paint; override;
|
||||
procedure OnGPSItemsModified(Sender: TObject; objs: TGPSObjList;
|
||||
Adding: boolean);
|
||||
@ -638,6 +668,7 @@ type
|
||||
property InactiveColor: TColor read GetInactiveColor write SetInactiveColor default clWhite;
|
||||
property MapProvider: String read GetMapProvider write SetMapProvider;
|
||||
property MapCenter: TMapCenter read FCenter write FCenter;
|
||||
property Scale: TMapScale read FScale write FScale;
|
||||
property POIImage: TCustomBitmap read FPOIImage write SetPOIImage;
|
||||
property POIImages: TCustomImageList read FPOIImages write SetPOIImages;
|
||||
property POIImagesWidth: Integer read FPOIImagesWidth write SetPOIImagesWidth default 0;
|
||||
@ -899,6 +930,61 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TMapScale }
|
||||
|
||||
procedure TMapScale.SetAlignSet(AValue: TAlignSet);
|
||||
begin
|
||||
if FAlignSet = AValue then Exit;
|
||||
FAlignSet := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMapScale.SetImperial(AValue: Boolean);
|
||||
begin
|
||||
if FImperial = AValue then Exit;
|
||||
FImperial := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMapScale.SetSpace(AValue: Integer);
|
||||
begin
|
||||
if FSpace = AValue then Exit;
|
||||
FSpace := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMapScale.SetVisible(AValue: Boolean);
|
||||
begin
|
||||
if FVisible = AValue then Exit;
|
||||
FVisible := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMapScale.SetWidthMax(AValue: Integer);
|
||||
begin
|
||||
if FWidthMax = AValue then Exit;
|
||||
FWidthMax := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
procedure TMapScale.SetZoomMin(AValue: Integer);
|
||||
begin
|
||||
if FZoomMin = AValue then Exit;
|
||||
FZoomMin := AValue;
|
||||
FView.Invalidate;
|
||||
end;
|
||||
|
||||
constructor TMapScale.Create(AView: TMapView);
|
||||
begin
|
||||
FView := AView;
|
||||
FAlignSet := [alRight, alBottom];
|
||||
FImperial := False;
|
||||
FSpace := 10;
|
||||
FVisible := False;
|
||||
FWidthMax := 250;
|
||||
FZoomMin := 8;
|
||||
end;
|
||||
|
||||
{ TMapAreaPoints }
|
||||
|
||||
function TMapAreaPoints.GetLayer: TMapLayer;
|
||||
@ -2559,6 +2645,122 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMapView.DrawMapScale;
|
||||
var
|
||||
Dist, V: Double;
|
||||
Digits: Integer;
|
||||
R: TRect;
|
||||
OldOpacity: Single;
|
||||
OldPenStyle: TPenStyle;
|
||||
Capt: String;
|
||||
Extent: TSize;
|
||||
W, H, Spc: Integer;
|
||||
MaxW: Integer;
|
||||
Imperial: Boolean;
|
||||
AlignSet: TAlignSet;
|
||||
begin
|
||||
Spc := Scale.Space;
|
||||
AlignSet := Scale.AlignSet;
|
||||
MaxW := Scale.WidthMax;
|
||||
Imperial := Scale.Imperial;
|
||||
|
||||
with Engine.ScreenRectToRealArea(Rect(0, Height div 2, MaxW, Height div 2)) do
|
||||
Dist := mvGeoMath.CalcGeoDistance(TopLeft.Lat, TopLeft.Lon,
|
||||
TopLeft.Lat, BottomRight.Lon, duMeters);
|
||||
|
||||
if Imperial then
|
||||
begin
|
||||
Dist := Dist * 0.62137E-3; // to miles
|
||||
Capt := 'mi';
|
||||
if Dist < 1.0 then
|
||||
begin
|
||||
Dist := Dist * 5280; // 1mi = 5280ft
|
||||
Capt := 'ft';
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
Capt := 'm';
|
||||
if Dist >= 1000 then
|
||||
begin
|
||||
Dist := Dist * 0.001;
|
||||
Capt := 'Km';
|
||||
end;
|
||||
end;
|
||||
|
||||
Digits := Trunc(Math.Log10(Dist));
|
||||
V := Power(10, Digits);
|
||||
|
||||
// 5, 3, 2, 1 multipliers
|
||||
if V * 5 < Dist then
|
||||
V := V * 5
|
||||
else if V * 3 < Dist then
|
||||
V := V * 3
|
||||
else if V * 2 < Dist then
|
||||
V := V * 2;
|
||||
|
||||
// Caption
|
||||
Capt := Round(V).ToString + ' ' + Capt;
|
||||
Extent := DrawingEngine.TextExtent(Capt);
|
||||
|
||||
// Width and height
|
||||
W := Round(MaxW * (V / Dist));
|
||||
H := Extent.Height + 3 + 3;
|
||||
|
||||
R := Rect(0, 0, W, H);
|
||||
|
||||
// Fix align set
|
||||
if AlignSet * [alLeft, alRight] = [] then
|
||||
Include(AlignSet, alRight);
|
||||
if AlignSet * [alTop, alBottom] = [] then
|
||||
Include(AlignSet, alBottom);
|
||||
|
||||
// Horizontal position
|
||||
if alLeft in AlignSet then
|
||||
if alRight in AlignSet then
|
||||
R.Offset((Width - W) div 2, 0) // Both alLeft+alRight=Center
|
||||
else
|
||||
R.Offset(Spc, 0) // to the left
|
||||
else if alRight in AlignSet then
|
||||
R.Offset((Width - W) - Spc, 0); // to the right
|
||||
|
||||
// Vertical position
|
||||
if alTop in AlignSet then
|
||||
if alBottom in AlignSet then
|
||||
R.Offset(0, (Height - H) div 2) // Both alTop+alBottom=Middle
|
||||
else
|
||||
R.Offset(0, Spc) // to the top
|
||||
else if alBottom in AlignSet then
|
||||
R.Offset(0, (Height - H) - Spc); // to the bottom
|
||||
|
||||
OldOpacity := DrawingEngine.Opacity;
|
||||
OldPenStyle := DrawingEngine.PenStyle;
|
||||
with DrawingEngine do
|
||||
try
|
||||
// Semitransparent background
|
||||
Opacity := 0.55;
|
||||
BrushStyle := bsSolid;
|
||||
BrushColor := clWhite;
|
||||
FillRect(R.Left, R.Top, R.Right, R.Bottom);
|
||||
|
||||
// Bar
|
||||
Opacity := 1.0;
|
||||
PenStyle := psSolid;
|
||||
PenColor := clBlack;
|
||||
PenWidth := 1;
|
||||
Polyline([R.TopLeft + Point(0, 10), R.TopLeft,
|
||||
Point(R.Right, R.Top),
|
||||
Point(R.Right, R.Top) + Point(0, 10)]);
|
||||
|
||||
// Caption
|
||||
BrushStyle := bsClear;
|
||||
TextOut(R.CenterPoint.X - Extent.CX div 2, R.Top + 3, Capt);
|
||||
finally
|
||||
Opacity := OldOpacity;
|
||||
PenStyle := OldPenStyle;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMapView.DblClick;
|
||||
begin
|
||||
inherited DblClick;
|
||||
@ -2621,6 +2823,9 @@ const
|
||||
if Assigned(FAfterDrawObjectsEvent) then
|
||||
FAfterDrawObjectsEvent(Self);
|
||||
|
||||
if Scale.Visible and (Zoom >= Scale.ZoomMin) then
|
||||
DrawMapScale;
|
||||
|
||||
DrawingEngine.PaintToCanvas(Canvas);
|
||||
if DebugTiles then
|
||||
DrawCenter;
|
||||
@ -3192,6 +3397,8 @@ begin
|
||||
FCenter.Longitude := 0.0;
|
||||
FCenter.Latitude := 0.0;
|
||||
|
||||
FScale := TMapScale.Create(Self);
|
||||
|
||||
FZoomMin := 1;
|
||||
FZoomMax := 19;
|
||||
Zoom := 1;
|
||||
@ -3212,6 +3419,7 @@ begin
|
||||
FLayers.Free;
|
||||
for I := 0 to High(FGPSItems) do
|
||||
FreeAndNil(FGPSItems[I]);
|
||||
FScale.Free;
|
||||
FCenter.Free;
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user