procedure CircularGradientPattern(Center: TPoint; OuterRadius, InnerRadius: TRealPoint;
Colors:
array of TColor;
var Bitmap: TBitmap; Region: HRGN = 0);
var PixelsTop,
PixelsBottom : PRGBArray;
X, Y : integer;
YSquare,
XSquare,
angle,
exzIn, exzOut,
lInnerRad,
lABSVector,
lOuterEllipseRad: extended;
LInnerRadius,
LOuterEllipse: TRealPoint;
StepCl : TColor;
begin
if (OuterRadius.X = 0)
or (OuterRadius.Y = 0)
then
raise Exception.Create(SysErrorMessage(DISP_E_OVERFLOW));
if not Assigned(bitmap)
then
begin
Bitmap := TBitmap.Create;
Bitmap.Height := trunc(2 * OuterRadius.X) + 1;
Bitmap.Width := trunc(2 * OuterRadius.Y) + 1;
end;
Bitmap.PixelFormat := pf24Bit;
LInnerRadius.X := max(InnerRadius.X, 0);
LInnerRadius.Y := max(InnerRadius.Y, 0);
LOuterEllipse := RealPoint(max(0, OuterRadius.X), max(0, OuterRadius.Y));
exzIn := 0;
exzOut := 0;
if LInnerRadius.X <> 0
then
exzIn := sqrt(sqr(LInnerRadius.X) - sqr(LInnerRadius.Y)) / LInnerRadius.X;
if LOuterEllipse.X <> 0
then
exzOut := sqrt(sqr(LOuterEllipse.X) - sqr(LOuterEllipse.Y)) / LOuterEllipse.X;
for y := 0
to Center.Y
do
begin
PixelsTop := Bitmap.ScanLine[y];
if (2 * Center.Y - Y < Bitmap.Height)
and (y <> Center.Y)
then
PixelsBottom := Bitmap.ScanLine[(2 * Center.Y) - Y - 1]
else
PixelsBottom :=
nil;
YSquare := sqr(Center.Y - Y);
for x := 0
to Bitmap.Width - 1
do
if (Region = 0)
or PtInRegion(Region, X, Y)
or (Assigned(PixelsBottom)
and (
(Region = 0)
or PtInRegion(Region, X, (2 * Center.Y) - Y - 1)))
then
begin
XSquare := sqr(X - Center.X);
lABSVector := sqrt(XSquare + YSquare);
if lABSVector <> 0
then
begin
if not (X = Center.X)
then
angle := arctan2(Center.Y - Y, X - Center.X)
else
angle := sign(Center.Y - Y) * pi / 2;
if LOuterEllipse.X <> LOuterEllipse.Y
then
lOuterEllipseRad := LOuterEllipse.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
else
lOuterEllipseRad := LOuterEllipse.X;
if LInnerRadius.X <> LInnerRadius.Y
then
lInnerRad := LInnerRadius.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
else
lInnerRad := LInnerRadius.X;
end;
if ((lOuterEllipseRad - lInnerRad) <> 0)
and (lABSVector <> 0)
then
begin
StepCl := ColorsBetween(Colors,
min(1,
abs(lABSVector - lInnerRad) /
abs(lOuterEllipseRad - lInnerRad)));
end
else
if lABSVector = 0
then
StepCl := Colors[0]
else
StepCl := ColorsBetween(Colors,1);
if (Region = 0)
or PtInRegion(Region, X, Y)
then
begin
PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
PixelsTop^[x].rgbtRed := GetRValue(StepCl);
end;
if Assigned(PixelsBottom)
and (
(Region = 0)
or PtInRegion(Region, X, (2 * Center.Y) - Y - 1))
then
begin
PixelsBottom^[x].rgbtBlue := GetBValue(StepCl);
PixelsBottom^[x].rgbtGreen := GetGValue(StepCl);
PixelsBottom^[x].rgbtRed := GetRValue(StepCl);
end;
end;
end;
for y := max(0, 2 * Center.Y)
to Bitmap.Height - 1
do
begin
PixelsTop := Bitmap.ScanLine[y];
YSquare := sqr(Center.Y - Y);
for x := 0
to Bitmap.Width - 1
do
if (Region = 0)
or PtInRegion(Region, X, Y)
then
begin
XSquare := sqr(X - Center.X);
lABSVector := sqrt(XSquare + YSquare);
if lABSVector <> 0
then
begin
if not (X = Center.X)
then
angle := arctan2(Center.Y - Y, X - Center.X)
else
angle := sign(Center.Y - Y) * pi / 2;
if LOuterEllipse.X <> LOuterEllipse.Y
then
lOuterEllipseRad := LOuterEllipse.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
else
lOuterEllipseRad := LOuterEllipse.X;
if LInnerRadius.X <> LInnerRadius.Y
then
lInnerRad := LInnerRadius.Y / (sqrt(1 - sqr(exzOut * cos(angle))))
else
lInnerRad := LInnerRadius.X;
end;
if ((lOuterEllipseRad - lInnerRad) <> 0)
and (lABSVector <> 0)
then
begin
StepCl := ColorsBetween(Colors,
min(1,
abs(lABSVector - lInnerRad) /
abs(lOuterEllipseRad - lInnerRad)));
end
else
if lABSVector = 0
then
StepCl := Colors[0]
else
StepCl := ColorsBetween(Colors,1);
if (Region = 0)
or PtInRegion(Region, X, Y)
then
begin
PixelsTop^[x].rgbtBlue := GetBValue(StepCl);
PixelsTop^[x].rgbtGreen := GetGValue(StepCl);
PixelsTop^[x].rgbtRed := GetRValue(StepCl);
end;
end;
end;
end;