Interpolation

GTA-Place · Verfasst: So 18.06.06 17:21

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.

markieren

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

markieren

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

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)

BenBE · Verfasst: 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

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

GTA-Place · Verfasst: So 18.06.06 17:56

BenBE 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.

BenBE 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.

BenBE 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 ^^).

BenBE hat folgendes geschrieben:

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

Da kümmert sich dann Seth drum ^^.

BenBE hat folgendes geschrieben:

Ansonsten nicht schlecht

Danke.

_________________
"Wer Ego-Shooter Killerspiele nennt, muss konsequenterweise jeden Horrorstreifen als Killerfilm bezeichnen." (Zeit.de)

F34r0fTh3D4rk · Verfasst: 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 · Verfasst: 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:

markieren

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:

markieren

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 · Verfasst: Do 17.08.06 20:01

GTA-Place hat folgendes geschrieben:

BenBE 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.

markieren

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.

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

F34r0fTh3D4rk · Verfasst: 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 · Verfasst: Sa 06.01.07 20:43

hier erstmal der code mit toleranz, welche in prozent angegeben wird:

markieren

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;

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme