LazMapViewer: Added Opacity property to the TMvIntfGraphicsDrawingEngine, TMvBGRADrawingEngine, TMapTrack, TGPSTrack.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9375 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/lazmapviewer/source/addons/bgra_drawingengine/mvde_bgra.pas

@@ -56,6 +56,8 @@ type
     function GetPenColor: TColor; override;
     function GetPenStyle: TPenStyle; override;
     function GetPenWidth: Integer; override;
+    function GetOpacity: Single; override;
+    procedure SetOpacity(AValue: Single); override;
     procedure SetBrushColor(AValue: TColor); override;
     procedure SetBrushStyle(AValue: TBrushStyle); override;
     procedure SetFontColor(AValue: TColor); override;
@@ -259,6 +261,25 @@ begin
   Result := FBuffer.CanvasBGRA.Pen.Width
 end;
 
+function TMvBGRADrawingEngine.GetOpacity: Single;
+var
+  A: Byte;
+begin
+  A := FBuffer.CanvasBGRA.Pen.BGRAColor.alpha;
+  if 255 = A
+    then Result := 1.0
+    else Result := Round(A / 255);
+end;
+
+procedure TMvBGRADrawingEngine.SetOpacity(AValue: Single);
+var
+  A: Byte;
+begin
+  A := Round(255 * AValue);
+  FBuffer.CanvasBGRA.Pen.BGRAColor.alpha := A;
+  FBuffer.CanvasBGRA.Brush.BGRAColor.alpha := A;
+end;
+
 procedure TMvBGRADrawingEngine.SetPenStyle(AValue: TPenStyle);
 begin
   FBuffer.CanvasBGRA.Pen.Style := AValue;

components/lazmapviewer/source/addons/rgbgraphics_drawingengine/mvde_rgbgraphics.pas

@@ -61,6 +61,8 @@ type
     function GetPenColor: TColor; override;
     function GetPenStyle: TPenStyle; override;
     function GetPenWidth: Integer; override;
+    function GetOpacity: Single; override;
+    procedure SetOpacity(AValue: Single); override;
     procedure SetBrushColor(AValue: TColor); override;
     procedure SetBrushStyle(AValue: TBrushStyle); override;
     procedure SetFontColor(AValue: TColor); override;
@@ -478,6 +480,16 @@ begin
   Result := FPenWidth;
 end;
 
+function TMvRGBGraphicsDrawingEngine.GetOpacity: Single;
+begin
+  Result := 1.0;
+end;
+
+procedure TMvRGBGraphicsDrawingEngine.SetOpacity(AValue: Single);
+begin
+  ;// TODO
+end;
+
 procedure TMvRGBGraphicsDrawingEngine.SetPenStyle(AValue: TPenStyle);
 begin
   FPenStyle := AValue;

components/lazmapviewer/source/mvde_intfgraphics.pas

@@ -46,8 +46,10 @@ type
     FFontColor: TColor;
     FFontSize: Integer;
     FFontStyle: TFontStyles;
+    FOpacity: Single;
     procedure CreateLazIntfImageAndCanvas(out ABuffer: TLazIntfImage;
       out ACanvas: TFPCustomCanvas; AWidth, AHeight: Integer);
+    procedure AddAlphaToColors;
   protected
     procedure DrawBitmapOT(X, Y: Integer; ABitmap: TCustomBitmap; AOpaqueColor, ATransparentColor: TColor);
     function GetBrushColor: TColor; override;
@@ -59,6 +61,8 @@ type
     function GetPenColor: TColor; override;
     function GetPenStyle: TPenStyle; override;
     function GetPenWidth: Integer; override;
+    function GetOpacity: Single; override;
+    procedure SetOpacity(AValue: Single); override;
     procedure SetBrushColor(AValue: TColor); override;
     procedure SetBrushStyle(AValue: TBrushStyle); override;
     procedure SetFontColor(AValue: TColor); override;
@@ -69,6 +73,7 @@ type
     procedure SetPenStyle(AValue: TPenStyle); override;
     procedure SetPenWidth(AValue: Integer); override;
   public
+    constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure CreateBuffer(AWidth, AHeight: Integer); override;
     procedure DrawBitmap(X, Y: Integer; ABitmap: TCustomBitmap;
@@ -243,10 +248,29 @@ begin
   rawImg.CreateData(True);
   ABuffer := TLazIntfImage.Create(rawImg, true);
   ACanvas := TFPImageCanvas.Create(ABuffer);
-  ACanvas.Brush.FPColor := colWhite;
+  {ACanvas.Brush.FPColor}BrushColor := clWhite;
   ACanvas.FillRect(0, 0, AWidth, AHeight);
 end;
 
+procedure TMvIntfGraphicsDrawingEngine.AddAlphaToColors;
+var
+  A: Word;
+begin
+  if not Assigned(FCanvas) then
+    Exit;
+  with FCanvas do
+    if FOpacity > 0.99 then
+      DrawingMode := dmOpaque
+    else
+    begin
+      A := Round($FFFF * FOpacity);
+      Pen.FPColor := FPColor(Pen.FPColor.Red, Pen.FPColor.Green, Pen.FPColor.Blue, A);
+      Brush.FPColor := FPColor(Brush.FPColor.Red, Brush.FPColor.Green, Brush.FPColor.Blue, A);
+      //FFontColor := ;
+      DrawingMode := dmAlphaBlend;
+    end;
+end;
+
 function TMvIntfGraphicsDrawingEngine.GetPenStyle: TPenStyle;
 begin
   if FCanvas <> Nil
@@ -513,6 +537,21 @@ begin
     Result := 0;
 end;
 
+function TMvIntfGraphicsDrawingEngine.GetOpacity: Single;
+begin
+  if Assigned(FCanvas) and (FCanvas.DrawingMode = dmAlphaBlend)
+    then Result := FOpacity
+    else Result := 1.0;
+end;
+
+procedure TMvIntfGraphicsDrawingEngine.SetOpacity(AValue: Single);
+begin
+  if not Assigned(FCanvas) or (AValue = FOpacity) then
+    Exit;
+  FOpacity := AValue;
+  AddAlphaToColors;
+end;
+
 procedure TMvIntfGraphicsDrawingEngine.SetPenStyle(AValue: TPenStyle);
 begin
   if FCanvas <> Nil then
@@ -611,7 +650,10 @@ end;
 procedure TMvIntfGraphicsDrawingEngine.SetBrushColor(AValue: TColor);
 begin
   if FCanvas <> nil then
+  begin
     FCanvas.Brush.FPColor := TColorToFPColor(AValue);
+    AddAlphaToColors;
+  end;
 end;
 
 procedure TMvIntfGraphicsDrawingEngine.SetBrushStyle(AValue: TBrushStyle);
@@ -643,7 +685,10 @@ end;
 procedure TMvIntfGraphicsDrawingEngine.SetPenColor(AValue: TColor);
 begin
   if FCanvas <> nil then
+  begin
     FCanvas.Pen.FPColor := TColorToFPColor(AValue);
+    AddAlphaToColors;
+  end;
 end;
 
 procedure TMvIntfGraphicsDrawingEngine.SetPenWidth(AValue: Integer);
@@ -652,6 +697,12 @@ begin
     FCanvas.Pen.Width := AValue;
 end;
 
+constructor TMvIntfGraphicsDrawingEngine.Create(AOwner: TComponent);
+begin
+  inherited Create(AOwner);
+  FOpacity := 1.0;
+end;
+
 function TMvIntfGraphicsDrawingEngine.TextExtent(const AText: String): TSize;
 var
   bmp: TBitmap;

components/lazmapviewer/source/mvde_lcl.pas

@@ -51,6 +51,8 @@ type
       function GetPenColor: TColor; override;
       function GetPenStyle: TPenstyle; override;
       function GetPenWidth: Integer; override;
+      function GetOpacity: Single; override;
+      procedure SetOpacity(AValue: Single); override;
       procedure SetBrushColor(AValue: TColor); override;
       procedure SetBrushStyle(AValue: TBrushStyle); override;
       procedure SetFontColor(AValue: TColor); override;
@@ -244,7 +246,7 @@ begin
   Result := FBuffer.Canvas.Pen.Color;
 end;
 
-function TMvLCLDrawingEngine.GetPenStyle: TPenStyle;
+function TMvLCLDrawingEngine.GetPenStyle: TPenstyle;
 begin
   Result := FBuffer.Canvas.Pen.Style;
 end;
@@ -254,6 +256,16 @@ begin
   Result := FBuffer.Canvas.Pen.Width;
 end;
 
+function TMvLCLDrawingEngine.GetOpacity: Single;
+begin
+  Result := 1.0;
+end;
+
+procedure TMvLCLDrawingEngine.SetOpacity(AValue: Single);
+begin
+  ;// TODO
+end;
+
 procedure TMvLCLDrawingEngine.Line(X1, Y1, X2, Y2: Integer);
 begin
   FBuffer.Canvas.Line(X1, Y1, X2, Y2);

components/lazmapviewer/source/mvdrawingengine.pas

@@ -37,6 +37,8 @@ type
     function GetPenColor: TColor; virtual; abstract;
     function GetPenStyle: TPenStyle; virtual; abstract;
     function GetPenWidth: Integer; virtual; abstract;
+    function GetOpacity: Single; virtual; abstract;
+    procedure SetOpacity(AValue: Single); virtual; abstract;
     procedure SetPenStyle(AValue: TPenStyle); virtual; abstract;
     procedure SetBrushColor(AValue: TColor); virtual; abstract;
     procedure SetBrushStyle(AValue: TBrushStyle); virtual; abstract;
@@ -82,6 +84,7 @@ type
     property PenColor: TColor read GetPenColor write SetPenColor;
     property PenStyle: TPenStyle read GetPenStyle write SetPenStyle;
     property PenWidth: Integer read GetPenWidth write SetPenWidth;
+    property Opacity: Single read GetOpacity write SetOpacity;
   end;
 
 // Vector <MX, MY> orthogonal to a line <X1, Y1>, <X2, Y2>

components/lazmapviewer/source/mvgpsobj.pas

@@ -156,6 +156,7 @@ type
     FDateTime: TDateTime;
     FLineWidth: Double;  // Line width in mm
     FLineColor: TColor;
+    FOpacity: Single;
     function GetDateTime: TDateTime;
   public
     constructor Create;
@@ -168,6 +169,7 @@ type
     property LineWidth: Double read FLineWidth write FLineWidth;
     property ConnectColor: TColor read FConnectColor write FConnectColor;
     property ConnectWidth: Double read FConnectWidth write FConnectWidth;
+    property Opacity: Single read FOpacity write FOpacity;
   end;
 
   { TGPSArea }
@@ -940,6 +942,7 @@ begin
   FLineWidth := -1;         // --> use MapView.DefaultTrackWidth
   FConnectColor := clNone;  // --> None, clDefault for LineColor
   FConnectWidth := -1;      // --> use LineWidth
+  FOpacity := 1.0;
 end;
 
 

components/lazmapviewer/source/mvmapviewer.pas

@@ -322,6 +322,7 @@ type
     FConnectWidth: Double;
     FLineColor: TColor;
     FLineWidth: Double;
+    FOpacity: Single;
     FPoints: TMapTrackPoints;
     FTrack: TGPSTrack;
     FOnDrawTrack: TMapTrackDrawEvent;
@@ -332,6 +333,7 @@ type
     procedure SetLineColor(AValue: TColor);
     procedure SetLineWidth(AValue: Double);
     procedure SetOnDrawTrack(AValue: TMapTrackDrawEvent);
+    procedure SetOpacity(AValue: Single);
     procedure SetPoints(AValue: TMapTrackPoints);
   protected
     procedure DrawTrack(Sender: TObject; AGPSObj: TGPSObj; AArea: TRealArea);
@@ -346,6 +348,7 @@ type
     property LineWidth: Double read FLineWidth write SetLineWidth;
     property ConnectColor: TColor read FConnectColor write SetConnectColor default clNone;
     property ConnectWidth: Double read FConnectWidth write SetConnectWidth;
+    property Opacity: Single read FOpacity write SetOpacity default 1.0;
     property Points: TMapTrackPoints read GetPoints write SetPoints;
     property OnDrawTrack: TMapTrackDrawEvent read FOnDrawTrack write SetOnDrawTrack;
   end;
@@ -843,6 +846,15 @@ begin
   ItemChanged;
 end;
 
+procedure TMapTrack.SetOpacity(AValue: Single);
+begin
+  AValue := EnsureRange(AValue, 0.0, 1.0);
+  if FOpacity = AValue then
+    Exit;
+  FOpacity:=AValue;
+  ItemChanged;
+end;
+
 function TMapTrack.GetGPSObj: TGPSObj;
 begin
   Result := FTrack;
@@ -896,6 +908,7 @@ end;
 constructor TMapTrack.Create(ACollection: TCollection);
 begin
   inherited Create(ACollection);
+  FOpacity := 1.0;
   FLineColor := clDefault;
   FLineWidth := -1;
   FConnectColor := clNone;
@@ -921,6 +934,7 @@ begin
   FTrack.LineWidth := LineWidth;
   FTrack.ConnectColor := ConnectColor;
   FTrack.ConnectWidth := ConnectWidth;
+  FTrack.Opacity := Opacity;
   FTrack.Visible := Visible;
   Changed(False);
 end;
@@ -2187,6 +2201,7 @@ var
   pt1, pt2: TRealPoint;
   trkColor, connColor: TColor;
   trkWidth, connWidth: Integer;
+  OldOpacity: Single;
 
   procedure ClipDrawLine(P1, P2: TPoint); inline;
   begin
@@ -2215,65 +2230,72 @@ begin
       else connWidth := TrackLineWidth(trk.ConnectWidth, trk.ExtraData);
   end;
 
-  DrawingEngine.PenColor := trkColor;
+  OldOpacity := DrawingEngine.Opacity;
-  DrawingEngine.PenWidth := trkWidth;
+  try
+    DrawingEngine.Opacity := trk.Opacity;
 
-  // Clipping rectangle
+    DrawingEngine.PenColor := trkColor;
-  if Cyclic then
+    DrawingEngine.PenWidth := trkWidth;
-    ClipRect := Rect(0, 0, ClientWidth, ClientHeight)
-  else
-  begin
-    L := Max(0, Engine.MapLeft);
-    T := Max(0, Engine.MapTop);
-    WS := ZoomFactor(Zoom) * TILE_SIZE;
-    ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth),
-      Min(Engine.MapTop + WS, ClientHeight));
-  end;
 
