Entwickler-Ecke

Open Source Units - Interpolation


GTA-Place - So 18.06.06 17:21
Titel: Interpolation
Hallo,

Seth (F34R) und ich haben eine Prozedur zur Suche in Wikipedia INTERPOLATION eines Bildes erstellt. Die Prozedur braucht für ein 1000x1000 Pixel großes Bild etwa 2,5 Sekunden und kann selbst Bilder selbst mit weniger als 1/100 aller Pixel relativ gut darstellen.


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
 
procedure PixelInterpolate(Image: TBitmap; Color: TColor; Max: Integer = 20);
type
  PixArray = Array[1..3] of Byte;
var
  X, Y, Pol:    Integer;
  XPol, YPol:   Integer;
  Step, BPol:   Integer;
  R, G, B:      Integer;
  aBitmap:      TBitmap;
  ScanL, ScanQ: ^PixArray;
  ScanN:        ^PixArray;
begin
  Step := 0;
  BPol := 0;

  Image.PixelFormat := pf24bit;
  aBitmap := TBitmap.Create;

  with aBitmap do
  begin
    Width       := Image.Width;
    Height      := Image.Height;
    PixelFormat := Image.PixelFormat;
    Canvas.Brush.Color := Color;
  end;

  for Y := 0 to Image.Height - 1 do
  begin
    ScanL := Image.ScanLine[Y];

    for X := 0 to Image.Width - 1 do
    begin
      if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) = Color then
        inc(BPol);

      inc(ScanL);
    end;
  end;

  while (BPol <> 0) AND (Step < Max + 1) do
  begin
    with aBitmap do
      Canvas.Rectangle(0, 0, Width, Height);

    for Y := 0 to Image.Height - 1 do
    begin
      ScanL := Image.ScanLine[Y];
      ScanN := aBitmap.ScanLine[Y];

      for X := 0 to Image.Width - 1 do
      begin
        if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) = Color then
        begin
          R   := 0;
          G   := 0;
          B   := 0;
          Pol := 0;

          for YPol := (Y - 2) to (Y + 2) do
            if (YPol > -1) and (YPol < Image.Height) then
            begin
              ScanQ := Image.ScanLine[YPol];
              inc(ScanQ, X - 2);

              for XPol := (X - 2) to (X + 2) do
              begin
                if (XPol > -1) AND (XPol < Image.Width) then
                begin
                  if ABS(RGB(ScanQ^[3], ScanQ^[2], ScanQ^[1])) <> Color then
                  begin
                    R := R + ScanQ^[3];
                    G := G + ScanQ^[2];
                    B := B + ScanQ^[1];

                    inc(Pol);
                  end;
                end;

                inc(ScanQ);
              end;
            end;

          if Pol > 0 then
          begin
            ScanN^[3] := R div Pol;
            ScanN^[2] := G div Pol;
            ScanN^[1] := B div Pol;

            dec(BPol);
          end;
        end;

        inc(ScanL);
        inc(ScanN);
      end;
    end;

    for Y := 0 to Image.Height - 1 do
    begin
      ScanL := aBitmap.ScanLine[Y];
      ScanQ := Image.ScanLine[Y];

      for X := 0 to Image.Width - 1 do
      begin
        if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) <> Color then
          for XPol := 1 to 3 do
            ScanQ^[XPol] := ScanL^[XPol];

        inc(ScanL);
        inc(ScanQ);
      end;
    end;

    inc(Step);
  end;
end;


Aufzurufen mit

Delphi-Quelltext 
1:
2:
 
PixelInterpolation(Image1.Picture.Bitmap, clBlack);    // oder
PixelInterpolation(Image1.Picture.Bitmap, clBlack, 10);


Hier ein Beispiel:



Voher:
user defined image

Nacher (Laufzeit: 300ms):
user defined image

Aus einem kaum erkennbaren Bild wurde ein relativ gutes Bild.


Feedback und Verbesserungswünsche erwünscht.

Gruß
GTA-Place und Seth


BenBE - So 18.06.06 17:39
Also allgemein zum Source soviel:

