Code-Beispiel

Grafiken für die PNG-Kompression optimieren

Lizenz:	Erster Autor:	Letzte Bearbeitung:
WTFPL	Jojo	11.02.2011

Viele Webgrafiken und auch Grafiken für Spiele und ähnliche Programme liegen heute im PNG-Format vor. Auch wenn die Anzahl der Modem-Surfer wohl so langsam gegen null geht, sollte man gerade im Web auf verträgliche Dateigrößen achten. Niemand wartet freiwillig zehn Sekunden, bis eine Webseite inklusive Bilder geladen ist. Um PNG-Grafiken möglichst klein zu machen, gibt es Programme wie PNGOut, die unter anderem mit Bruteforce-Algorithmen kleinstmögliche PNG-Dateien zu erstellen versuchen. Dies geschieht in der Regel verlustfrei, das heißt das Bild wird zwar kleiner, sieht aber immer noch exakt wie das Original aus.

Offensichtlich kann man da noch mehr rausholen. Da 200kb einfach zu viel für eine Headergrafik waren, suchte ich nach möglichst unscheinbaren Möglichkeiten, TrueColor-Bilder so zu verändern, dass die PNG-Kompression kleinere Dateien erzeugen kann. Da wenige häufig auftretende Werte sich besser komprimieren lassen als viele selten auftretende Werte, wählte ich den Ansatz, die Least Significant Bits der RGB-Kanäle einfach wegzustreichen. Bei vielen Grafiken ist der Unterschied - sechs statt acht Bit pro Farbkanal in meinem Fall - überhaupt nicht offensichtlich. Das merkt man eigentlich nur bei extrem sanften Farbverläufen. Trotzdem konnte ich im Beispielfall die Dateigröße auf 125kb drücken - ordentlich!

Lange Rede, kurzer Sinn: Hier ist ein Code, der eine BMP-Datei lädt, die zwei LSBs aller Farbkanäle nullt und dann ein neues BMP rausschreibt. Die PNG-Umwandlung muss danach manuell vorgenommen werden, z.B. mit PNGOut.

' Bitte anpassen

#Define filename_in "in.bmp"

#Define filename_out "out.bmp"



Dim As UShort bmpw, bmph

Open filename_in For Binary As #1

    Get #1, 19, bmpw 'Breite des Bitmaps

    Get #1, 23, bmph 'Hoehe des Bitmaps

Close #1



ScreenRes bmpw, bmph, 32, 1, -1 ' Screen ohne grafisches Feedback erzeugen

Dim As Any Ptr img = ImageCreate(bmpw, bmph)



BLoad filename_in, img



For x As Integer = 0 To bmpw - 1

    For y As Integer = 0 To bmph - 1

        Dim As Integer pnt = Point(x, y, img)

        pnt = pnt And &HFFFCFCFC ' Bitmaske. Alphakanal bleibt vollständig erhalten (FF), Rot, Gruen und Blau werden jeweils um die untersten beiden Bits beschnitten (FC).

        PSet img, (x, y), pnt

    Next

Next



BSave filename_out, img



ImageDestroy img

Zusätzliche Informationen und Funktionen

Das Code-Beispiel wurde am 11.02.2011 von Jojo angelegt.
Die aktuellste Version wurde am 11.02.2011 von Jojo gespeichert.

Bearbeiten

Versionen

Impressum • Nutzungsbedingungen • Datenschutz

Microsoft, Windows, Windows NT, XBOX und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.