Autor |
Beitrag |
GTA-Place
Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
Verfasst: So 18.06.06 17:21
Hallo,
Seth (F34R) und ich haben eine Prozedur zur 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.
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); PixelInterpolation(Image1.Picture.Bitmap, clBlack, 10); |
Hier ein Beispiel:
Voher:
Nacher (Laufzeit: 300ms):
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)
Zuletzt bearbeitet von GTA-Place am Fr 08.01.10 00:07, insgesamt 3-mal bearbeitet
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
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
Beiträge: 5248
Erhaltene Danke: 2
WIN XP, IE 7, FF 2.0
Delphi 7, Lazarus
|
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
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
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
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
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:
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
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Do 17.08.06 20:01
_________________ 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
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
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
Beiträge: 5284
Erhaltene Danke: 27
Win Vista (32), Win 7 (64)
Eclipse, SciTE, Lazarus
|
Verfasst: Sa 06.01.07 20:43
hier erstmal der code mit toleranz, welche in prozent angegeben wird:
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; |
|
|
|