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

components/lazmapviewer/source/mvgpsobj.pas

@@ -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 }

components/lazmapviewer/source/mvmapviewer.pas

@@ -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),
+  Result := PointsOfInterest.HitTest(Area);
-    Tracks.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