Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Tutorial

FBImage < - > Freeimage.dll

von RedakteurVoltaSeite 1 von 1

Ich bin kein Freund der Freeimage.dll (zu viel Ballast, wenn man nur eine PNG oder JPG - Grafik laden möchte) sie ist aber eine mächtige Lib, wenn man sie sich näher ansieht.
Dazu hat FreeImage eine sehr gute Doku (FreeImagexxx.pdf), die ich nur jedem, der damit arbeiten möchte, empfehlen kann.

Wenn man mit Freeimage unter Freebasic arbeitet, geht es meist darum, ein Bild in ein FBImage zu bekommen oder aus einem FBImage in eine FIBitmap zu übertragen. Ab der FBVersion 0.17 hat sich nicht nur der FBImageHeader geändert, auch wurde die Zeilenbreite im FBImage auf ein Mehrfaches von 16 Byte festgelegt. D.h. wenn ein Pixel 4 Byte (32 Bit) hat, ist die 'Breite' immer ein Mehrfaches von 4.
Diese Neuerung ist für eine flottere Bearbeitung mit moderneren Prozessoren notwendig, da diese 128 Bit (= 16 Byte = 4 Pixel) in einem Rutsch bearbeiten oder kopieren können.
Für ein 32Bit - FBImage mit 398 x 300 Pixel bedeutet dies nicht 398 * 300 * 4 = 477600 Byte sondern 480000 Byte. Die Zeilenbreite wird nicht 398 * 4 = 1592 Byte, sondern auf die nächsthöhere durch 16 teilbare Zahl (1600 Byte) erhöht.
Berücksichtigt man dies beim Kopieren nicht, werden alle Bilder, deren Breite nicht glatt durch 4 teilbar ist, sehr verzerrt dargestellt.
Etwas erleichtert wird es durch den neue FBImageHeader, da er die tatsächliche Byteanzahl der Zeile als pitch - Wert zur Verfügung stellt.

Hier habe ich zwei Funktionen geschrieben, die mit dem neuen und alten FBImageHeader zurecht kommen.

Function FBImage2FIBitmap(ByVal Image As Any Ptr) As FIBITMAP Ptr
Function FIBitmap2FBImage(ByVal Dib As FIBITMAP Ptr ) As Any Ptr

Dabei habe ich die FB - interne Kopierroutine fb_hMemCpyMMX benutzt, die mir wesentlich schneller erscheint als die crt - MemCpy.

Die Funktion Save2PCB entstand bei der Durchsicht der FreeImage393.pdf. Sie zeigt, wie einfach man mit Freeimage eine 8-bit Palette Color Bitmap in wirklich sehr guter Farbqualität zaubern kann.
Am Ende des kleinen Testprogramms wird die 256 Farben Bitmap mit der ursprünglichen 32 Bit Bitmap xor verknüpft. Das Ergebnis zeigt, wie wenig Farbverluste entstanden sind.

'FBImage2FIBitmap und FIBitmap2FBImage 12.11.2007 by Volta
#Include Once "FreeImage.bi"
Declare Sub mmxcopy Cdecl Alias "fb_hMemCpyMMX" _
         (ByVal dest As Any Ptr, ByVal src As Any Ptr, ByVal size As Integer)

Function FBImage2FIBitmap(ByVal Image As Any Ptr) As FIBITMAP Ptr
  Dim As FIBITMAP Ptr Dib
  Dim As UInteger Ptr buffer = Image 'erleichtert den Imageheader auszuwerten
  Dim As UInteger bpp, breit, hoch, pitch

  If buffer[0]=7 Then 'neuer Header
    bpp = buffer[1]   'dies sind BYTE per Pixel
    If bpp <> 4 Then Return NULL 'nur im 32-Bit Format
    breit = buffer[2] 'Anzahl Pixel (4 Byte) pro Zeile
    hoch = buffer[3]
    pitch = buffer[4] 'Anzahl Byte pro Zeile (.align 16)
    Image += 32       '+ Sizeof FBImageHeader
    Dib = FreeImage_Allocate(breit, hoch, bpp *8) 'hier Bit per Pixel angeben
    Dim As UByte Ptr FIpixel = FreeImage_GetBits(Dib)
    For i As Integer = 1 To hoch ' Die Bilddaten zeilenweise kopieren
      mmxcopy FIpixel, Image, breit * bpp
      FIpixel+= (breit * bpp)
      Image += pitch  'sonst verzerrt das Bild
    Next

  Else  'alter Header
    bpp = buffer[0] And 7  'dies sind BYTE per Pixel
    If bpp <> 4 Then Return NULL 'nur im 32-Bit Format
    breit = (buffer[0] And &Hfff8) Shr 3
    hoch = (buffer[0] And &Hffff0000) Shr 16
    Dib = FreeImage_Allocate(breit, hoch, bpp *8) 'hier Bit per Pixel angeben
    mmxcopy FreeImage_GetBits(Dib), Image +4 , breit * hoch * bpp 'Bilddaten kopieren
  End If
  FreeImage_FlipVertical(Dib) 'Bild steht sonst auf dem Kopf

  Function = Dib
