Seite 1 von 1

BMP Manipulator/Converter

Verfasst: 01.09.2009 23:46
von cxAlex
Hier mal ein kleiner Source der BMP - Dateien konvertieren und "PB - freundlich" machen kann.

Derzeit kann der Code sämtliche BMP - Formate speichern und laden.

Das Ziel ist alle Formate nach 24 Bit zu konvertieren.

Konvertieren:
1 Bit => 24 Bit (Volle 1 Bit Unterstützung)
4 Bit RGB => 24 Bit (RLE4 - Kompression fehlt, sehr selten)
8 Bit RGB/RLE8 - Komprimiert => 24 Bit (Volle 8 Bit Unterstützung)
16 Bit RGB/Bitfields => 24 Bit (volle 16 Bit Unterstützung)
32 Bit RGB/Bitfields => 24 Bit (volle 32 Bit Unterstützung)
Umrechnen BottomUp <=> TopDown

Die Procedure BMP_MakePBFriendly() sollte die BMP so konvertieren das die BMP die derzeitigen PB - Bugs mit BMPs umgeht (gedreht dargestellt...)

Code: Alles auswählen

; ; ------------------------------------------------------------------------------------
; BMP - Manipulator
; Convertieren usw. von BMP
; Author: Alexander Aigner
; PB 4.4 +
; ------------------------------------------------------------------------------------

;EnableExplicit

Structure _RLE8Entry
  Lenght.a
  StructureUnion
    Char.a
    Action.a
  EndStructureUnion
EndStructure

Structure _BMPPixel
  Green.a
  Red.a
  Blue.a
EndStructure

Structure _BMPPixelEx Extends _BMPPixel
  Alpha.a
EndStructure

Structure _ColorTableEntry
  Entry.l[0]
EndStructure

Structure _RGBMasks
  Green.l
  Red.l
  Blue.l
EndStructure

Structure _Bitmap
  FileHeader.BITMAPFILEHEADER
  InfoHeader.BITMAPINFOHEADER
  RGBMask._RGBMasks
  *BMPData
  BMPDataSize.l
  *ColorTable._ColorTableEntry
  ColorTableSize.l
EndStructure

Prototype BMP_FilterCB(*Pixel._BMPPixel)

