| Author |
 Topic  |
|
|
Fellafoo
USA
60 Posts |
 Posted - Mar 26 2025 : 11:07:07
|
I don't think there is already a built-in way to do this. So, I've prototyped the following function to return a TIEBitmap filled with a radial gradient (with or without an alpha gradient). I tried manipulating the RGBA pixels directly, but that did not work for me.
function RadialGradientFill(Width, Height: Integer; Center: TPoint; Radius: Integer; ClrBeg, ClrEnd: TColor; OpaBeg, OpaEnd: Byte): TIEBitmap;
var
x, y: Integer;
dx, dy: Integer;
Distance: Double;
Ratio: Double;
BegR, BegG, BegB: Byte;
EndR, EndG, EndB: Byte;
CurR, CurG, CurB, CurOpa: Byte;
pPix, pPixA: pRGB{A};
x1, x2, y1, y2: Integer; { Bounding rectangle for fill circle }
ieBmpAlpha: TIEBitmap; { Temp bitmap for alpha fill }
begin
Result := nil;
{ Create TIEBitmap and set pixel format }
Result := TIEBitmap.Create(Width, Height, ie24RGB);
try
ieBmpAlpha := TIEBitmap.Create(Width, Height, ie24RGB);
try
{ Convert the TColor values to their RGB components. }
BegR := GetRValue(ColorToRGB(ClrBeg));
BegG := GetGValue(ColorToRGB(ClrBeg));
BegB := GetBValue(ColorToRGB(ClrBeg));
EndR := GetRValue(ColorToRGB(ClrEnd));
EndG := GetGValue(ColorToRGB(ClrEnd));
EndB := GetBValue(ColorToRGB(ClrEnd));
{ Determine the bounding box of the circle. }
x1 := Max(0, Center.X - Radius);
y1 := Max(0, Center.Y - Radius);
x2 := Min(Width - 1, Center.X + Radius);
y2 := Min(Height - 1, Center.Y + Radius);
{ Loop over each row of the bounding box. }
for y := y1 to y2 do begin
{ Pointer to the first byte of the current scanline. }
pPix := Result.Scanline[y];
pPixA := ieBmpAlpha.Scanline[y];
{ Loop over each pixel in the current row. }
for x := x1 to x2 do begin
dx := x - Center.X;
dy := y - Center.Y;
Distance := Sqrt(dx * dx + dy * dy);
if (Distance <= Radius) then begin
{ Calculate the gradient ratio (0 at center, 1 at the perimeter). }
Ratio := Distance / Radius;
{ Linearly interpolate each color component. }
CurR := Round(BegR + Ratio * (EndR - BegR));
CurG := Round(BegG + Ratio * (EndG - BegG));
CurB := Round(BegB + Ratio * (EndB - BegB));
{ Interpolate the alpha (opacity) value. }
CurOpa := Round(OpaBeg + Ratio * (OpaEnd - OpaBeg));
{ Color pixels }
pPix^.r := CurB;
pPix^.g := CurG;
pPix^.b := CurR;
{ Alpha pixels }
pPixA^.r := CurOpa;
pPixA^.g := CurOpa;
pPixA^.b := CurOpa;
Inc(pPix);
Inc(pPixA);
end;
end;
end;
Result.AlphaChannel.Assign(ieBmpAlpha);
Result.SyncAlphaChannel(); { Convert to 8 bit }
finally
ieBmpAlpha.Free;
end;
except
Result.Free;
end;
end; { RadialGradientFill }
If there's a way to do this with a single bitmap, please let me know.
Thank You,
MFM |
|
|
xequte
38899 Posts |
Posted - Mar 27 2025 : 00:07:08
|
Hi
Your code is fine, and there will be little performance benefit from using a single bitmap, but if you want to you can just treat the alphachannel as regular bitmap as follows (untested):
function RadialGradientFill(Width, Height: Integer; Center: TPoint; Radius: Integer; ClrBeg, ClrEnd: TColor; OpaBeg, OpaEnd: Byte): TIEBitmap;
var
x, y: Integer;
dx, dy: Integer;
Distance: Double;
Ratio: Double;
BegR, BegG, BegB: Byte;
EndR, EndG, EndB: Byte;
CurR, CurG, CurB, CurOpa: Byte;
pPix, pPixA: pRGB{A};
x1, x2, y1, y2: Integer; { Bounding rectangle for fill circle }
begin
Result := nil;
{ Create TIEBitmap and set pixel format }
Result := TIEBitmap.Create(Width, Height, ie24RGB);
try
Result.AlphaChannel.Allocate(Width, Height, ie24RGB); // Temporarily promote to 24bit for smoother gradient
try
{ Convert the TColor values to their RGB components. }
BegR := GetRValue(ColorToRGB(ClrBeg));
BegG := GetGValue(ColorToRGB(ClrBeg));
BegB := GetBValue(ColorToRGB(ClrBeg));
EndR := GetRValue(ColorToRGB(ClrEnd));
EndG := GetGValue(ColorToRGB(ClrEnd));
EndB := GetBValue(ColorToRGB(ClrEnd));
{ Determine the bounding box of the circle. }
x1 := Max(0, Center.X - Radius);
y1 := Max(0, Center.Y - Radius);
x2 := Min(Width - 1, Center.X + Radius);
y2 := Min(Height - 1, Center.Y + Radius);
{ Loop over each row of the bounding box. }
for y := y1 to y2 do begin
{ Pointer to the first byte of the current scanline. }
pPix := Result.Scanline[y];
pPixA := Result.AlphaChannel.Scanline[y];
{ Loop over each pixel in the current row. }
for x := x1 to x2 do begin
dx := x - Center.X;
dy := y - Center.Y;
Distance := Sqrt(dx * dx + dy * dy);
if (Distance <= Radius) then begin
{ Calculate the gradient ratio (0 at center, 1 at the perimeter). }
Ratio := Distance / Radius;
{ Linearly interpolate each color component. }
CurR := Round(BegR + Ratio * (EndR - BegR));
CurG := Round(BegG + Ratio * (EndG - BegG));
CurB := Round(BegB + Ratio * (EndB - BegB));
{ Interpolate the alpha (opacity) value. }
CurOpa := Round(OpaBeg + Ratio * (OpaEnd - OpaBeg));
{ Color pixels }
pPix^.r := CurB;
pPix^.g := CurG;
pPix^.b := CurR;
{ Alpha pixels }
pPixA^.r := CurOpa;
pPixA^.g := CurOpa;
pPixA^.b := CurOpa;
Inc(pPix);
Inc(pPixA);
end;
end;
end;
finally
Result.SyncAlphaChannel(); { Convert to 8 bit }
end;
except
Result.Free;
end;
end;
Nigel
Xequte Software
www.imageen.com
|
 |
|
|
Fellafoo
USA
60 Posts |
Posted - Mar 27 2025 : 07:12:25
|
Thank you, Nigel. Your updated method does work.
Out of curiosity, is it possible to use a single pointer for the pixel access?
For example...
var
pPix: PRGBA;
begin
...
pPix^.r := CurR;
pPix^.g := CurG;
pPix^.b := CurB;
pPix^.a := CurOpa;
I recall trying this previously without success.
MFM |
|
|
|
xequte
38899 Posts |
|
| |
Topic |
|
|
|
Search
Radial Gradient