1. Ihr solltet 32-bit Pixelformate nutzen, da ihr dann immer Aligned-Zugriffe auf den RAM habt. Außerdem sind dann einige Vergleiche einfacher ...

2. Bei dem Vergleich mit dem Color solltet Ihr abprüfen, dass ihr einen gültigen RGB-Farbcode bekommen habt. ansonsten findet er nämlich keine Pixel, wenn man clWindow als Lückenfarbe übergibt ...

3. Die FOR-Schleifen ab Zeile 27 sollte man noch ein wenig optimieren und vieles mehr inlinen ...

4. Die Kantenglättung zwischen interpolierten Bereichen sollte noch etwas verbessert werden ...

Ansonsten nicht schlecht :P


GTA-Place - So 18.06.06 17:56
user profile iconBenBE hat folgendes geschrieben:
1. Ihr solltet 32-bit Pixelformate nutzen, da ihr dann immer Aligned-Zugriffe auf den RAM habt. Außerdem sind dann einige Vergleiche einfacher ...

Laut einem Tutorial von DSDT ist 24-bit das beste, deshalb haben wir 24-bit genommen.

user profile iconBenBE hat folgendes geschrieben:
2. Bei dem Vergleich mit dem Color solltet Ihr abprüfen, dass ihr einen gültigen RGB-Farbcode bekommen habt. ansonsten findet er nämlich keine Pixel, wenn man clWindow als Lückenfarbe übergibt ...

Verstehe ich nicht ganz. Ich übergebe doch auch clBlack und es wird gefunden.

user profile iconBenBE hat folgendes geschrieben:
3. Die FOR-Schleifen ab Zeile 27 sollte man noch ein wenig optimieren und vieles mehr inlinen ...

Kann ich mal gucken, was sich machen lässt (mein Spezialgebiet ^^).

user profile iconBenBE hat folgendes geschrieben:
4. Die Kantenglättung zwischen interpolierten Bereichen sollte noch etwas verbessert werden ...

Da kümmert sich dann Seth drum ^^.

user profile iconBenBE hat folgendes geschrieben:
Ansonsten nicht schlecht :P

Danke.


F34r0fTh3D4rk - So 18.06.06 18:39
auf kleinere bilder kann man wunderbar ein pixel filter anwenden um das ganze photorealistischer zu machen, unser erstes verfahren (über quadrate) ist (wenn es optimiert ist) sicherlich um einiges schneller, die qualität lässt dann aber zu wünschen übrig (ist aber auch garnet mal übel).

Die "Glättung" könnte man vielleicht nachträglich vornehmen indem man starke abstufungen analysiert und korrigiert, oder man bezieht einen größeren pixelbereich mit ein, was aber wieder der genauigkeit schaded.

Bisher bin ich mit dem Algo sehr zufrieden, GTA-Place hat ihn schon drastisch optimiert.

naja ich werde dann mal nach einer guten glättungsmethode schauen ;)


F34r0fTh3D4rk - Di 15.08.06 14:46
ich hab das mal auf Rects umgestellt, ich weiß net, ob es so funzt, wie es soll, bitt testen:


Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
 
procedure PixelInterpolate(Image: TBitmap; Color: TColor; Rect: TRect; Max: Integer = 20);
type
  PixArray = Array[1..3] of Byte;
var
  X, Y, Pol:    Integer;
  XPol, YPol:   Integer;
  Step, BPol:   Integer;
  R, G, B:      Integer;
  aBitmap:      TBitmap;
  ScanL, ScanQ: ^PixArray;
  ScanN:        ^PixArray;
