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

[Matze]

Hallo,

ich habe eine Grafik, die viele bunte Linien enthält, die sich schneiden und beliebige Formen haben können. Leider sind die Linien nur einen Pixel breit und wenn ich das ausdrucke, kann man nur ahnen, dass da eine Linie sein könnte.

Gibt es die Möglichkeit diese Linien mit einem Tool zu verdicken?

Grüße, Matze

[turboPASCAL]

Villeicht das Teil Vektorisieren ?

An sonsten bleibt nicht viel übrig, zB. "Resize".

[Matze]

Resize? Das Bild ist groß genug. ;)

Hm, dann muss ich mir was anderes überlegen, wie ich das ausdrucken könnte ...

[himitsu]

Gibt es eine Einheitliche Hintergrundfarbe?

Wenn ja, dann entweder jedes Pixel, welches nicht dem Hintergrund entspricht, in ein neues Bild übertragen und dort als etwas größeren Kreis zeichen.

Wenn es dabei auch rchteckig sein darf, ginge auch einfach

Delphi-Quellcode:

BildNew.Width := Bild.Width + B;
BildNew.Height := Bild.Height + B;
For x := 0 to B - 1 do
  For y := 0 to B - 1 do
    BildNew.DrawTransparent(Bild, x, y);

B wäre der Faktor, um welchen die Pixel vergrößert würden.
du kannst natürlich X und Y so beeinflußen, daß es einen Kreis einfügt :angel2:


Einziges Problem sind Farbübergänge, welche eigentlich bei den Schnittpunkten von Linien entstehen sollten ... hier ist es ja mehr so, daß es mehr kantig überlappende Kreuzungen ergibt.

[Matze]

Ja es gibt eine einheitliche Hintergrundfarbe. Ich könnte schon versuchen, selbst etwas zu basteln, wenn es nicht anders geht.

Edit [21:18]: ich habe nun was gebastelt.

[turboPASCAL]

Passt doch. ;)

PS.: der Name "linienfettierer" ist :thumb:

[Matze]

Schöner wäre es natürlich, wenn ich die Farben nacheinander übermalen würde. Dann würden diese Farbverkuddelungen nicht passieren und sich die Linien sauber überlagern.
Aber das ist dann doch etwas zu aufwändig. ;)

[DP-Maintenance]

Dieses Thema wurde von "Matze" von "Klatsch und Tratsch" nach "Multimedia" verschoben.
Mittlerweile eher Multimedia mit K&T-Anteil. *g*

[himitsu]

Delphi-Quellcode:

procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
var
  x, y, x2, y2, x3, y3, R, G, B, P: Integer;
  C: TColor;
  Temp: TBitmap;
  Mask: Array of Array of Boolean;
begin
  SetLength(Mask, Size, Size);
  for x := 0 to Size - 1 do
    for y := 0 to Size - 1 do
      Mask[x, y] := True;//(x - Size div 2)
  Temp := TBitmap.Create;
  try
    Temp.Width := Image.Width + Size - 1;
    Temp.Height := Image.Height + Size - 1;
    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;
        for x2 := 0 to Size - 1 do
        begin
          x3 := x - Size div 2 + x2;
          if (x3 >= 0) and (x3 < Image.Width) then
            for y2 := 0 to Size - 1 do
            begin
              y3 := y - Size div 2 + 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;

[Matze]

:shock: Sehr übersichtlich. :mrgreen:
Da lohnt sich vermutlich auch, das mit ScanLine (tolle, neue OH-Tags) zu lösen.

Vielen Dank, das sehe ich mir morgen mal genauer an.

