VisualBasic Durchschnittsfarbe eines Bildes ermitteln

[Verata]

Hi @ all!
Ich versuche für ein Programm die Durchschnittsfarbe eines Bildes zu bestimmen. Dabei bin ich leider auf unerwartete Probleme gestoßen. Was ich vom System her versuche ist folgendes:
Bild in Picturebox laden
Bild Pixelweise durchgehen, Long Farbwerte in RGB Werte konvertieren,
Alle R-Werte addieren, alle B-Werte addieren, Alle G -Werte addieren
R-,G- und B-Werte durch die Anzahl der Pixel teilen und das Ergebnis in Long konvertieren.

Dazu habe ich mir folgenden Code ausgedacht:

Public Function getcolor(path As String, Höhe As Long, Breite As Long, pic As PictureBox) As Long
pic.AutoSize = True
pic.ScaleMode = 3
pic.Picture = LoadPicture(path)
Dim result As Long
Dim R As Long
Dim G As Long
Dim B As Long
Dim count As Long 'nur zu Testzwecken

Dim x As Integer
Dim y As Integer

For y = 1 To Höhe
    
    For x = 1 To Breite
    R = R + (GetPixel(pic.hdc, x, y) And &HFF&)
    G = G + (GetPixel(pic.hdc, x, y) \ &H100& And &HFF&)
    B = B + (GetPixel(pic.hdc, x, y) \ &H10000 And &HFF&)
    count = count + 1 'nur zu Testzwecken
    Debug.Print R 'nur zu Testzwecken
    DoEvents
    Next x
    
Next y
result = RGB(R / (Höhe * Breite), G / (Höhe * Breite), B / (Höhe * Breite))
getcolor = result
End Function

Leider funktioniert das überhaupt nicht. Aus mir nicht ersichtlichen Gründen ist die Variable Count, die die Pixel mitzählt am Ende größer als die Höhe*Breite in Pixeln. Des Weiteren ist kommt immer Weiß heraus. Sieht jemand, wo der Fehler liegt? Hat jemand eine Idee, wie man den Code beschleunigen könnte?
mfg Verata

 

[agentdark]

Hallo,

    R = R + (GetPixel(pic.hdc, x, y) And &HFF&)
    G = R + (GetPixel(pic.hdc, x, y) \ &H100& And &HFF&)
    B = R + (GetPixel(pic.hdc, x, y) \ &H10000 And &HFF&)
    count = count + 1 'nur zu Testzwecken

Zunächst einmal, wenn ich das richtig verstehe willst du die jeweiligen Farbwerte der Pixel addieren, müsstest du dann nicht auch G = G+Wert und B = B+Wert machen?

Aus mir nicht ersichtlichen Gründen ist die Variable Count, die die Pixel mitzählt am Ende größer als die Höhe*Breite in Pixeln.

Dass der Count nicht stimmt könnt vielleicht daran liegen dass du bei x,y=0 beginnst, müsste das nicht bei 1 anfangen? Falls das so ist dann wäre dein Count momentan um [(Länge+Breite)+1] höher als er sein sollte, mal testen?

 

[Verata]

Zunächst einmal danke für deine Hilfe. Wenn ich den von dir gefundenen Fehler korrigiere meint er jedes Bild sei Rot. Um den Thread für andere lesbar zu halten werde ich den Fehler oben ausbessern. Was den count angeht ist dieser nicht um zwei, sondern bei einem Bild mit 1600*1200 um 2801 Durchläufe zu groß. Ich glaube auch, das hier die Ursache für die falsche Farbe liegt. Hat jemand eine Idee, was ich sonst noch falsch gemacht habe?
mfg Verata

 

[agentdark]

Hm hab ich wohl etwas unverständlich ausgedrückt das mit dem Count, aber das ist genau was ich meinte:

Ist um (1600+1200)+1 = 2801 zu hoch.

Teste mal bitte mit x,y = 1

(also "for y = 1 to Höhe" und "for x = 1 to Breite")

 

[Verata]

Ja, Ich habe dich falsch verstanden.
Also, das Problem mit dem falschen Count ist somit aus der Welt. Mit der Farbe hatte das leider nichts zu tun. Hast du ne Idee, warum immer Rot herauskommt?
Die Funktion liefert bei jedem Bild:
R: 255
G: 0
B: 0

mfg Verata

 

[BerniG]

Liefert denn ein einzelnes "GetPixel(pic.hdc, x, y) \ &H100& And &HFF&)" überhaupt einen korrekten Wert (für x und y halt was einsetzen)? Ich glaube du rechnest da einfach falsch. Hier http://www.programmersheaven.com/mb/VBasic/273686/273686/getpixel-rgb-value/ und hier http://www.xtremevbtalk.com/showthread.php?s=&threadid=19035 wird das bisschen anders gerechnet, probier das mal!
Außerdem würde ich die Ausgabe von GetPixel in einer Variablen cachen (und die Funktion nicht 3x aufrufen); das sollte performancemäßig etwas besser sein!

 

[agentdark]

Müsste nicht eigentlich der Syntax anders sein, also zuerst And und dann die Division?
Außerdem glaube ich dass die HEX Operation nicht stimmt.

Ich denke es müsste etwa so sein, hab das allerdings länger nicht mehr gemacht:

G = G + ((GetPixel(pic.hdc, x, y) And &HFF00&) \ &H100)
B = B + ((GetPixel(pic.hdc, x, y) And &HFF0000&) \ &H10000)

 

[Verata]