; Height umdrehen
Macro _BMP_Mirror24Bit(_BMP)
  *Pixel = _BMP#\BMPData + _BMP#\BMPDataSize
  *RawData = AllocateMemory(_BMP#\BMPDataSize)
  *NewPixel = *RawData
  
  Select _BMP#\InfoHeader\biCompression
    Case #BI_bitfields
      ; Nur 16/32 Bit
      
    Case #BI_RGB
      
      colsize = width*SizeOf(_BMPPixel) + pattern
      ; Zeile drehen, da passt noch was nich...
      For row = 1 To height
        *Pixel-colsize
        CopyMemory(*Pixel, *NewPixel, colsize)
        *NewPixel + colsize
      Next
      
      RtVar = #True
      
    Case #BI_RLE8, #BI_RLE4
      ; RLE ist nur mit BottomUp möglich
      
  EndSelect
EndMacro

; Bitmasken für 16/32 Bit
Procedure ShiftRightByMask(Color, Mask, DTBits = 8)
  Protected ShiftCount, Test, BitCount, BaseColor, BitsToFill
  
  If Mask = 0 : ProcedureReturn #Null : EndIf
  
  Test = $00000001
  While ShiftCount<32
    If Mask & Test
      Break
    EndIf
    Test<<1
    ShiftCount + 1
  Wend
  
  BitCount = 32
  Test = $80000000
  
  While BitCount
    If (Mask>>ShiftCount) & Test
      Break
    EndIf
    Test>>1
    BitCount-1
  Wend
  
  BaseColor = (Color & Mask)>>ShiftCount
  
  If DTBits>BitCount
    BitsToFill = DTBits-BitCount
    Repeat
      BaseColor<<1
      If BaseColor & 1
        BaseColor | 1
      EndIf
      BitsToFill-1
    Until Not BitsToFill
  ElseIf DTBits<BitCount
    BaseColor>>(BitCount-DTBits)
  EndIf
  
  ProcedureReturn BaseColor
EndProcedure

; BMP - Laden
Procedure BMP_Load(File$)
  Protected hFile, *BMP._Bitmap
  
  With *BMP
    hFile = ReadFile(#PB_Any, File$)
    If hFile
      *BMP = AllocateMemory(SizeOf(_Bitmap))
      
      ; Header laden
      ReadData(hFile, @\FileHeader, SizeOf(BITMAPFILEHEADER))
      ReadData(hFile, @\InfoHeader, SizeOf(BITMAPINFOHEADER))
      
      ; RGB - Masken laden
      If \InfoHeader\biCompression = #BI_bitfields
        ReadData(hFile, @\RGBMask, SizeOf(_RGBMasks))
      EndIf
      
      ; Farbtabelle laden
      If \InfoHeader\biClrUsed Or (\InfoHeader\biBitCount = 1) Or(\InfoHeader\biBitCount = 4) Or (\InfoHeader\biBitCount = 8) ; Farbtabelle (Bei 1, 4 oder 8 ist 0 = max)
        If Not \InfoHeader\biClrUsed ; Maximum
          \ColorTableSize = Pow(2, \InfoHeader\biBitCount)
        Else
          \ColorTableSize = \InfoHeader\biClrUsed*SizeOf(Long)
        EndIf
        \ColorTable = AllocateMemory(\ColorTableSize)
        ReadData(hFile, \ColorTable, \ColorTableSize)
      EndIf
      
      ; Rohdaten laden
      FileSeek(hFile, \FileHeader\bfOffBits)
      If \FileHeader\bfOffBits
        \BMPDataSize = Lof(hFile)-\FileHeader\bfOffBits
        \BMPData = AllocateMemory(\BMPDataSize)
        ReadData(hFile, \BMPData, \BMPDataSize)
      EndIf
      
      CloseFile(hFile)
      ProcedureReturn *BMP
    EndIf
  EndWith
EndProcedure

; BMP - Speichern
Procedure BMP_Save(*BMP._Bitmap, FileName$)
  Protected hFile
  
  With *BMP
    hFile = CreateFile(#PB_Any, FileName$)
    If hFile
      ; Header Speichern
      WriteData(hFile, @\FileHeader, SizeOf(BITMAPFILEHEADER))
      WriteData(hFile, @\InfoHeader, SizeOf(BITMAPINFOHEADER))
      
      ; RGB Masken speichern
      If \InfoHeader\biCompression = #BI_bitfields
        WriteData(hFile, @\RGBMask, SizeOf(_RGBMasks))
      EndIf
      
      ; Farbtabelle speichern
      If \ColorTable
        WriteData(hFile, \ColorTable, \ColorTableSize)
      EndIf
      
      ; Rohdaten speichern
      FileSeek(hFile, \FileHeader\bfOffBits)
      If \BMPData
        WriteData(hFile, \BMPData, \BMPDataSize)
      EndIf
      CloseFile(hFile)
      ProcedureReturn #True
    EndIf
  EndWith
EndProcedure

; Bitmapdaten kopieren
Procedure BMP_Copy(*BMP._Bitmap)
  Protected *NewBMP._Bitmap
  *NewBMP = AllocateMemory(SizeOf(_Bitmap))
  
  ; Copy BMP Data
  With *BMP
    
    ; Infos Kopieren
    CopyMemory(@\FileHeader, @*NewBMP\FileHeader, SizeOf(BITMAPFILEHEADER))
    CopyMemory(@\InfoHeader, @*NewBMP\InfoHeader, SizeOf(BITMAPINFOHEADER))
    CopyMemory(@\RGBMask, @*NewBMP\RGBMask, SizeOf(_RGBMasks))
    
    ; Farbtabelle kopieren
    If \ColorTable
      *NewBMP\ColorTable = AllocateMemory(\ColorTableSize)
      CopyMemory(\ColorTable, *NewBMP\ColorTable, \ColorTableSize)
      *NewBMP\ColorTableSize = \ColorTableSize
    EndIf
    
    ; Rohdaten kopieren
    If \BMPData
      *NewBMP\BMPDataSize = \BMPDataSize
      *NewBMP\BMPData = AllocateMemory(\BMPDataSize)
      CopyMemory(\BMPData, *NewBMP\BMPData, \BMPDataSize)
    EndIf
    
    ProcedureReturn *NewBMP
  EndWith
EndProcedure

; BMP - Freigeben
Procedure BMP_Free(*BMP._Bitmap)
  With *BMP
    If \BMPData
      FreeMemory(\BMPData)
    EndIf
    If \ColorTable
      FreeMemory(\ColorTable)
    EndIf
    FreeMemory(*BMP)
  EndWith
EndProcedure

Procedure BMP_Filter(*BMP._Bitmap, *CB.BMP_FilterCB)
  Protected *Pixel._BMPPixel, row, col, pattern, width, height, RtVar
  
  With *BMP
    Select \InfoHeader\biBitCount
      Case 1
        ; noch zu erledigen
        
      Case 4
        ; noch zu erledigen
        
      Case 8
        ; noch zu erledigen
        
      Case 16
        ; Ungebrächlich, ev. noch erledigen
        
      Case 24
        Select \InfoHeader\biCompression
          Case #BI_bitfields
            ; Nur 16/32 Bit
            
          Case #BI_RGB
            pattern = \InfoHeader\biWidth%4 ; Füllpattern
            height = \InfoHeader\biHeight
            width = \InfoHeader\biWidth
            
            *Pixel = \BMPData
            
            For row = 1 To height
              For col = 1 To width
                *CB(*Pixel)
                *Pixel + SizeOf(_BMPPixel)
              Next
              *Pixel + pattern
            Next
            
            RtVar = #True
            
          Case #BI_RLE8, #BI_RLE4
            ; Nur 4/8 Bit
            
        EndSelect
        
      Case 32
        ; Ungebrächlich, ev. noch erledigen
        
    EndSelect
  EndWith
EndProcedure

; Konvertiert auf 24 Bit
Procedure BMP_ConvertTo24Bit(*BMP._Bitmap)
  Protected *Pixel._BMPPixel, *p8Pixel, *p8PixelEntry.Character, *RawData, i, NewPixel._BMPPixelEx
  Protected pattern, height, width, row, col, RtVar, *RLE8._RLE8Entry, NewSize
  Protected *p16PixelEntry.Word, *p32PixelEntry.Long
  
  With *BMP
    
    pattern = \InfoHeader\biWidth%4 ; Füllpattern
    height = \InfoHeader\biHeight
    width = \InfoHeader\biWidth
    
    NewSize = width*height*SizeOf(_BMPPixel)
    NewSize + NewSize%4
    
    *p8PixelEntry = \BMPData
    Select \InfoHeader\biBitCount
      Case 1 ; 1 Bit
        *RawData = AllocateMemory(NewSize + SizeOf(Byte))
        *Pixel = *RawData
        
        Select \InfoHeader\biCompression
          Case #BI_RGB
            
            ; Umrechnen von 8 auf 24 Bit
            For row = 1 To height
              For col = 1 To width
                
                ; Alle Bits durchgehen
                For i = 0 To 7
                  
                  ; Pixeldaten laden
                  *p8Pixel = \ColorTable\Entry[((*p8PixelEntry\c & $80) Or #Null)]
                  
                  ; Pixeldaten speichern
                  PokeL(*Pixel, *p8Pixel)
                  *Pixel + SizeOf(_BMPPixel)
                  
                  ; Weitershiften
                  *p8PixelEntry\c<<1
                Next
                
                ; Weiterzählen
                *p8PixelEntry + SizeOf(Byte)
              Next
              
              ; Pattern
              *p8PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
        EndSelect
        
      Case 4 ; 4 Bit
        *RawData = AllocateMemory(NewSize + SizeOf(Byte))
        *Pixel = *RawData
        
        Select \InfoHeader\biCompression
          Case #BI_RGB
            
            ; Umrechnen von 8 auf 24 Bit
            For row = 1 To height
              For col = 1 To width
                
                ; 1. Wert aus der Farbtabelle holen
                *p8Pixel = \ColorTable\Entry[(*p8PixelEntry\c>>4) & $0F]
                
                ; Und 1. Teil übertragen
                PokeL(*Pixel, *p8Pixel)
                *Pixel + SizeOf(_BMPPixel)
                
                ; 2. Wert aus der Farbtabelle holen (4 Bit passen 2* in ein Byte)
                *p8Pixel = \ColorTable\Entry[*p8PixelEntry\c & $0F]
                
                ; Und 2. Teil übertragen
                PokeL(*Pixel, *p8Pixel)
                
                ; Weiterzählen
                *p8PixelEntry + SizeOf(Byte)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p8PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
          Case #BI_RLE4
            ; Noch nicht unterstützt
            
        EndSelect
        
      Case 8 ; 8 Bit
        *RawData = AllocateMemory(NewSize + SizeOf(Byte))
        *Pixel = *RawData
        
        Select \InfoHeader\biCompression
          Case #BI_RGB
            
            ; Umrechnen von 8 auf 24 Bit
            For row = 1 To height
              For col = 1 To width
                
                ; Wert aus der Farbtabelle holen
                *p8Pixel = \ColorTable\Entry[*p8PixelEntry\c]
                
                ; Und übertragen
                PokeL(*Pixel, *p8Pixel)
                
                ; Weiterzählen
                *p8PixelEntry + SizeOf(Byte)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p8PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
          Case #BI_RLE8
            ; Das wird lustig...
            ; Lauflängencodierung, so ein Unsinn...
            
            *RLE8 = *p8PixelEntry
            
            For row = 1 To height
              For col = 1 To width
                
                If *RLE8\Lenght ; Gut, einfach x mal einfügen..
                  *p8Pixel = \ColorTable\Entry[*RLE8\Char]
                  For i = 1 To *RLE8\Lenght ; Pixel n - mal eintragen
                    PokeL(*Pixel, *p8Pixel)
                    *Pixel + SizeOf(_BMPPixel)
                  Next
                Else ; Irgend eine Extrawurst...
                  Select *RLE8\Action
                    Case 0 : Break ; Ende Bildzeile
                    Case 1 : Break 2 ; Ende Bild
                    Case 2 ; Pixelverschiebung
                      *RLE8 + SizeOf(_RLE8Entry)
                      *Pixel + *RLE8\Lenght + *RLE8\Char*(width*SizeOf(_BMPPixel) + pattern) ; Muss so passen...
                    Default ; Direkt übernehmen
                      For i = 1 To *RLE8\Action
                        *p8Pixel = \ColorTable\Entry[*RLE8\Char + i]
                        PokeL(*Pixel, *p8Pixel)
                        *Pixel + SizeOf(_BMPPixel)
                      Next
                      *RLE8 + *RLE8\Action-SizeOf(_RLE8Entry)
                      
                  EndSelect
                EndIf
                *RLE8 + SizeOf(_RLE8Entry)
                
              Next
              *Pixel + pattern
            Next
            
            RtVar = #True
        EndSelect
        
      Case 16 ; 16 Bit
        *RawData = AllocateMemory(NewSize + SizeOf(Byte))
        *Pixel = *RawData
        
        *p16PixelEntry = *p8PixelEntry
        Select \InfoHeader\biCompression
          Case #BI_bitfields
            
            For row = 1 To height
              For col = 1 To width
                
                ; Wertteile lesen
                NewPixel\Red = ShiftRightByMask(*p16PixelEntry\w, \RGBMask\Red)
                NewPixel\Green = ShiftRightByMask(*p16PixelEntry\w, \RGBMask\Green)
                NewPixel\Blue = ShiftRightByMask(*p16PixelEntry\w, \RGBMask\Blue)
                NewPixel\Alpha = 255
                
                ; Eintragen
                PokeL(*Pixel, @NewPixel)
                
                *p16PixelEntry + SizeOf(Word)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p16PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
          Case #BI_RGB
            
            ; Umrechnen von 16 auf 24 Bit
            For row = 1 To height
              For col = 1 To width
                
                ; Wertteile lesen
                NewPixel\Red = ((*p16PixelEntry\w>>10) & $1F)<<3
                NewPixel\Green = ((*p16PixelEntry\w>>5) & $1F)<<3
                NewPixel\Blue = (*p16PixelEntry\w & $1F)<<3
                NewPixel\Alpha = 255
                
                ; Eintragen
                PokeL(*Pixel, @NewPixel)
                
                *p16PixelEntry + SizeOf(Word)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p16PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
        EndSelect
        
      Case 24
        ; Unnötig
        RtVar = #True
        
      Case 32
        *RawData = AllocateMemory(NewSize + SizeOf(Byte))
        *Pixel = *RawData
        
        *p32PixelEntry = *p8PixelEntry
        Select \InfoHeader\biCompression
          Case #BI_bitfields
            For row = 1 To height
              For col = 1 To width
                
                ; Wertteile lesen
                NewPixel\Red = ShiftRightByMask(*p32PixelEntry\l, \RGBMask\Red)
                NewPixel\Green = ShiftRightByMask(*p32PixelEntry\l, \RGBMask\Green)
                NewPixel\Blue = ShiftRightByMask(*p32PixelEntry\l, \RGBMask\Blue)
                NewPixel\Alpha = 255
                
                ; Eintragen
                PokeL(*Pixel, @NewPixel)
                
                *p32PixelEntry + SizeOf(Long)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p32PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
          Case #BI_RGB
            
            ; Umrechnen von 32 auf 24 Bit
            For row = 1 To height
              For col = 1 To width
                
                ; Wertteile lesen
                NewPixel\Red = *p32PixelEntry\l & $FF
                NewPixel\Green = (*p32PixelEntry\l>>8) & $FF
                NewPixel\Blue = (*p32PixelEntry\l>>16) & $FF
                NewPixel\Alpha = (*p32PixelEntry\l>>24) & $FF
                
                ; Eintragen
                PokeL(*Pixel, @NewPixel)
                
                *p32PixelEntry + SizeOf(Long)
                *Pixel + SizeOf(_BMPPixel)
              Next
              
              ; Pattern
              *p32PixelEntry + pattern
              *Pixel + pattern
            Next
            
            RtVar = #True
            
        EndSelect
        
    EndSelect
    
    If RtVar = #True And \InfoHeader\biBitCount<>24
      ; Farbtable entfernen, offset ändern
      \FileHeader\bfOffBits-\ColorTableSize
      If \ColorTable
        FreeMemory(\ColorTable)
      EndIf
      \InfoHeader\biClrUsed = #Null
      \InfoHeader\biClrImportant = #Null
      \ColorTable = #Null
      \ColorTableSize = #Null
      
      ; Daten wechseln
      FreeMemory(\BMPData)
      \BMPData = *RawData
      
      ; Neue Größe schreiben
      \BMPDataSize = NewSize
      
      \InfoHeader\biSizeImage = \BMPDataSize
      
      ; Format - Infos ändern
      \InfoHeader\biBitCount = 24
      \InfoHeader\biCompression = #BI_RGB
      
    EndIf
    
    ProcedureReturn RtVar
    
  EndWith
EndProcedure

; Änder auf TopDown
Procedure BMP_ConvertToTopDown(*BMP._Bitmap)
  Protected row, col, pattern, width, height, RtVar, colsize
  Protected *RawData, *NewPixel._BMPPixel, *Pixel._BMPPixel
  
  With *BMP
    Select \InfoHeader\biBitCount
      Case 1
        ; Noch zu erledigen
        
      Case 4
        ; Noch zu erledigen
        
      Case 8
        ; Noch zu erledigen
        
      Case 16
        ; Ungebrächlich, ev. noch erledigen
        
      Case 24
        pattern = \InfoHeader\biWidth%4 ; Füllpattern
        height = \InfoHeader\biHeight
        width = \InfoHeader\biWidth
        
        If height>0
          
          _BMP_Mirror24Bit(*BMP)
          
        EndIf
        
      Case 32
        ; Ungebrächlich, ev. noch erledigen
        
    EndSelect
    
    If RtVar = #True
      \InfoHeader\biHeight*-1
      FreeMemory(\BMPData)
      \BMPData = *RawData
    EndIf
    
    ProcedureReturn RtVar
  EndWith
EndProcedure

; Änder auf BottomUp
Procedure BMP_ConvertToBottomUp(*BMP._Bitmap)
  Protected row, col, pattern, width, height, RtVar, colsize
  Protected *RawData, *NewPixel._BMPPixel, *Pixel._BMPPixel
  
  With *BMP
    Select \InfoHeader\biBitCount
      Case 1
        ; Noch zu erledigen
        
      Case 4
        ; Noch zu erledigen
        
      Case 8
        ; Noch zu erledigen
        
      Case 16
        ; Ungebrächlich, ev. noch erledigen
        
      Case 24
        pattern = \InfoHeader\biWidth%4 ; Füllpattern
        height = \InfoHeader\biHeight
        width = \InfoHeader\biWidth
        
        If height<0
          
          _BMP_Mirror24Bit(*BMP)
          
        EndIf
        
      Case 32
        ; Ungebrächlich, ev. noch erledigen
        
    EndSelect
    
    If RtVar = #True
      \InfoHeader\biHeight*-1
      FreeMemory(\BMPData)
      \BMPData = *RawData
    EndIf
    
    ProcedureReturn RtVar
  EndWith
EndProcedure

; Macht das ganze "PB - freundlich"
Procedure BMP_MakePBFriendly(*BMP._Bitmap)
  If BMP_ConvertTo24Bit(*BMP)
    If BMP_ConvertToTopDown(*BMP) ; Hier ev. auf BottomUp ändern falls PB mirrord
      ProcedureReturn #True
    EndIf
  EndIf
EndProcedure
Gruß, Alex

Verfasst: 02.09.2009 10:16
von cxAlex
Update:
Konvertierung ALLER BMP Formate nach 24 Bit RGB (Ausnahme: 4 Bit RLE4 - Komprimiert (sehr selten).

Code siehe oben.

Gruß, Alex