[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

[Teekeks]

@himi: Deine Version von gestern um 22:24 hat bei mir ca. 20min gebraucht um zu rechnen bei einem 250x360px-Bild... Ist das normal?? ^^
Ich probiere aber auch mal deine neuste version aus...
Wobei ich die alte version etwas abgewandelt hatte, da es bei mir irgentwie keine funktion rgb und auch kein getrvalue... gab (Lazarus/Linux)

Delphi-Quellcode:

procedure LinienFettierer(Image: TBitmap; Background: TColor; Size: Integer);
var
  x, y, x2, y2, x3, y3, R, G, B, P: Integer;
  C: TColor;
  Temp: TBitmap;
  Mask: Array of Array of Boolean;
begin
  SetLength(Mask, Size, Size);
  for x := 0 to Size - 1 do
    for y := 0 to Size - 1 do
      Mask[x, y] := True;//(x - Size div 2)
  Temp := TBitmap.Create;
  try
    Temp.Width := Image.Width + Size - 1;
    Temp.Height := Image.Height + Size - 1;
    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;
        for x2 := 0 to Size - 1 do
        begin
          x3 := x - Size div 2 + x2;
          if (x3 >= 0) and (x3 < Image.Width) then
            for y2 := 0 to Size - 1 do
            begin
              y3 := y - Size div 2 + 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, integer(C));
                  Inc(G, integer(C shr 8));
                  Inc(B, integer(C shr 16));
                  Inc(P);
                end;
              end;
            end;
        end;
        if P <> 0 then
          Temp.Canvas.Pixels[x, y] := Word(integer(R div P)+integer((G shr 8) div P)+integer((B shr 16) div P))//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;

Aber wiegesagt versuche ich nochmal alles zu verstehen und das vor allem bei der neueren version...

[hadschi92]

Dass es so langsam ist liegt an der Funktion Canvas.Pixels, diese ist sehr sehr langsam. Wenn du sie durch Scanline ersetzt ist die Funktion viel schneller. Wie oben gesagt von 45 Sekunden auf weniger als eine.

[Matze]

Du bist ein Schatz himi. :kiss: :mrgreen:

Das funktioniert bei mir einwandfrei!

PS: Nun verstehe ich auch, wieso so oft nach einer Komplettlösung gefragt wird.

[Teekeks]

Ich habe gerade einen WTF-Effekt:
Wozu das:

Delphi-Quellcode:

TScanArray = packed Array[0..0] of TRGBA;

[himitsu]

Zitat:

Zitat von Teekeks

Wozu das:

Was davon?

Der Record war zur einfachen Umrechnung/Zerlegung der Farbanteile



Und Array[0..0] ist ein Sonderfall
hier wird von Delphi keine Index-Prüfung gemacht, also es entspricht sozusagen einem Array[0..{unbekannt}] und man muß so keinen Maximalwert angeben ... es kann also nicht passieren, daß hier mal eine ERangeError (Exception) geworfen wird.

Ich weiß ja nicht wie groß die Bilder sind und eh ich mir ausversehn einen zu kleinen Maxiamlwert festlege oder "mühsam" den maximal möglichen Wert berechne ...

*rechne*
Array[0..$1FFFFFFE] dürfte auch gehn und größer geht es eh nicht (die 2 GB-Grenze wäre dann erreicht)

[Medium]

Zitat:

Zitat von Matze

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

In Code gegossen dürfte es weniger tief verschachtelt, und sogar etwas kürzer als die aktuelle Version ausfallen ;). Das Ergebnis wird allerdings bei steigender Dicke dem von Himi immer unähnlicher.

Was mir aber auch noch gerade einfiel ist die Hough-Transformation! Grob gesagt kannst du damit aus so einfachen Bildern recht genau die Parameter für die zugehörigen Geradengleichungen herausbekommen, und mit diesen dann sogar vektoriell ganz neu zeichnen, mit allen Freiheiten die das so bringen könnte. Also... zumindest theoretisch :D

Edit:
Das "array[0..0] of Typ" ist eine C-übliche Schreibweise für dynamische Arrays. Technisch entspricht das einem "^Typ", also einem Pointer. Der Unterschied ist nun, dass man einen Pointer mit inc() weiterschubsen müsste, bei der Schreibweise als Array übernimmt der Compiler die Pointerarithmetik und man kann hübsch mit Indizes dran gehen. Weniger hübsch ist, dass man ohne Netz und doppelten Boden über die Grenze des eigentlichen Datenbereichs hinweg flutschen kann, die Größenangabe also mehr als wichtig dabei ist.

Diese zwei Codefetzen dürften identische Wirkung haben:
1:

Delphi-Quellcode:

type
  TOpenIntArray = array[0..0] of Integer;

