From 66ff282a1d14dbb2e22d3878f7d593f61f5ef548 Mon Sep 17 00:00:00 2001 From: alpine-a110 Date: Wed, 4 Dec 2024 17:10:22 +0000 Subject: [PATCH] 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 --- .../lazmapviewer/source/mvmapviewer.pas | 208 ++++++++++++++++++ 1 file changed, 208 insertions(+) diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 5aa07c8be..3aafe44d5 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/components/lazmapviewer/source/mvmapviewer.pas @@ -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;