
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9527 8e941d3f-bd1b-0410-a28a-d453659cc2b4
232 lines
5.6 KiB
ObjectPascal
232 lines
5.6 KiB
ObjectPascal
{ TMapScalePlugin - draws a length scale corresponding to the current zoom level }
|
|
|
|
unit mvMapScalePlugin;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, Math,
|
|
Graphics, Controls, Types,
|
|
mvMapViewer, mvGeoMath, mvPluginCore;
|
|
|
|
type
|
|
{ TMapScalePlugin }
|
|
|
|
TScaleAlignSet = set of alTop..alRight;
|
|
|
|
TMapScalePlugin = class(TMvPlugin)
|
|
private
|
|
FSpaceY: Integer;
|
|
FAlignSet: TScaleAlignSet;
|
|
FImperial: Boolean;
|
|
FSpaceX: Integer;
|
|
FWidthMax: Integer;
|
|
FZoomMin: Integer;
|
|
procedure SetAlignSet(AValue: TScaleAlignSet);
|
|
procedure SetImperial(AValue: Boolean);
|
|
procedure SetSpaceX(AValue: Integer);
|
|
procedure SetSpaceY(AValue: Integer);
|
|
procedure SetWidthMax(AValue: Integer);
|
|
procedure SetZoomMin(AValue: Integer);
|
|
protected
|
|
procedure AfterDrawObjects(AMapView: TMapView; var {%H-}Handled: Boolean); override;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
published
|
|
property AlignSet: TScaleAlignSet read FAlignSet write SetAlignSet default [alRight, alBottom];
|
|
property Imperial: Boolean read FImperial write SetImperial default False;
|
|
property SpaceX: Integer read FSpaceX write SetSpaceX default 10;
|
|
property SpaceY: Integer read FSpaceY write SetSpaceY default 10;
|
|
property WidthMax: Integer read FWidthMax write SetWidthMax default 250;
|
|
property ZoomMin: Integer read FZoomMin write SetZoomMin default 8;
|
|
end;
|
|
|
|
implementation
|
|
|
|
constructor TMapScalePlugin.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
FAlignSet := [alRight, alBottom];
|
|
FImperial := False;
|
|
FSpaceX := 10;
|
|
FSpaceY := 10;
|
|
FWidthMax := 250;
|
|
FZoomMin := 8;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.AfterDrawObjects(AMapView: TMapView; var Handled: Boolean);
|
|
var
|
|
Dist, V: Double;
|
|
Digits: Integer;
|
|
R: TRect;
|
|
OldOpacity: Single;
|
|
OldPenStyle: TPenStyle;
|
|
Capt: String;
|
|
Extent: TSize;
|
|
W, H, HalfHeight, SpcX, SpcY: Integer;
|
|
MaxW: Integer;
|
|
begin
|
|
if AMapView.Zoom < FZoomMin then
|
|
exit;
|
|
|
|
SpcX := FSpaceX;
|
|
SpcY := FSpaceY;
|
|
MaxW := Min(WidthMax, AMapView.ClientWidth);
|
|
HalfHeight := AMapView.Height div 2;
|
|
|
|
with AMapView.Engine.ScreenRectToRealArea(Rect(0, HalfHeight, MaxW, HalfHeight)) 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 := AMapView.DrawingEngine.TextExtent(Capt);
|
|
|
|
// Width and height
|
|
W := Round(MaxW * (V / Dist));
|
|
H := Extent.Height + 3 + 3;
|
|
|
|
if W + SpcX >= AMapView.ClientWidth then
|
|
SpcX := Max(1, AMapView.ClientWidth - W - 1);
|
|
if H + SpcY > AMapView.ClientHeight then
|
|
SpcY := Max(1, AMapView.ClientHeight - H - 1);
|
|
|
|
R := Rect(0, 0, W, H);
|
|
|
|
// Fix align set
|
|
if FAlignSet * [alLeft, alRight] = [] then
|
|
Include(FAlignSet, alRight);
|
|
if FAlignSet * [alTop, alBottom] = [] then
|
|
Include(FAlignSet, alBottom);
|
|
|
|
// Horizontal position
|
|
if alLeft in AlignSet then
|
|
if alRight in AlignSet then
|
|
R.Offset((AMapView.ClientWidth - W) div 2, 0) // Both alLeft+alRight=Center
|
|
else
|
|
R.Offset(SpcX, 0) // to the left
|
|
else
|
|
if alRight in AlignSet then
|
|
R.Offset((AMapView.ClientWidth - W) - SpcX, 0); // to the right
|
|
|
|
// Vertical position
|
|
if alTop in AlignSet then
|
|
if alBottom in AlignSet then
|
|
R.Offset(0, (AMapView.ClientHeight - H) div 2) // Both alTop+alBottom=Middle
|
|
else
|
|
R.Offset(0, SpcY) // to the top
|
|
else
|
|
if alBottom in AlignSet then
|
|
R.Offset(0, (AMapView.ClientHeight - H) - SpcY); // to the bottom
|
|
|
|
OldOpacity := AMapView.DrawingEngine.Opacity;
|
|
OldPenStyle := AMapView.DrawingEngine.PenStyle;
|
|
with AMapView.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 TMapScalePlugin.SetAlignSet(AValue: TScaleAlignSet);
|
|
begin
|
|
if FAlignSet = AValue then Exit;
|
|
FAlignSet := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.SetImperial(AValue: Boolean);
|
|
begin
|
|
if FImperial = AValue then Exit;
|
|
FImperial := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.SetSpaceX(AValue: Integer);
|
|
begin
|
|
if FSpaceX = AValue then Exit;
|
|
FSpaceX := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.SetSpaceY(AValue: Integer);
|
|
begin
|
|
if FSpaceY = AValue then Exit;
|
|
FSpaceY := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.SetWidthMax(AValue: Integer);
|
|
begin
|
|
if FWidthMax = AValue then Exit;
|
|
FWidthMax := AValue;
|
|
Update;
|
|
end;
|
|
|
|
procedure TMapScalePlugin.SetZoomMin(AValue: Integer);
|
|
begin
|
|
if FZoomMin = AValue then Exit;
|
|
FZoomMin := AValue;
|
|
Update;
|
|
end;
|
|
|
|
initialization
|
|
RegisterPluginClass(TMapScalePlugin, 'Map scale');
|
|
|
|
end.
|
|
|