procedure Foo(input: array of Integer; length: Integer);
var
  a: TOpenIntArray;
  i, bar: Integer;
begin
  a := input;
  for i := 0 to length-1 do
  begin
    bar := a[i];
  end;
end;

2:

Delphi-Quellcode:

procedure Foo(input: array of Integer; length: Integer);
var
  a: PInteger;
  i, bar: Integer;
begin
  a := @input[0];
  for i := 0 to length-1 do
  begin
    bar := a^;
    inc(a);
  end;
end;

Da es in C keine offenen Arrays gibt, hat man sich mit diesem Konstrukt beholfen. Dort muss dann auch von Hand vom Speichermanager entsprechend RAM angefordert werden, und die Bereichsprüfung ist auch Handarbeit. Alles der Kram, der bei Delphi durch die Compilermagic in dynamischen Arrays halt so passiert. Und da es in Delphi prinzipiell auch anders und imho eleganter geht, sollte man dieses array[0..0] auch eher als Ergebnis einer 1:1 Übersetzung sehen, keinesfalls aber als empfohlen. Es ist eigentlich ein überholtes Relikt.

In diesem Fall hier ist es auch kein 2GB großes Array :shock:. Die Deklaration so einer Variable belegt an sich erstmal genau eine Registerbreite Speicher - es ist nur ein Pointer. Der wird hier dann auf den Speicherbereich des ersten (bzw. eigentlich letzten) Pixels gebogen, so dass man durch Weiterrücken pixelweise über diesen Buffer läuft. Es ist nur ein popeliger Pointer, der etwas "lustig" hingeschrieben ist damit man indizierten Zugriff ohne Handarbeit haben kann - bzw. weil irgend jemand mal C Code so nach Delphi übersetzt hat, und es Schule gemacht hat =)
Man könnte genauso gut ein "echtes" dynamisches Delphi-Array nehmen, und es mit etwas trickserei genau auf den selben Bereich zeigen lassen. Die Verwendung wäre identisch, und man fordert auch nie selbst nochmal Speicher dafür an (kein SetLength in diesem Fall). Der ist schon da, im Bitmap.

[himitsu]

So, hier nun die Resultate gemixt in einem Programm

#org ErstelleBild
#4 LinienFettiererKopieren
#14 LinienFettiererMix

#20 LinienFettiererDirekt [clRed, clGreen, clBlack]
#20 LinienFettiererDirekt [clBlack, clGreen, clRed]
#18 LinienFettiererDirekt []

#14 LinienFettiererMix + #18 LinienFettiererDirekt []


falls noch jemand einen Algo hat ... einfach her damit

[add]
ach ja, das Programm versucht erstmal eine "LinienFettierer.bmp" im Programmverzeichnis zu laden,
also falls wer mal ein anderes Bildchen ausprobieren will

und ich hab grad gemerkt, daß mehrere Funktionen nacheinander auch witzig sind
(ganz unten das einzelne Bildchen)

[Medium]

Schaut sau-nice aus :thumb: Hätte anfangs nicht gedacht, dass man ohne kompliziertes Analyseglöt so gute Ergebnisse kriegen kann. Sag mal, klappt das ähnlich gut bei beliebig geformten Kurven statt Linien?

[Matze]

Zitat:

Zitat von Medium

Sag mal, klappt das ähnlich gut bei beliebig geformten Kurven statt Linien?

Da der Algorithmus das Bild zeilenweise durchgeht ist die Linien- bzw. Kurvenform egal. Im 1. Beitrag habe ich "Linien" geschrieben, sehe ich gerade, doch bei mir sind alles Kurven. :angle2:

[himitsu]

die LinienFettiererMix läßt sich sogar auf Fotos loslassen :lol:

die anderen Versionen brauchen aber die Hintergrundfarbe, in welche sie sich hinein ausbreiten, sonst kommen da keine guten Ergebnisse raus, falls sich überhaupt viel ändert

[edit] ach ja, für dat Foto hab ich natürlich die nötigen Rechte
dachte halt, wenn schon Foto, dann kann ich euch auch 'ne Freude machen :angel:

[turboPASCAL]

:thumb:

Ein netter Hase. :mrgreen: