Here is code for ellipse that changes alpha of A8R8G8B8 image:
procedure DrawPixelAlpha(Canvas: TImagingCanvas; X, Y: Integer; Alpha: Byte);
var
ColRec: TColor32Rec;
begin
ColRec.Color := Canvas.Pixels32[X, Y];
ColRec.A := Alpha;
Canvas.Pixels32[X, Y] := ColRec.Color;
end;
procedure DrawAlphaEllipse(Canvas: TImagingCanvas; const Rect: TRect; Alpha: Byte; Fill: Boolean);
var
RadX, RadY, DeltaX, DeltaY, R, RX, RY: LongInt;
X1, X2, Y1, Y2, Bpp, OldY, I: LongInt;
Color: PColor32Rec;
begin
X1 := Rect.Left;
X2 := Rect.Right;
Y1 := Rect.Top;
Y2 := Rect.Bottom;
SwapMin(X1, X2);
SwapMin(Y1, Y2);
RadX := (X2 - X1) div 2;
RadY := (Y2 - Y1) div 2;
Y1 := Y1 + RadY;
Y2 := Y1;
OldY := Y1;
DeltaX := (RadX * RadX);
DeltaY := (RadY * RadY);
R := RadX * RadY * RadY;
RX := R;
RY := 0;
if Fill then
begin
for I := X1 to X2 do
DrawPixelAlpha(Canvas, I, Y1, Alpha);
end;
DrawPixelAlpha(Canvas, X1, Y1, Alpha);
DrawPixelAlpha(Canvas, X2, Y1, Alpha);
while RadX > 0 do
begin
if R > 0 then
begin
Inc(Y1);
Dec(Y2);
Inc(RY, DeltaX);
Dec(R, RY);
end;
if R <= 0 then
begin
Dec(RadX);
Inc(X1);
Dec(X2);
Dec(RX, DeltaY);
Inc(R, RX);
end;
if (OldY <> Y1) and Fill then
begin
for I := X1 to X2 do
DrawPixelAlpha(Canvas, I, Y1, Alpha);
for I := X1 to X2 do
DrawPixelAlpha(Canvas, I, Y2, Alpha);
end;
OldY := Y1;
DrawPixelAlpha(Canvas, X1, Y1, Alpha);
DrawPixelAlpha(Canvas, X2, Y1, Alpha);
DrawPixelAlpha(Canvas, X1, Y2, Alpha);
DrawPixelAlpha(Canvas, X2, Y2, Alpha);
end;
end;
Here is how to use it to draw alpha ellipses and squares/rectangles (filled):
// draw ellipse
DrawAlphaEllipse(Canvas, Rect(16, 64, 240, 192), 55, True);
// draw square
for I := 128 to 255 do
for J := 128 to 255 do
DrawPixelAlpha(Canvas, I, J, 200);
Resulting image is attached to this post.