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
This commit is contained in:
alpine-a110 2024-07-02 12:09:27 +00:00
parent 97d83f67b2
commit 8b67489472
7 changed files with 177 additions and 53 deletions

View File

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

View File

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

View File

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

View File

@ -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);

View File

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

View File

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

View File

@ -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;
DrawingEngine.PenWidth := trkWidth;
OldOpacity := DrawingEngine.Opacity;
try
DrawingEngine.Opacity := trk.Opacity;
// Clipping rectangle
if Cyclic then
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;
DrawingEngine.PenColor := trkColor;
DrawingEngine.PenWidth := trkWidth;
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
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
// Clipping rectangle
if Cyclic then
ClipRect := Rect(0, 0, ClientWidth, ClientHeight)
else
begin
iPt3 := CyclicPointOf(iPt2, ClipRect.Right); // Left point
iPt4 := (iPt1 - iPt2); // delta to the right point
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;
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;
DrawingEngine.PenWidth := connWidth;
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
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;
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;
finally
DrawingEngine.Opacity := OldOpacity;
end;
end;