Bildbearbeitung: Linien verstärken, gibt's sowas?

[himitsu]

so, jetzt ist es rund

x3 und y3 (also die Pixelposition im Originalbild) wurde falsch berechnet ... hatte mich schon gewundert, warum es so verschoben aussah

Delphi-Quellcode:

// 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;