LazMapViewer: Semi-transparent areas added to the map layers.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9377 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
alpine-a110
parent
269750c258
commit
e8c71cf0d3
@ -179,6 +179,7 @@ type
|
||||
FFillColor: TColor;
|
||||
FLineColor: TColor;
|
||||
FLineWidth: Double;
|
||||
FOpacity: Single;
|
||||
public
|
||||
constructor Create;
|
||||
|
||||
@ -186,6 +187,7 @@ type
|
||||
property FillColor: TColor read FFillColor write FFillColor;
|
||||
property LineColor: TColor read FLineColor write FLineColor;
|
||||
property LineWidth: Double read FLineWidth write FLineWidth;
|
||||
property Opacity: Single read FOpacity write FOpacity;
|
||||
end;
|
||||
|
||||
{ TGPSObjectList }
|
||||
@ -355,11 +357,14 @@ begin
|
||||
FFillColor := clNone;
|
||||
FLineColor := clDefault; // --> use MapView.DefaultTrackColor
|
||||
FLineWidth := -1; // --> use MapView.DefaultTrackWidth
|
||||
FOpacity := 1.0;
|
||||
end;
|
||||
|
||||
procedure TGPSArea.Draw(AView: TObject; Area: TRealArea);
|
||||
begin
|
||||
TMapView(AView).DrawArea(Area, Self);
|
||||
if Assigned(FOnDrawObj)
|
||||
then FOnDrawObj(AView, Self, Area)
|
||||
else TMapView(AView).DrawArea(Area, Self);
|
||||
end;
|
||||
|
||||
{ TGPSPolyLine }
|
||||
|
||||
@ -61,6 +61,8 @@ type
|
||||
TPointsOfInterest = class;
|
||||
TMapTrack = class;
|
||||
TMapTracks = class;
|
||||
TMapArea = class;
|
||||
TMapAreas = class;
|
||||
TGPSTileLayer = class;
|
||||
TGPSComboLayer = class;
|
||||
|
||||
@ -70,6 +72,9 @@ type
|
||||
TMapTrackDrawEvent = procedure(Sender: TObject;
|
||||
ADrawer: TMvCustomDrawingEngine; ATrack: TMapTrack) of object;
|
||||
|
||||
TMapAreaDrawEvent = procedure(Sender: TObject;
|
||||
ADrawer: TMvCustomDrawingEngine; AArea: TMapArea) of object;
|
||||
|
||||
{ TMapObjectList }
|
||||
|
||||
TMapObjectList = class(specialize TFPGObjectList<TObject>)
|
||||
@ -154,8 +159,10 @@ type
|
||||
FMapProvider: String;
|
||||
FOpacity: Single;
|
||||
FPointsOfInterest: TPointsOfInterest;
|
||||
FAreas: TMapAreas;
|
||||
FTracks: TMapTracks;
|
||||
private
|
||||
function GetAreas: TMapAreas;
|
||||
function GetGPSObj: TGPSObj; override;
|
||||
function GetView: TMapView; override;
|
||||
function GetLayer: TMapLayer; override;
|
||||
@ -163,6 +170,7 @@ type
|
||||
function GetPointsOfInterest: TPointsOfInterest;
|
||||
function GetTracks: TMapTracks;
|
||||
function GetUseThreads: Boolean;
|
||||
procedure SetAreas(AValue: TMapAreas);
|
||||
procedure SetDrawMode(AValue: TItemDrawMode);
|
||||
procedure SetMapProvider(AValue: String);
|
||||
procedure SetOpacity(AValue: Single);
|
||||
@ -183,6 +191,7 @@ type
|
||||
property DrawMode: TItemDrawMode read FDrawMode write SetDrawMode default idmUseOpacity;
|
||||
property Opacity: Single read FOpacity write SetOpacity default 0.25;
|
||||
property PointsOfInterest: TPointsOfInterest read GetPointsOfInterest write SetPointsOfInterest;
|
||||
property Areas: TMapAreas read GetAreas write SetAreas;
|
||||
property Tracks: TMapTracks read GetTracks write SetTracks;
|
||||
end;
|
||||
|
||||
@ -277,6 +286,23 @@ type
|
||||
procedure FixOrder(APrevIndex, AIndex: Integer); override;
|
||||
end;
|
||||
|
||||
{ TMapAreaPoint }
|
||||
|
||||
TMapAreaPoint = class(TMapPoint)
|
||||
protected
|
||||
function GPSArea: TGPSArea;
|
||||
function CreatePoint: TGPSPoint; override;
|
||||
procedure DestroyPoint; override;
|
||||
end;
|
||||
|
||||
{ TMapAreaPoints }
|
||||
|
||||
TMapAreaPoints = class(specialize TMapCollection<TMapAreaPoint, TMapArea>)
|
||||
protected
|
||||
function GetLayer: TMapLayer; override;
|
||||
procedure FixOrder(APrevIndex, AIndex: Integer); override;
|
||||
end;
|
||||
|
||||
{ TPointOfInterest }
|
||||
|
||||
TPointOfInterest = class(TMapPoint)
|
||||
@ -305,15 +331,6 @@ type
|
||||
function GetLayer: TMapLayer; override;
|
||||
end;
|
||||
|
||||
{ TMapPolygon }
|
||||
|
||||
TMapPolygon = class(TMapItem)
|
||||
private
|
||||
FPoints: TGPSPointList;
|
||||
published
|
||||
property Points: TGPSPointList read FPoints;
|
||||
end;
|
||||
|
||||
{ TMapTrack }
|
||||
|
||||
TMapTrack = class(TMapItem)
|
||||
@ -343,7 +360,6 @@ type
|
||||
procedure ItemChanged; override;
|
||||
function HitTest(constref Area: TRealArea): TMapObjectList; override;
|
||||
published
|
||||
//property DateTime: TDateTime read GetDateTime write FDateTime;
|
||||
property LineColor: TColor read FLineColor write SetLineColor default clDefault;
|
||||
property LineWidth: Double read FLineWidth write SetLineWidth;
|
||||
property ConnectColor: TColor read FConnectColor write SetConnectColor default clNone;
|
||||
@ -360,6 +376,49 @@ type
|
||||
function GetLayer: TMapLayer; override;
|
||||
end;
|
||||
|
||||
TMapArea = class(TMapItem)
|
||||
private
|
||||
FFillColor: TColor;
|
||||
FLineColor: TColor;
|
||||
FLineWidth: Double;
|
||||
FOpacity: Single;
|
||||
FPoints: TMapAreaPoints;
|
||||
FArea: TGPSArea;
|
||||
FOnDrawArea: TMapAreaDrawEvent;
|
||||
function GetGPSObj: TGPSObj; override;
|
||||
function GetPoints: TMapAreaPoints;
|
||||
procedure SetFillColor(AValue: TColor);
|
||||
procedure SetLineColor(AValue: TColor);
|
||||
procedure SetLineWidth(AValue: Double);
|
||||
procedure SetOnDrawArea(AValue: TMapAreaDrawEvent);
|
||||
procedure SetOpacity(AValue: Single);
|
||||
procedure SetPoints(AValue: TMapAreaPoints);
|
||||
protected
|
||||
procedure DrawArea(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea);
|
||||
public
|
||||
constructor Create(ACollection: TCollection); override;
|
||||
destructor Destroy; override;
|
||||
procedure ItemChanged; override;
|
||||
function HitTest(constref Area: TRealArea): TMapObjectList; override;
|
||||
published
|
||||
property LineColor: TColor read FLineColor write SetLineColor default clDefault;
|
||||
property LineWidth: Double read FLineWidth write SetLineWidth;
|
||||
property FillColor: TColor read FFillColor write SetFillColor default clNone;
|
||||
property Opacity: Single read FOpacity write SetOpacity default 1.0;
|
||||
property Points: TMapAreaPoints read GetPoints write SetPoints;
|
||||
property OnDrawArea: TMapAreaDrawEvent read FOnDrawArea write SetOnDrawArea;
|
||||
end;
|
||||
|
||||
{ TMapAreas }
|
||||
|
||||
TMapAreas = class(specialize TMapCollection<TMapArea, TMapLayer>)
|
||||
protected
|
||||
function GetLayer: TMapLayer; override;
|
||||
public
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
|
||||
{ TMapView }
|
||||
|
||||
TMapView = class(TCustomControl)
|
||||
@ -680,6 +739,183 @@ type
|
||||
destructor Destroy; override;
|
||||
end;
|
||||
|
||||
{ TMapAreaPoints }
|
||||
|
||||
function TMapAreaPoints.GetLayer: TMapLayer;
|
||||
begin
|
||||
Result := MCOwner.Layer;
|
||||
end;
|
||||
|
||||
procedure TMapAreaPoints.FixOrder(APrevIndex, AIndex: Integer);
|
||||
var
|
||||
I, T, B: Integer;
|
||||
Area: TGPSArea;
|
||||
O: TGPSPoint;
|
||||
begin
|
||||
if Assigned(MCOwner) and (MCOwner is TMapArea)
|
||||
then Area := (MCOwner as TMapArea).FArea
|
||||
else Exit;
|
||||
T := Min(APrevIndex, AIndex);
|
||||
B := Max(APrevIndex, AIndex);
|
||||
if APrevIndex < 0 then
|
||||
begin
|
||||
T := AIndex;
|
||||
B := Pred(Count);
|
||||
end;
|
||||
for I := T to B do
|
||||
begin
|
||||
O := TGPSPoint(TMapItem(Items[I]).GPSObj);
|
||||
if Area.Points.Extract(O) <> Nil then
|
||||
Area.Points.Insert(I, O);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ TMapAreas }
|
||||
|
||||
function TMapAreas.GetLayer: TMapLayer;
|
||||
begin
|
||||
Result := MCOwner;
|
||||
end;
|
||||
|
||||
destructor TMapAreas.Destroy;
|
||||
begin
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
{ TMapArea }
|
||||
|
||||
function TMapArea.GetGPSObj: TGPSObj;
|
||||
begin
|
||||
Result := FArea;
|
||||
end;
|
||||
|
||||
function TMapArea.GetPoints: TMapAreaPoints;
|
||||
begin
|
||||
Result := FPoints;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetFillColor(AValue: TColor);
|
||||
begin
|
||||
if FFillColor=AValue then Exit;
|
||||
FFillColor:=AValue;
|
||||
ItemChanged;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetLineColor(AValue: TColor);
|
||||
begin
|
||||
if FLineColor = AValue then Exit;
|
||||
FLineColor := AValue;
|
||||
ItemChanged;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetLineWidth(AValue: Double);
|
||||
begin
|
||||
if FLineWidth = AValue then Exit;
|
||||
FLineWidth := AValue;
|
||||
ItemChanged;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetOnDrawArea(AValue: TMapAreaDrawEvent);
|
||||
begin
|
||||
if CompareMem(@FOnDrawArea, @AValue, SizeOf(TMethod)) then
|
||||
Exit;
|
||||
FOnDrawArea := AValue;
|
||||
if Assigned(FOnDrawArea)
|
||||
then FArea.OnDrawObj := @DrawArea
|
||||
else FArea.OnDrawObj := Nil;
|
||||
ItemChanged;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetOpacity(AValue: Single);
|
||||
begin
|
||||
AValue := EnsureRange(AValue, 0.0, 1.0);
|
||||
if FOpacity = AValue then
|
||||
Exit;
|
||||
FOpacity:=AValue;
|
||||
ItemChanged;
|
||||
end;
|
||||
|
||||
procedure TMapArea.SetPoints(AValue: TMapAreaPoints);
|
||||
begin
|
||||
FPoints.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TMapArea.DrawArea(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea
|
||||
);
|
||||
begin
|
||||
if Assigned(FOnDrawArea) then
|
||||
FOnDrawArea(Sender, (Collection as TMapAreas).GetView.DrawingEngine, Self);
|
||||
end;
|
||||
|
||||
constructor TMapArea.Create(ACollection: TCollection);
|
||||
begin
|
||||
inherited Create(ACollection);
|
||||
FOpacity := 1.0;
|
||||
FLineColor := clDefault;
|
||||
FLineWidth := -1;
|
||||
FFillColor := clNone;
|
||||
FVisible := True;
|
||||
FPoints := TMapAreaPoints.Create(Self, 0);
|
||||
FArea := TGPSArea.Create;
|
||||
Layer.ComboLayer.Add(FArea, Pred(_TILELAYERS_ID_), Self.Index + BASE_Z_AREA);
|
||||
end;
|
||||
|
||||
destructor TMapArea.Destroy;
|
||||
begin
|
||||
FPoints.Free;
|
||||
if Assigned(FArea) then
|
||||
Layer.ComboLayer.Delete(FArea);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TMapArea.ItemChanged;
|
||||
begin
|
||||
FArea.Name := Caption;
|
||||
FArea.LineColor := LineColor;
|
||||
FArea.LineWidth := LineWidth;
|
||||
FArea.FillColor := FillColor;
|
||||
FArea.Opacity := Opacity;
|
||||
FArea.Visible := Visible;
|
||||
Changed(False);
|
||||
end;
|
||||
|
||||
function TMapArea.HitTest(constref Area: TRealArea): TMapObjectList;
|
||||
begin
|
||||
Result := Points.HitTest(Area);
|
||||
if Assigned(Result) then
|
||||
Result.Add(Self);
|
||||
end;
|
||||
|
||||
{ TMapAreaPoint }
|
||||
|
||||
function TMapAreaPoint.GPSArea: TGPSArea;
|
||||
begin
|
||||
Result := Nil;
|
||||
if Assigned(Collection) and (Collection is TMapAreaPoints) then
|
||||
with (Collection as TMapAreaPoints) do
|
||||
if Assigned(MCOwner) and (MCOwner is TMapArea) then
|
||||
Result := (MCOwner as TMapArea).FArea;
|
||||
end;
|
||||
|
||||
function TMapAreaPoint.CreatePoint: TGPSPoint;
|
||||
var
|
||||
Area: TGPSArea;
|
||||
begin
|
||||
Result := inherited CreatePoint;
|
||||
Area := GPSArea;
|
||||
if Assigned(Area)
|
||||
then Area.Points.Add(Result);
|
||||
end;
|
||||
|
||||
procedure TMapAreaPoint.DestroyPoint;
|
||||
var
|
||||
Area: TGPSArea;
|
||||
begin
|
||||
Area := GPSArea;
|
||||
if Assigned(Area) and Assigned(FPoint)
|
||||
then Area.Points.Remove(FPoint);
|
||||
end;
|
||||
|
||||
{ TMapObjectList }
|
||||
|
||||
constructor TMapObjectList.Create(ASingleObj: TObject);
|
||||
@ -1320,6 +1556,11 @@ begin
|
||||
Result := FTracks;
|
||||
end;
|
||||
|
||||
function TMapLayer.GetAreas: TMapAreas;
|
||||
begin
|
||||
Result := FAreas;
|
||||
end;
|
||||
|
||||
function TMapLayer.GetGPSObj: TGPSObj;
|
||||
begin
|
||||
Result := FComboLayer;
|
||||
@ -1347,6 +1588,11 @@ begin
|
||||
Result := FUseThreads;
|
||||
end;
|
||||
|
||||
procedure TMapLayer.SetAreas(AValue: TMapAreas);
|
||||
begin
|
||||
FAreas.Assign(AValue);
|
||||
end;
|
||||
|
||||
procedure TMapLayer.SetDrawMode(AValue: TItemDrawMode);
|
||||
begin
|
||||
if FDrawMode=AValue then Exit;
|
||||
@ -1428,6 +1674,7 @@ begin
|
||||
FTag := 0;
|
||||
|
||||
FPointsOfInterest := TPointsOfInterest.Create(Self, BASE_Z_POI);
|
||||
FAreas := TMapAreas.Create(Self, BASE_Z_AREA);
|
||||
FTracks := TMapTracks.Create(Self, BASE_Z_TRACK);
|
||||
FComboLayer := TGPSComboLayer.Create;
|
||||
View.GPSItems.Add(FComboLayer, _TILELAYERS_ID_, Self.Index + BASE_Z_LAYER);
|
||||
@ -1436,6 +1683,7 @@ end;
|
||||
destructor TMapLayer.Destroy;
|
||||
begin
|
||||
FPointsOfInterest.Free;
|
||||
FAreas.Free;
|
||||
FTracks.Free;
|
||||
if Assigned(FComboLayer) then
|
||||
View.GPSItems.Delete(FComboLayer);
|
||||
@ -1444,8 +1692,9 @@ end;
|
||||
|
||||
function TMapLayer.HitTest(constref Area: TRealArea): TMapObjectList;
|
||||
begin
|
||||
Result := TMapObjectList.AddListToResult(PointsOfInterest.HitTest(Area),
|
||||
Tracks.HitTest(Area));
|
||||
Result := PointsOfInterest.HitTest(Area);
|
||||
Result := TMapObjectList.AddListToResult(Tracks.HitTest(Area), Result);
|
||||
Result := TMapObjectList.AddListToResult(Areas.HitTest(Area), Result);
|
||||
end;
|
||||
|
||||
procedure TMapLayer.AssignFromGPSList(AList: TGPSObjectList);
|
||||
@ -2331,6 +2580,8 @@ begin
|
||||
if NoFill then
|
||||
Pts[Pred(C)] := Pts[0];
|
||||
|
||||
DrawingEngine.Opacity := ar.Opacity;
|
||||
|
||||
if ar.LineColor = clNone then
|
||||
DrawingEngine.PenStyle := psClear
|
||||
else
|
||||
|
||||
Loading…
Reference in New Issue
Block a user