begin
  Step := 0;
  BPol := 0;

  Image.PixelFormat := pf24bit;
  aBitmap := TBitmap.Create;

  with aBitmap do
  begin
    Width       := Image.Width;
    Height      := Image.Height;
    PixelFormat := Image.PixelFormat;
    Canvas.Brush.Color := Color;
    Canvas.Pen.Color := Color;
  end;

  for Y := Rect.Top to Rect.Bottom - 1 do
  begin
    ScanL := Image.ScanLine[Y];

    for X := Rect.Left to Rect.Right - 1 do
    begin
      if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) = Color then
        inc(BPol);

      inc(ScanL);
    end;
  end;

  while (BPol <> 0) AND (Step < Max + 1) do
  begin
    with aBitmap.Canvas do
      Rectangle(0, 0, aBitmap.Width, aBitmap.Height);

    for Y := Rect.Top to rect.Bottom - 1 do
    begin
      ScanL := Image.ScanLine[Y];
      ScanN := aBitmap.ScanLine[Y];

      for X := Rect.Left to Rect.Right - 1 do
      begin
        if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) = Color then
        begin
          R   := 0;
          G   := 0;
          B   := 0;
          Pol := 0;

          for YPol := (Y - 2) to (Y + 2) do
            if (YPol >= Rect.Top) and (YPol <= Rect.Bottom - 1) then
            begin
              ScanQ := Image.ScanLine[YPol];
              inc(ScanQ, X - 2);

              for XPol := (X - 2) to (X + 2) do
              begin
                if (XPol >= Rect.Left) AND (XPol <= Rect.Right - 1) then
                begin
                  if ABS(RGB(ScanQ^[3], ScanQ^[2], ScanQ^[1])) <> Color then
                  begin
                    R := R + ScanQ^[3];
                    G := G + ScanQ^[2];
                    B := B + ScanQ^[1];

                    inc(Pol);
                  end;
                end;

                inc(ScanQ);
              end;
            end;

          if Pol > 0 then
          begin
            ScanN^[3] := R div Pol;
            ScanN^[2] := G div Pol;
            ScanN^[1] := B div Pol;

            dec(BPol);
          end;
        end;

        inc(ScanL);
        inc(ScanN);
      end;
    end;

    for Y := Rect.Top to Rect.Bottom - 1 do
    begin
      ScanL := aBitmap.ScanLine[Y];
      ScanQ := Image.ScanLine[Y];

      for X := Rect.Left to Rect.Right - 1 do
      begin
        if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) <> Color then
          for XPol := 1 to 3 do
            ScanQ^[XPol] := ScanL^[XPol];

        inc(ScanL);
        inc(ScanQ);
      end;
    end;

    inc(Step);
  end;
end;


ich bastle gerade an einer testumgebung, toleranz werde ich als nächstes einbauen ;)


Leider wird der Interpolierte Teil am Linken Rand angezeigt, was ist falsch ?


EDIT: so scheint es zu gehen:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
 
    for Y := Rect.Top to Rect.Bottom - 1 do
    begin
      ScanL := aBitmap.ScanLine[Y];
      ScanQ := Image.ScanLine[Y];

      for X := Rect.Left to Rect.Right - 1 do
      begin
        if ABS(RGB(ScanL^[3], ScanL^[2], ScanL^[1])) <> Color then
          for XPol := 1 to 3 do
            ScanQ^[XPol + Rect.Left * 3] := ScanL^[XPol];

        inc(ScanL);
        inc(ScanQ);
      end;
    end;


EDIT2: Nein das stimmt auch net ganz :'(


BenBE - Do 17.08.06 20:01
user profile iconGTA-Place hat folgendes geschrieben:
user profile iconBenBE hat folgendes geschrieben:
2. Bei dem Vergleich mit dem Color solltet Ihr abprüfen, dass ihr einen gültigen RGB-Farbcode bekommen habt. ansonsten findet er nämlich keine Pixel, wenn man clWindow als Lückenfarbe übergibt ...

Verstehe ich nicht ganz. Ich übergebe doch auch clBlack und es wird gefunden.


Delphi-Quelltext 
1:
 
clWindow = DWORD($80000000 + COLOR_WINDOW);

D.h. clWindow hat, wenn es als Lückenfarbe genutzt werden sollte, keine gleichbleibenden Farbwerte, sondern einen symbolischen Farbwert, der erst mit ColorToRGB in einen RGB-Farbwert umgewandelt werden sollten.


