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,
sin_x, cos_x,
lInnerRad,
lOuterRad,
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));
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);
lOuterRad := sqrt(XSquare + YSquare);
if lOuterRad <> 0
then
begin
sin_x := (Center.Y - Y) / lOuterRad;
//
cos_x := (X - Center.X) / lOuterRad;
lInnerRad := sqrt(sqr(LInnerRadius.X * cos_x) + sqr(LInnerRadius.Y * sin_x));
lOuterEllipseRad := sqrt(sqr(LOuterEllipse.X * cos_x) + sqr(LOuterEllipse.Y * sin_x));
end;
// LInnerRad = Betrag(KoordUrsprung - Schnittpunkt(X,Y) mit innerer ellipse
// lOuterEllipseRad = Betrag(KoordUrsprung - Schnittpunkt(X,Y) mit äusserer ellipse
// LOuterrad = Betrag ortsvektor (X,Y)
if ((lOuterEllipseRad - lInnerRad) <> 0)
and (lOuterRad <> 0)
then
begin
StepCl := ColorsBetween(Colors,
min(1,
abs(lOuterRad - lInnerRad) /
abs(lOuterEllipseRad - lInnerRad)));
end
else
if lOuterRad = 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);
lOuterRad := sqrt(XSquare + YSquare);
if lOuterRad <> 0
then
begin
sin_x := (Center.Y - Y) / lOuterRad;
cos_x := (X - Center.X) / lOuterRad;
lInnerRad := sqrt(sqr(LInnerRadius.X * cos_x) + sqr(LInnerRadius.Y * sin_x));
lOuterEllipseRad := sqrt(sqr(LOuterEllipse.X * cos_x) + sqr(LOuterEllipse.Y * sin_x));
end;
if ((lOuterEllipseRad - lInnerRad) <> 0)
and (lOuterRad <> 0)
then
begin
StepCl := ColorsBetween(Colors,
min(1,
abs(lOuterRad - lInnerRad) /
abs(lOuterEllipseRad - lInnerRad)));
end
else
if lOuterRad = 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;