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