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

[himitsu]

joar, ScannLines könnte es schon etwas beschleunigen :roll:

aber ich wollt's jetzt nicht übertreiben

das Mask sollte eigentlich einen ausgemalten Kreis enthalten
und weil ich grad irgendwie mit Sinus und Cosinus 'ne Denkblokade hab, ist da nur ein "sinnloses" Quadrat drinnen :oops:

[edit]
ähhhhh ... ok, ich glaub Potenz und Wurzeln waren da eh besser, als Sinus :wall:


[edit2]
wie gesagt, irgendwie denk ich grad nicht richtig :vernupft:

hier kommt irgendwie kein richtiger Kreis raus ... eher irgendwie verdreht

Delphi-Quellcode:

for x := 0 to Size - 1 do
  for y := 0 to Size - 1 do
    Mask[x, y] := Sqrt(Sqr(x - Size div 2) * Sqr(y - Size div 2)) < Size div 2;

Code:

----------X---------
---------XXX--------
---------XXX--------
---------XXX--------
---------XXX--------
---------XXX--------
--------XXXXX-------
-------XXXXXXX------
------XXXXXXXXX-----
-XXXXXXXXXXXXXXXXXXX
XXXXXXXXXXXXXXXXXXXX
-XXXXXXXXXXXXXXXXXXX
------XXXXXXXXX-----
-------XXXXXXX------
--------XXXXX-------
---------XXX--------
---------XXX--------
---------XXX--------
---------XXX--------
---------XXX--------

nja, immerhin sieht es so jetzt eher nach Kreis aus (siehe Anhang, auch wenn die "Berechnung" bestimmt einfacher ginge)

Delphi-Quellcode:

for x := 0 to Size - 1 do
  for y := 0 to Size - 1 do
    Mask[(x + Size div 2) mod Size, (y + Size div 2) mod Size] := 
      Sqrt(Sqr(x - Size div 2) * Sqr(y - Size div 2)) >= Size div 2;

[Medium]

Das schaut dem sehr ähnlich was ich grad vorschlagen wollte. Ähnliches hab ich nämlich grad für mein anstehendes BA Projekt gebastelt, und das basiert auf der Diffusionsgleichung. Eine gute annäherung dieser erhält man einfach durch Faltung des Bildes mit diesem Kernel:

Code:

1  1  1
1 -8  1
1  1  1

Wenn man das nun etwas modifiziert, so dass es heisst:

Code:

1/N 1/N 1/N
1/N  0  1/N
1/N 1/N 1/N

mit N = Anzahl Pixel unter dem Kernel die <> Hintergrundfarbe sind, dann ergibt sich nach mehrfacher Anwendung ein Wachstumsprozess, der in "schon gewachsenen" Bereichen zudem weichzeichnet. Wenn man dann noch statt dieses einfachen Kernels einen Gausskernel so "missbraucht", ergeben sich auch hübsch gerundete Kanten :). Das Ergebnis dürfte dem von Himi recht ähnlich werden, aber evtl. hilft die formale Beschreibung dem einen oder anderen ja weiter.

[himitsu]

so, jetzt ist es rund :nerd:

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;

[himitsu]

ich übe einfach zuwenig :cry:

nja, aber schön flott isses nun ... vorher mit Pixels rund ~45 Sekunden und nun nichtmal eine :shock:

Delphi-Quellcode:

// benötigt: ein TButton (Button1) und ein TImage (Image1)

procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
type
  TRGBA = packed Record  R, G, B, A: Byte;  End;
  TScanArray = packed Array[0..0] of TRGBA;
  PScanArray = ^TScanArray;
var
  x, y, x2, y2, x3, y3, R, G, B, P: Integer;
  C: TRGBA;
  Temp: TBitmap;
  Mask: Array of Array of Boolean;
  Scan: Array of PScanArray;
  Scan2: PScanArray;
