paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-06-06 03:38:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

fpvectorial: Fix rendering of radial gradients

Browse Source
This commit is contained in:
wp_xyz 2023-01-20 00:54:00 +01:00
parent e4e48d6ab8
commit 89b047a06c
4 changed files with 57 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
components/fpvectorial/fpvectorial.pas
View File

@ -4307,17 +4307,9 @@ var
lDist: Double;
lColor: TFPColor;
function GradientValue_to_px(AValue: Double; AUnit: TvCoordinateUnit; AIsY: Boolean): Integer;
var
lSideLen: Integer;
function GradientValue_to_px(AValue: Double; AUnit: TvCoordinateUnit; ASideLen: Integer; AIsY: Boolean): Integer;
begin
Result := 0;
if AIsY then
lSideLen := (ARect.Bottom-ARect.Top)
else
lSideLen := (ARect.Right-ARect.Left);
case AUnit of
vcuDocumentUnit:
if AIsY then
@ -4325,7 +4317,7 @@ var
else
Result := CoordToCanvasX(AValue, ARenderInfo.DestX, ARenderInfo.MulX);
vcuPercentage:
Result := Round(lSideLen * AValue);
Result := Round(ASideLen * AValue);
end;
end;
@ -4363,10 +4355,10 @@ begin
lAspectRatio := lHeight/lWidth;
// Calculate center of outer-most gradient circle
lGradient_cx_px := GradientValue_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, False);
lGradient_cy_px := GradientValue_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, True);
lGradient_cx_px := GradientValue_to_px(Brush.Gradient_cx, Brush.Gradient_cx_Unit, lWidth, False);
lGradient_cy_px := GradientValue_to_px(Brush.Gradient_cy, Brush.Gradient_cy_Unit, lHeight, True);
// Calculate radius of outer-most gradient circle, relative the width
lGradient_r_px := GradientValue_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, False);
lGradient_r_px := GradientValue_to_px(Brush.Gradient_r, Brush.Gradient_r_Unit, lWidth, false);
{ -- not implemented, yet
lGradient_fx_px := GradientValue_to_px(Brush.Gradient_fx, Brush.Gradient_fx_Unit, False);
lGradient_fy_px := GradientValue_to_px(Brush.Gradient_fy, Brush.Gradient_fy_Unit, True);
@ -4375,19 +4367,19 @@ begin
// pixel-by-pixel version
for i := 0 to lWidth-1 do
begin
for J := 0 to lHeight-1 do
for j := 0 to lHeight-1 do
begin
lx := ARect.Left + i;
ly := ARect.Top + j;
if not IsPointInPolygon(lx, ly, APoints) then Continue;
// distance of current point (i, j) to gradient center, corrected for aspect ratio
// distance of current point (i, j) to gradient center, correct for aspect ratio
lDist := sqrt(sqr(i - lGradient_cx_px) + sqr((j - lGradient_cy_px)/lAspectRatio));
// lDist := sqrt(sqr(i-lGradient_cx_px)+sqr(j-lGradient_cy_px));
lDist := lDist / lGradient_r_px;
lDist := Min(Max(0, lDist), 1);
// Color for point (lx, ly)
lColor := Distance_To_RadialGradientColor(lDist);
ADest.Colors[lx, ly] := AlphaBlendColor(ADest.Colors[lx, ly], lColor);
end;
end;

11
components/fpvectorial/tests/vt_gradients.inc
View File

@ -48,4 +48,15 @@ Tree.Items.AddChildObject(node, 'Rounded rectangle',
Tree.Items.AddChildObject(node, 'Polygon',
TRenderParams.Create(@Render_Shape, 'polygon_gradientradial.png', $0504));
node := Tree.Items.AddChild(mainnode, 'radial off-center');
Tree.Items.AddChildObject(node, 'Circle',
TRenderParams.Create(@Render_Shape, 'circle_gradientradial_offc.png', $0105));
Tree.Items.AddChildObject(node, 'Ellipse',
TRenderParams.Create(@Render_Shape, 'ellipse_gradientradial_offc.png', $0205));
Tree.Items.AddChildObject(node, 'Rectangle',
TRenderParams.Create(@Render_Shape, 'rect_gradientradial_offc.png', $0305));
Tree.Items.AddChildObject(node, 'Rounded rectangle',
TRenderParams.Create(@Render_Shape, 'rounded_rect_gradientradial_offc.png', $0405));
Tree.Items.AddChildObject(node, 'Polygon',
TRenderParams.Create(@Render_Shape, 'polygon_gradientradial_offc.png', $0505));

12
components/fpvectorial/tests/vtmain.pas
View File

@ -440,7 +440,8 @@ procedure TMainForm.Render_Shape(APage: TvVectorialPage;
$00000001 --> horizontal gradient
$00000002 --> vertical gradient
$00000003 --> linear gradient
$00000004 --> radial gradient
$00000004 --> radial gradient (centered)
$00000005 --> radial gradient (off-center)
AIntParam and $0000FF00 = $00000100 --> circle
$00000200 --> ellipse
$00000300 --> rectangle
@ -465,7 +466,8 @@ begin
$00000001: ent.Brush := StdHorizGradientBrush(colYellow, colRed);
$00000002: ent.Brush := StdVertGradientBrush(colYellow, colRed);
$00000003: ent.Brush := StdLinearGradientBrush(colYellow, colRed);
$00000004: ent.Brush := StdRadialGradientBrush(colYellow, colRed);
$00000004: ent.Brush := StdRadialGradientBrush(colYellow, colRed, 0.5, 0.5, 0.5);
$00000005: ent.Brush := StdRadialGradientBrush(colYellow, colRed, 0.25, 0.25, 0.75);
else raise Exception.Create('Brush not supported');
end;
case AIntParam and $000F0000 of
@ -616,7 +618,8 @@ begin
$00000001: obj.Brush := StdHorizGradientBrush(colYellow, colRed);
$00000002: obj.Brush := StdVertGradientBrush(colYellow, colRed);
$00000003: obj.Brush := StdLinearGradientBrush(colYellow, colRed);
$00000004: obj.Brush := StdRadialGradientBrush(colYellow, colRed);
$00000004: obj.Brush := StdRadialGradientBrush(colYellow, colRed, 0.5, 0.5, 0.5);
$00000005: obj.Brush := StdRadialGradientBrush(colYellow, colRed, 0.25, 0.25, 0.75);
else raise Exception.Create('Brush not supported');
end;
case AIntParam and $000F0000 of
@ -646,7 +649,8 @@ begin
$00000001: obj.Brush := StdHorizGradientBrush(colBlue, colWhite);
$00000002: obj.Brush := StdVertGradientBrush(colBlue, colWhite);
$00000003: obj.Brush := StdLinearGradientBrush(colBlue, colWhite);
$00000004: obj.Brush := StdRadialGradientBrush(colBlue, colWhite);
$00000004: obj.Brush := StdRadialGradientBrush(colBlue, colWhite, 0.5, 0.5, 0.5);
$00000005: obj.Brush := StdRadialGradientBrush(colBlue, colWhite, 0.25, 0.25, 0.75);
else raise Exception.Create('Brush not supported');
end;
case AIntParam and $00000F00 of

33
components/fpvectorial/tests/vtprimitives.pas
View File

@ -37,7 +37,7 @@ function StdSolidBrush(AColor: TFPColor): TvBrush;
function StdHorizGradientBrush(AColor1, AColor2: TFPColor): TvBrush;
function StdVertGradientBrush(AColor1, AColor2: TFPColor): TvBrush;
function StdLinearGradientBrush(AColor1, AColor2: TFPColor): TvBrush;
function StdRadialGradientBrush(AColor1, AColor2: TFPColor): TvBrush;
function StdRadialGradientBrush(AColor1, AColor2: TFPColor; CX, CY, R: Double): TvBrush;
function StdPen(AColor: TFPColor; AWidth: Integer): TvPen;
procedure Rotate(APage: TvVectorialPage; AShape: TvEntity; Angle: Double);
@ -256,6 +256,30 @@ begin
Result.Gradient_colors[1].Position := 1;
end;
function CreateRadialGradientBrush(CX, CY, R, FX, FY: Double;
AStartColor, AEndColor: TFPColor): TvBrush;
begin
Result.Kind := bkRadialGradient;
Result.Gradient_cx := CX;
Result.Gradient_cy := CY;
Result.Gradient_r := R;
// Our renderer does not support a moving center --> put both centers at the same spot
Result.Gradient_fx := CX;
Result.Gradient_fy := CY;
Result.Gradient_cx_Unit := vcuPercentage;
Result.Gradient_cy_Unit := vcuPercentage;
Result.Gradient_r_Unit := vcuPercentage;
Result.Gradient_fx_Unit := vcuPercentage;
Result.Gradient_fy_Unit := vcuPercentage;
SetLength(Result.Gradient_colors, 2);
Result.Gradient_colors[0].Color := AStartColor;
Result.Gradient_colors[0].Position := 0;
Result.Gradient_colors[1].Color := AEndColor;
Result.Gradient_colors[1].Position := 1;
end;
(*
function CreateRadialGradientBrush(CX, CY, R, FX, FY: Double;
AStartColor, AEndColor: TFPColor): TvBrush;
begin
@ -270,7 +294,7 @@ begin
Result.Gradient_colors[0].Position := 0;
Result.Gradient_colors[1].Color := AEndColor;
Result.Gradient_colors[1].Position := 1;
end;
end; *)
{ Pen }
@ -438,9 +462,10 @@ begin
AColor1, AColor2);
end;
function StdRadialGradientBrush(AColor1, AColor2: TFPColor): TvBrush;
function StdRadialGradientBrush(AColor1, AColor2: TFPColor;
CX, CY, R: Double): TvBrush;
begin
Result := CreateRadialGradientBrush(0.5, 0.5, 0.5, 0.5, 0.5,
Result := CreateRadialGradientBrush(CX, CY, R, 0.5, 0.5,
AColor1, AColor2);
end;