-  pt1 := trk.Points[0].RealPoint;
+    // Clipping rectangle
-  iPt1 := Engine.LatLonToScreen(pt1);
+    if Cyclic then
-  EndSegm := TSegmentExtraData.MarkOf(trk.Points[0].ExtraData) = smEnd;
+      ClipRect := Rect(0, 0, ClientWidth, ClientHeight)
-  for I := 1 to Pred(trk.Points.Count) do
-  begin
-    pt2 := trk.Points[I].RealPoint;
-    iPt2 := Engine.LatLonToScreen(pt2);
-    ToEast := GoingEast(pt1.Lon, pt2.Lon); // Eastwards?
-    iPt2 := CyclicPointOf(iPt2, iPt1.X, ToEast); // Nearest iPt2 to iPt1
-
-    // Rightmost cyclic copy of the segment
-    if ToEast then
-    begin
-      iPt3 := CyclicPointOf(iPt1, ClipRect.Right); // Left point
-      iPt4 := (iPt2 - iPt1); // delta to the right point
-    end
     else
     begin
-      iPt3 := CyclicPointOf(iPt2, ClipRect.Right); // Left point
+      L := Max(0, Engine.MapLeft);
-      iPt4 := (iPt1 - iPt2); // delta to the right point
+      T := Max(0, Engine.MapTop);
+      WS := ZoomFactor(Zoom) * TILE_SIZE;
+      ClipRect := Rect(L, T, Min(Engine.MapLeft + WS, ClientWidth),
+        Min(Engine.MapTop + WS, ClientHeight));
     end;
 