F34r0fTh3D4rk - Do 17.08.06 20:08
es kommt eh noch eine toleranz rein und dann vielleicht auch ein typ TRGB als record oder so, ist besser als TColor ^^


F34r0fTh3D4rk - Sa 06.01.07 20:43
hier erstmal der code mit toleranz, welche in prozent angegeben wird:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
 
procedure FastPixelInterpolate(Image: TBitmap; Color: TColor; tolerance: integer; Maximum: Integer = 20);
  function ColorDifference(R1, G1, B1: byte; col2: TColor): integer;
  var
    R2, G2, B2,
    RD, GD, BD: byte;
  begin
    R2 := getrvalue(col2);
    G2 := getgvalue(col2);
    B2 := getbvalue(col2);
    RD := round(abs(r1 - r2) / 2.55); GD := round(abs(g1 - g2) / 2.55); BD := round(abs(b1 - b2) / 2.55);
    result := round(0.3 * rd + 0.59 * gd + 0.11 * bd);
  end;
type
  PixArray = Array[1..3] of Byte;
var
  X, Y, Pol:    Integer;
  XPol, YPol:   Integer;
  Step, BPol:   Integer;
  R, G, B:      Integer;
  aBitmap:      TBitmap;
  ScanL, ScanQ: ^PixArray;
  ScanN:        ^PixArray;
begin
  Step := 0;
  BPol := 0;

  Image.PixelFormat := pf24bit;
  aBitmap := TBitmap.Create;

  with aBitmap do
  begin
    Width       := Image.Width;
    Height      := Image.Height;
    PixelFormat := Image.PixelFormat;
    Canvas.Brush.Color := Color;
  end;

  for Y := 0 to Image.Height - 1 do
  begin
    ScanL := Image.ScanLine[Y];

    for X := 0 to Image.Width - 1 do
    begin
      if ColorDifference(ScanL^[3], ScanL^[2], ScanL^[1], Color) <= tolerance then
        inc(BPol);

      inc(ScanL);
    end;
  end;

  while (BPol <> 0) AND (Step < Maximum + 1) do
  begin
    with aBitmap do
      Canvas.Rectangle(0, 0, Width, Height);

    for Y := 0 to Image.Height - 1 do
    begin
      ScanL := Image.ScanLine[Y];
      ScanN := aBitmap.ScanLine[Y];

      for X := 0 to Image.Width - 1 do
      begin
        if ColorDifference(ScanL^[3], ScanL^[2], ScanL^[1], Color) <= tolerance then
        begin
          R   := 0;
          G   := 0;
          B   := 0;
          Pol := 0;

          for YPol := (Y - 2) to (Y + 2) do
            if (YPol > -1) and (YPol < Image.Height) then
            begin
              ScanQ := Image.ScanLine[YPol];
              inc(ScanQ, X - 2);

              for XPol := (X - 2) to (X + 2) do
              begin
                if (XPol > -1) AND (XPol < Image.Width) then
                begin
                  if ColorDifference(ScanQ^[3], ScanQ^[2], ScanQ^[1], Color) > tolerance then
                  begin
                    R := R + ScanQ^[3];
                    G := G + ScanQ^[2];
                    B := B + ScanQ^[1];

                    inc(Pol);
                  end;
                end;

                inc(ScanQ);
              end;
            end;

          if Pol > 0 then
          begin
            ScanN^[3] := R div Pol;
            ScanN^[2] := G div Pol;
            ScanN^[1] := B div Pol;

            dec(BPol);
          end;
        end;

        inc(ScanL);
        inc(ScanN);
      end;
    end;

    for Y := 0 to Image.Height - 1 do
    begin
      ScanL := aBitmap.ScanLine[Y];
      ScanQ := Image.ScanLine[Y];

      for X := 0 to Image.Width - 1 do
      begin
        if ColorDifference(ScanL^[3], ScanL^[2], ScanL^[1], Color) > tolerance then
          for XPol := 1 to 3 do
            ScanQ^[XPol] := ScanL^[XPol];

        inc(ScanL);
        inc(ScanQ);
      end;
    end;

    inc(Step);
  end;
end;


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!