// benötigt: ein TButton (Button1) und ein TImage (Image1)
procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
var
x, y, x2, y2, x3, y3, R, G, B, P, A: Integer;
C: TColor;
Temp: TBitmap;
Mask:
Array of Array of Boolean;
begin
Temp := TBitmap.Create;
try
Temp.Width := Image.Width + Size - 1;
Temp.Height := Image.Height + Size - 1;
{}Temp.Canvas.Brush.Color := clBlack;
{}Temp.Canvas.Ellipse(0, 0, Size, Size);
{}Temp.Canvas.Pixels[Size
div 2, Size
div 2] := clBlack;
{}SetLength(Mask, Size, Size);
{}for x := 0
to Size - 1
do
{} for y := 0
to Size - 1
do
{} Mask[x, y] := Temp.Canvas.Pixels[x, y] = clBlack;
for x := 0
to Temp.Width - 1
do
for y := 0
to Temp.Height - 1
do
begin
R := 0; G := 0; B := 0; P := 0; A := Size;
for x2 := 0
to Size - 1
do
begin
x3 := x - Size + 1 + x2;
if (x3 >= 0)
and (x3 < Image.Width)
then
for y2 := 0
to Size - 1
do
begin
y3 := y - Size + 1 + y2;
if (y3 >= 0)
and (y3 < Image.Height)
and Mask[x2, y2]
then
begin
C := Image.Canvas.Pixels[x3, y3];
if C <> Background
then
begin
Inc(R, GetRValue(C));
Inc(G, GetGValue(C));
Inc(B, GetBValue(C));
Inc(P);
end;
end;
end;
end;
if P <> 0
then
Temp.Canvas.Pixels[x, y] :=
RGB(R
div P, G
div P, B
div P)
else
Temp.Canvas.Pixels[x, y] := Background;
end;
Image.Width := Temp.Width;
Image.Height := Temp.Height;
Image.Canvas.Draw(0, 0, Temp);
finally
Temp.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Temp: TBitmap;
begin
Temp := TBitmap.Create;
try
Temp.Width := 100;
Temp.Height := 100;
Temp.Canvas.Pen.Color := clBlack;
Temp.Canvas.MoveTo(0, 10);
Temp.Canvas.LineTo(80, 100);
Temp.Canvas.Pen.Color := clRed;
Temp.Canvas.MoveTo(50, 10);
Temp.Canvas.LineTo(5, 100);
Temp.Canvas.Pen.Color := clGreen;
Temp.Canvas.MoveTo(100, 45);
Temp.Canvas.LineTo(5, 80);
Image1.Canvas.Brush.Color := clBtnFace;
Image1.Canvas.FillRect(Rect(0, 0, Image1.Width, Image1.Height));
Image1.Canvas.Draw(0, 0, Temp);
LinienFettierer(Temp, clWhite, 25);
Image1.Canvas.Draw(Temp.Width + 5, 0, Temp);
finally
Temp.Free;
end;
end;