diff --git a/components/lazmapviewer/source/mvgpsobj.pas b/components/lazmapviewer/source/mvgpsobj.pas index 306f7e636..f256118ce 100644 --- a/components/lazmapviewer/source/mvgpsobj.pas +++ b/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 } diff --git a/components/lazmapviewer/source/mvmapviewer.pas b/components/lazmapviewer/source/mvmapviewer.pas index 8f389aa28..756023162 100644 --- a/components/lazmapviewer/source/mvmapviewer.pas +++ b/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) @@ -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) + 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) + 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