End Function


Function FIBitmap2FBImage(ByVal Dib As FIBITMAP Ptr ) As Any Ptr
  Dim As UInteger bpp, breit, hoch, pitch
  FreeImage_FlipVertical(Dib) 'Bild steht sonst auf dem Kopf
  Dib = FreeImage_ConvertTo32Bits(Dib)'nur im 32-Bit Format

  breit = FreeImage_GetWidth(Dib)
  hoch = FreeImage_GetHeight(Dib)
  Dim As Any Ptr Image = ImageCreate(breit, hoch), ximage = Image
  Dim As UInteger Ptr buffer = Image 'erleichtert den Imageheader auszuwerten
  Dim As UByte Ptr FIpixel = FreeImage_GetBits(Dib)

  If buffer[0]=7 Then  'neuer Header
    bpp = buffer[1]    'dies sind BYTE per Pixel
    If bpp <> 4 Then Return NULL 'nur im 32-Bit Format
    pitch = buffer[4]  'Anzahl Byte pro Zeile (.align 16)
    ximage += 32       '+ Sizeof FBImageHeader
    For i As Integer = 1 To hoch ' Die Bilddaten zeilenweise kopieren
      mmxcopy ximage, FIpixel, breit * bpp
      FIpixel+= (breit * bpp)
      ximage += pitch  'sonst verzerrt das Bild
    Next

  Else  'alter Header
    bpp = buffer[0] And 7  'dies sind BYTE per Pixel
    If bpp <> 4 Then Return NULL 'nur im 32-Bit Format
    mmxcopy ximage +4, FIpixel,  breit * hoch * bpp 'Bilddaten kopieren
  End If
  FreeImage_Unload(Dib)
  Function = Image
End Function

'Save to 8-bit Palette Color Bitmap  10.11.2007 by Volta
Function Save2PCB(ByVal Image As Any Ptr, ByRef File As String, _
  ByVal FIFormat As Integer=0, ByVal Flag As Integer=0) As Integer

  Dim As FIBITMAP Ptr Dib = FBImage2FIBitmap(Image)

  'erst zu 24-bit Bitmap dann zu 8-bit Palette Color Bitmap umwandeln.
  Dib = FreeImage_ColorQuantize (FreeImage_ConvertTo24Bits (Dib), FIQ_NNQUANT)

  Dim As Integer Result = FreeImage_Save(FIFormat, Dib, StrPtr(File), Flag)
  FreeImage_Unload(Dib)
  Return Result
End Function

'----Testprog----------------------------------------
Screen 19,32

Dim As Any Ptr bild = ImageCreate(398,300)
BLoad "test32.bmp",bild
Put (0,0), bild
Save2PCB (bild, "test8bit.bmp", FIF_BMP) '"test8bit.png", FIF_PNG)
If bild <> 0 Then ImageDestroy bild

Sleep 2000

Dim As FIBITMAP Ptr Dib8bit = FreeImage_Load(FIF_BMP, "test8bit.bmp")
bild = FIBitmap2FBImage(Dib8bit)
FreeImage_Unload(Dib8bit)
Put (0,300), bild

Sleep 2000
Put (0,0), bild, xor
If bild <> 0 Then ImageDestroy bild

Sleep

Viel Spaß damit
Volta

 

Zusätzliche Informationen und Funktionen
  • Das Tutorial wurde am 14.11.2007 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 05.12.2008 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen