procedure FillPolygonAlpha(Vertices: TVertexList; Dest: TBitmap;
Color: TColor);
type
TIntegerArray =
array of integer;
var
x,y: integer;
i,j: integer;
PixelPtr: PColor;
BasePixelPtr: PColor;
ColorPartR, ColorPartG, ColorPartB, ColorA: Byte;
Breakpoints: TIntegerArray;
function GetBreakpoints(Row: integer; XOffset: integer): TIntegerArray;
var
Pt1, Pt2: TPoint;
PtOld, PtNew: TPoint;
Count: integer;
i: integer;
procedure QuickSort(
var SortList: TIntegerArray; L, R: Integer);
var
I, J: Integer;
P, T: Integer;
begin
repeat
I := L;
J := R;
P := Sortlist[(L + R)
div 2];
repeat
while SortList[i] < P
do
Inc(I);
while SortList[j] > P
do
Dec(J);
if I <= J
then
begin
T := SortList[I];
SortList[I] := SortList[J];
SortList[J] := T;
Inc(I);
Dec(J);
end;
until I > J;
if L < J
then
QuickSort(SortList, L, J);
L := I;
until I >= R;
end;
begin
PtOld := Vertices.Last;
Count := 0;
SetLength(Result, Vertices.Count);
for i := 0
to Vertices.Count - 1
do
begin
PtNew := Vertices[i];
if PtNew.Y > PtOld.Y
then
begin
Pt1 := PtOld;
Pt2 := PtNew;
end
else
begin
Pt1 := PtNew;
Pt2 := PtOld;
end;
if ((PtNew.Y < Row) = (Row <= PtOld.Y))
and
((XOffset-Pt1.X)*(Pt2.Y-Pt1.Y) < (Pt2.X-Pt1.X)*(Row-Pt1.Y))
then
begin
Result[Count] := trunc(Pt2.X * (Row-Pt1.y) / (Pt2.Y-Pt1.Y)
+ Pt1.X * (Pt2.Y-Row) / (Pt2.Y-Pt1.Y));
inc(Count);
end;
PtOld := PtNew;
end;
SetLength(Result,Count);
if length(Result)>=1
then
Quicksort(Result,0,high(Result));
end;
begin
if Vertices.Count < 3
then exit;
Dest.PixelFormat := pf32Bit;
ColorA := Color
shr 24;
ColorPartR := Muldiv(GetRValue(Color), ColorA,255);
ColorPartG := Muldiv(GetGValue(Color), ColorA,255);
ColorPartB := Muldiv(GetBValue(Color), ColorA,255);
for y := EnsureRange(Vertices.BoundingBox.Top, 0, Dest.Height-1)
to
EnsureRange(Vertices.BoundingBox.Bottom, 0, Dest.Height-1)
do
begin
BasePixelPtr := Dest.ScanLine[y];
x := Vertices.BoundingBox.Left;
BreakPoints := GetBreakpoints(y,x-1);
i := 0;
while i <= high(Breakpoints)
do
begin
PixelPtr := BasePixelPtr;
inc(PixelPtr, EnsureRange(Breakpoints[i], 0, Dest.Width-1));
for j := EnsureRange(Breakpoints[i], 0, Dest.Width)
to
EnsureRange(Breakpoints[i+1], 0, Dest.Width-1)
do
begin
PixelPtr^ :=
ColorPartR +
Muldiv(PixelPtr^
and $00FF0000
shr 16,255-ColorA,255)
shl 16
or
ColorPartG +
Muldiv(PixelPtr^
and $0000FF00
shr 8,255-ColorA,255)
shl 8
or
ColorPartB +
Muldiv(PixelPtr^
and $000000FF,255-ColorA,255);
inc(PixelPtr);
end;
inc(i,2);
end;
end;
end;