begin
  Background := ColorToRGB(Background) and $00FFFFFF;
  Temp := TBitmap.Create;
  try
    Image.PixelFormat := pf32bit;
    Temp.PixelFormat := pf32bit;
    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;
    SetLength(Scan, Size);
    for y := 0 to Temp.Height - 1 do
    begin
      {}for y2 := 0 to Size - 1 do
      {}begin
      {}  y3 := y - Size + 1 + y2;
      {}  if (y3 >= 0) and (y3 < Image.Height) then
      {}    Scan[y2] := Image.ScanLine[y3] else Scan[y2] := nil;
      {}end;
      {}Scan2 := Temp.ScanLine[y];
      for x := 0 to Temp.Width - 1 do
      begin
        R := 0;  G := 0;  B := 0;  P := 0;
        for y2 := 0 to Size - 1 do
        begin
          y3 := y - Size + 1 + y2;
          if (y3 >= 0) and (y3 < Image.Height) then
            for x2 := 0 to Size - 1 do
            begin
              x3 := x - Size + 1 + x2;
              if (x3 >= 0) and (x3 < Image.Width) and Mask[x2, y2] then
              begin
                //C := Image.Canvas.Pixels[x3, y3];
                {}C := Scan[y2][x3];
                if TColor(C) <> Background then
                begin
                  Inc(R, C.R);
                  Inc(G, C.G);
                  Inc(B, C.B);
                  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)
          {}Scan2[x] := TRGBA(RGB(R div P, G div P, B div P))
        else
          //Temp.Canvas.Pixels[x, y] := Background;
          {}Scan2[x] := TRGBA(Background);
      end;
    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, UpDown1.Position);

    Image1.Canvas.Draw(120, 0, Temp);
    Image1.Repaint;
  finally
    Temp.Free;
  end;
end;

[edit]
kleinen Fehler behoben, das Seten des Pixels war noch in der y2-Schleife drinnen, aber mußte erst danach gemacht werden (also wurde unnötiger weise öfters ausgeführt)

[Matze]

Himi, du bist echt ein Freak. Aber ich kenne das, da möchte man etwas schaffen und versucht es so lange, bis es klappt.
Mal sehen, wie ich deinen Code in mein Tool einbauen kann. Dafür herzlichen Dank. Dass du nun Scanline nutzt ist klasse. Denn meine Grafiken haben eine Auflösung von 2339 x 1654 Pixel und da macht sich das sicher positiv bemerkbar.

Deine "{}"-Kommentare sind lustig, auch wenn ich nicht verstanden habe, was der Sinn des Ganzen ist. Aber es verleiht dem Source einige nette Farbtupfer. :stupid:

Auch dir danke, Medium. Wenn ich die Zeit finde, probiere ich das auch mal aus, wobei das recht kompliziert aussieht.

Grüße, Matze

[himitsu]

Zitat:

Deine {}...

du solltest mal meine Quellcodes hier sehn :oops:

im Grunde sind das hier nur die Änderungen/Erweiterungen zu ersten "Version"
(hab mir halt wichtige Dinge markiert, welche eventuell noch geändert/überprüft werden müssen oder schon geändert wurden ... je nach Kontext, bzw. je nach Lust und Laune)

hey, ich brauchte mal 'ne Ablenkung, bevor ich von anderen Dingen zuviel abbekomm (seh nur noch hier und da PHP)

[DeddyH]

"{}" heißt wahrscheinlich "Mein Code ist so gut, den muss man nicht kommentieren" :lol: SCNR^^

[himitsu]

ach deswegen hab ich fast nie welche drin :nerd:

Gut, wenn es dir zu unscharf ist, dann eben erstmal die billige Version ohne Mittelwert, und dafür jeweils mit dem Farbwert des ersten gefundenen Pixels.

Delphi-Quellcode:

procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
type
  TRGBA = packed Record  R, G, B, A: Byte;  End;
  TScanArray = packed Array[0..0] of TRGBA;
  PScanArray = ^TScanArray;
var
  x, y, x2, y2, x3, y3, P: Integer;
  C: TRGBA;
  Temp: TBitmap;
  Mask: Array of Array of Boolean;
  Scan: Array of PScanArray;
  Scan2: PScanArray;
begin
  Background := ColorToRGB(Background) and $00FFFFFF;
  Temp := TBitmap.Create;
  try
    Image.PixelFormat := pf32bit;
    Temp.PixelFormat := pf32bit;
    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;
    SetLength(Scan, Size);
    for y := 0 to Temp.Height - 1 do
    begin
      {}for y2 := 0 to Size - 1 do
      {}begin
      {}  y3 := y - Size + 1 + y2;
      {}  if (y3 >= 0) and (y3 < Image.Height) then
      {}    Scan[y2] := Image.ScanLine[y3] else Scan[y2] := nil;
      {}end;
      {}Scan2 := Temp.ScanLine[y];
      for x := 0 to Temp.Width - 1 do
      begin
        {}Scan2[x] := TRGBA(Background);
        P := 0;
        for y2 := 0 to Size - 1 do
        begin
          y3 := y - Size + 1 + y2;
          if (y3 >= 0) and (y3 < Image.Height) then
            for x2 := 0 to Size - 1 do
            begin
              x3 := x - Size + 1 + x2;
              if (x3 >= 0) and (x3 < Image.Width) and Mask[x2, y2] then
              begin
                //C := Image.Canvas.Pixels[x3, y3];
                {}C := Scan[y2][x3];
                if TColor(C) <> Background then
                begin
                  {}Scan2[x] := TRGBA(RGB(C.R, C.G, C.B));
                  P := 1;
                  Break;
                end;
              end;
            end;
          if P <> 0 then Break;
        end;
      end;
    end;
    Image.Width := Temp.Width;
    Image.Height := Temp.Height;
    Image.Canvas.Draw(0, 0, Temp);
  finally
    Temp.Free;
  end;