-    if EndSegm and ConnSegm then
+    pt1 := trk.Points[0].RealPoint;
+    iPt1 := Engine.LatLonToScreen(pt1);
+    EndSegm := TSegmentExtraData.MarkOf(trk.Points[0].ExtraData) = smEnd;
+    for I := 1 to Pred(trk.Points.Count) do
     begin
-      DrawingEngine.PenColor := connColor;
+      pt2 := trk.Points[I].RealPoint;
-      DrawingEngine.PenWidth := connWidth;
+      iPt2 := Engine.LatLonToScreen(pt2);
+      ToEast := GoingEast(pt1.Lon, pt2.Lon); // Eastwards?
+      iPt2 := CyclicPointOf(iPt2, iPt1.X, ToEast); // Nearest iPt2 to iPt1
+
+      // Rightmost cyclic copy of the segment
+      if ToEast then
+      begin
+        iPt3 := CyclicPointOf(iPt1, ClipRect.Right); // Left point
+        iPt4 := (iPt2 - iPt1); // delta to the right point
+      end
+      else
+      begin
+        iPt3 := CyclicPointOf(iPt2, ClipRect.Right); // Left point
+        iPt4 := (iPt1 - iPt2); // delta to the right point
+      end;
+
+      if EndSegm and ConnSegm then
+      begin
+        DrawingEngine.PenColor := connColor;
+        DrawingEngine.PenWidth := connWidth;
+      end;
+
+      if not EndSegm or ConnSegm then
+        // Draw all copies of the segment, right to left
+        repeat
+          ClipDrawLine(iPt3, iPt3 + iPt4);
+          iPt3 := CyclicPointOf(iPt3, Pred(iPt3.X), False); // Next left cyclic iPt3
+        until Max(iPt3.X, iPt3.X + iPt4.X) < ClipRect.Left;
+
+      if EndSegm and ConnSegm then
+      begin
+        DrawingEngine.PenColor := trkColor;
+        DrawingEngine.PenWidth := trkWidth;
+      end;
+
+      pt1 := pt2;
+      iPt1 := iPt2;
+      EndSegm := TSegmentExtraData.MarkOf(trk.Points[I].ExtraData) = smEnd;
     end;
-
+  finally
-    if not EndSegm or ConnSegm then
+    DrawingEngine.Opacity := OldOpacity;
-      // Draw all copies of the segment, right to left
-      repeat
-        ClipDrawLine(iPt3, iPt3 + iPt4);
-        iPt3 := CyclicPointOf(iPt3, Pred(iPt3.X), False); // Next left cyclic iPt3
-      until Max(iPt3.X, iPt3.X + iPt4.X) < ClipRect.Left;
-
-    if EndSegm and ConnSegm then
-    begin
-      DrawingEngine.PenColor := trkColor;
-      DrawingEngine.PenWidth := trkWidth;
-    end;
-
-    pt1 := pt2;
-    iPt1 := iPt2;
-    EndSegm := TSegmentExtraData.MarkOf(trk.Points[I].ExtraData) = smEnd;
   end;
 end;