Ich habe das Problem wohl absolut falsch eingeordnet. Die GetPixelfunktion ist die Wurzel des Übles. Sie liefert immer -1 als Long Wert. Was geht denn da eurer Meinung nach schief?
mfg Verata

 

[agentdark]

Oha da fällt mir was ein...

Versuch mal anstatt "from 1 to x,y":

For y = 0 to (Höhe-1)
For x = 0 to (Breite-1)

Ich glaub das zählt von 0 bis (x-1) anstatt von 1 bis x.

Der Count ändert sich dadurch nicht, wird nur "um 1 verschoben".

Das würde auch die "-1" erklären wenn es außerhalb des Bereichs wäre.

 

[Verata]

Bei einem kleinen Experiment ist mir aufgefallen, das getpixel auch -1 zurückgibt, wenn der getpixel-Befehl durch das selbe Event ausgelöst wird, wie das laden des Bildes. In meinem Hauptprojekt zeigte das leider keine Wirkung.
mfg Verata

 

[BerniG]

Probier doch mal die Point(x,y)-Funktion (also "pic.Point(x, y)") um an die Farbe zu kommen.

Oder das Bild in ein Bitmap umwandeln und darauf operieren:

Dim bmp As Bitmap = pic.Image
Dim col As Color
...schleife...
col = bmp.GetPixel(x, y)
R=R+col.R
G=G+col.G
B=B+col.B
...

Soweit ich das nämlich in der Doku gesehen habe, hat ein Color-Objekt ja schon R,G,B und A (=Alpha)-Werte gespeichert und somit ist das selbst rechnen unnötig.
Falls das Erstellen des Bitmap so nicht gehen sollte, dann erstell das Bild doch mit
Dim bmp As New Bitmap("xyz.jpg")
,speicher das Bitmap irgendwo in ner Variable und erstelle dann die Picturebox mithilfe des Bitmap. Deiner Funktion übergibst du dann natürlich gleich das Bitmap und nicht mehr die Picturebox.

 

[Verata]

Bei pic.point tritt der selbe Fehler auf (Rückgabe ist immer -1).
mfg Verata

 

[XunnD]

-1 entspricht nach dem Zweierkomplement exakt 2 hoch n Bits - 1

Bei 32 Bits also 2 hoch 32 - 1

Also

0x100000000 - 1 =
0x0FFFFFFFFF

Was Du also als -1 interpretierst, ist Weiß (alle RGB-Komponenten sind 100%, also 255, also FF hex).

Die unteren 24 Bits entsprechen den jeweiligen Farbkomponenten R (LSB), G und B (MSB).

Mal in C:

unsigned long col = GetPixel(...) & 0xffffff;
unsigned char cr = col & 0xff;
unsigned char cg = (col >> 8)&0xff;
unsigned char cb = (col >> 16)&0xff;

So hast Du in cr, cg und cb jeweils Werte von 0 bis 255 (inkl.)



Mein Tipp daher:
-GetPixel in eine Variable X zwischenspeichern
-X mit FFFFFF hex maskieren (so umgehst Du das Vorzeichenproblem)
-aus X dann mit Bitshifting und Maskierung die Farben extrahieren

 

[Woey]

hi,

Ermittel doch mal den Fehlercode mittels GetLastError() (WinApi) -> msdn

 

[Verata]

Es gibt keinen Error, der Errorcode ist = 0. Er scheint wirklich zu glauben, die Pixel sein weiß.
mfg Verata

 

[Benston]

Kannst du uns nochmal den Code zeigen, wie du ihn aktuell benutzt?
Ansonsten würde ich dir zu C# raten für Bildmanipulation in .NET...
Durch die Möglichkeit mit unsafe Bereichen und Pointern zu arbeiten, erreichst du wesentlich höhere Geschwindigkeiten.
Die GetPixel Methode ist nicht gerade die schnellste...

 

[Verata]

Mein aktueller Code ist der folgende:

Public Function getcolor(path As String, Höhe As Long, Breite As Long, pic As PictureBox) As Long
pic.AutoSize = True
pic.ScaleMode = 3
pic.Picture = LoadPicture(path)
Dim result As Long
Dim R As Long
Dim G As Long
Dim B As Long
Dim count As Long
Dim col As Long

Dim x As Integer
Dim y As Integer

For y = 1 To Höhe
    
    For x = 1 To Breite
    col = GetPixel(pic.hdc, x, y)
    R = R + (col And &HFF&)
    G = G + ((col And &HFF00&) \ &H100)
    B = B + ((col And &HFF0000) \ &H10000)
    DoEvents
    count = count + 1
    Debug.Print "R:" & (col And &HFF&)
    Debug.Print "G:" & (col And &HFF00&) / 256
    Debug.Print "B:" & (col And &HFF0000) / 65535
    Next x
    
Next y
Debug.Print R / (Höhe * Breite)
Debug.Print G / (Höhe * Breite)
Debug.Print B / (Höhe * Breite)
Debug.Print count
result = RGB(R / (Höhe * Breite), G / (Höhe * Breite), B / (Höhe * Breite))
getcolor = result
End Function

Ich kann den Code übrigens nicht nach C# .NET portieren, da es sich erstens um ein VB6 Programm handelt und zweitens der Großteil des Programms schon fertig ist und mir nur noch diese Funktion fehlt.

mfg Veratata

 

[BerniG]

Hast du es denn mal mit der
Dim bmp As New Bitmap(path)
Methode probiert? Auf dem bmp sollte das GetPixel (siehe Code oben) dann laufen.

 

[Verata]

Gleiches Problem.
mfg Verata