end;

[himitsu]

Was auch noch recht leicht ginge ...

- man lege ein Gitter über das Bild
- nehme sich jedes Raster vor und wähle eine Farbe ... Mittelwert oder auch die häufigste Farbe
* (jeweils auch die hintergrundfarbenen Pixel ignoriert)
- und fülle dann das Rasterfeld mit dieser Farbe

(warum hier alle immer so ... äähhhhhh ... kompliziert denken müssen :lol: )

[himitsu]

ungetestet ... hier werden theoretisch zuerst je die Farben aus Colors genommen und dann das erste gefundene Pixel

Delphi-Quellcode:

procedure LinienFettierer(Image: TBitmap; Background: TColor; Colors: Array of TColor; Size: Integer);
type
  TRGBA = packed Record  R, G, B, A: Byte;  End;
  TScanArray = packed Array[0..0] of TRGBA;
  PScanArray = ^TScanArray;
var
  x, y, x2, y2, x3, y3, i: Integer;
  C: TRGBA;
  Temp: TBitmap;
  Mask: Array of Array of Boolean;
  Scan: Array of PScanArray;
  Scan2: PScanArray;
label
  break;
begin
  Background := ColorToRGB(Background) and $00FFFFFF;
  for i := 0 to High(Colors) do
    Colors[i] := ColorToRGB(Colors[i]) and $00FFFFFF;
  Temp := TBitmap.Create;
  try
    Image.PixelFormat := pf32bit;
    Temp.PixelFormat := pf32bit;
    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;
    SetLength(Scan, Size);
    for y := 0 to Temp.Height - 1 do
    begin
      for y2 := 0 to Size - 1 do
      begin
        y3 := y - Size + 1 + y2;
        if (y3 >= 0) and (y3 < Image.Height) then
          Scan[y2] := Image.ScanLine[y3] else Scan[y2] := nil;
      end;
      Scan2 := Temp.ScanLine[y];
      for x := 0 to Temp.Width - 1 do
      begin
        for i := 0 to Length(Colors) do
          for y2 := 0 to Size - 1 do
          begin
            y3 := y - Size + 1 + y2;
            if (y3 >= 0) and (y3 < Image.Height) then
              for x2 := 0 to Size - 1 do
              begin
                x3 := x - Size + 1 + x2;
                if (x3 >= 0) and (x3 < Image.Width) and Mask[x2, y2] then
                begin
                  C := Scan[y2][x3];
                  if ((i < Length(Colors)) and (TColor(C) = Colors[i]))
                     or ((i = Length(Colors)) and (TColor(C) <> Background)) then
                  begin
                    Scan2[x] := TRGBA(RGB(C.R, C.G, C.B));
                    goto break;
                  end;
                end;
              end;
          end;
        Scan2[x] := TRGBA(Background);
        break:
      end;
    end;
    Image.Width := Temp.Width;
    Image.Height := Temp.Height;
    Image.Canvas.Draw(0, 0, Temp);
  finally
    Temp.Free;
  end;
end;

[add]

Zitat:

[30.09.2009 19:22] Matze: ich würde den Farben gerne eine Priorität verpassen O:-)
[30.09.2009 19:22] Matze: also dass erst dunkelblau gemalt wird, dann hellblau, dann orange, dann rot etc
...
[30.09.2009 19:32] Matze: danke, aber laut deinem Satz hast du mich falsch verstanden
[30.09.2009 19:33] Matze: ich möchte zuerst auf dem kompletten Bild alle dunkelblauen Linien verdicken. Anschließend alle hellblauen etc
[30.09.2009 19:33] Matze: aktuell geht rot bei mir bissl unter und daher wäre es schön, wenn das am Schluss übermalt werden würde
[30.09.2009 19:33] himitsu: es werden vorrangig nacheinander die Farben des Arrays genommen und wenns nicht im Array drin ist, dann der erste fund

da wohl meine Beschreibung nicht eindeutig war