Last edited on 5 June 2007.
Code: Select all
Procedure.l LoadBMP(filename.s)
;From FreeImage source "PluginBMP.cpp"
;Loads Windows, OS/2 1.x and OS/2 2.x Bitmap files
Protected bfh.BITMAPFILEHEADER
Protected bih.BITMAPINFOHEADER
Protected *pal.RGBQUAD
Protected file.l,bhsize.l,width.l,height.l,bitcount.l
Protected compression.l,pitch.l,ncolors.l,hDIB.l,id.l,count.l
Protected sline.l,statusbyte.l,secondbyte.l,ix.l,iy.l
Protected lownibble.l,deltax.l,deltay.l,align.l
;Open file
file=ReadFile(#PB_Any,filename)
If file=0
MessageRequester("LOAD ERROR","File could not be opened")
ProcedureReturn #False
EndIf
;Read the file header
ReadData(file,bfh,SizeOf(BITMAPFILEHEADER))
;Read the info header
bhsize=ReadLong(file) ;Get the header size, can vary in OS/2 2.x
FileSeek(file,SizeOf(BITMAPFILEHEADER)) ;Seek to the info header
If bhsize=SizeOf(BITMAPCOREHEADER) ;Bitmap is OS/2 1.x
bih\biSize=ReadLong(file) ;bcSize
bih\biWidth=ReadWord(file) ;bcWidth
bih\biHeight=ReadWord(file) ;bcHeight
bih\biPlanes=ReadWord(file) ;bcPlanes
bih\biBitCount=ReadWord(file) ;bcBitCount
ElseIf bhsize>SizeOf(BITMAPINFOHEADER) ;Bitmap is OS/2 2.x
ReadData(file,bih,SizeOf(BITMAPINFOHEADER))
Else ;Bitmap is Windows or OS/2 2.x
ReadData(file,bih,bhsize)
EndIf
;Calculate some information
width=bih\biWidth
height=Abs(bih\biHeight) ;Ignore top-down bitmaps
bitcount=bih\biBitCount
compression=bih\biCompression
pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned width
ncolors=bih\biClrUsed
If bitcount<16 ;1/4/8-bit, calculate ncolors if needed
If ncolors<=0 Or ncolors>1 << bitcount
ncolors=1 << bitcount ;2/16/256 colors
EndIf
Else ;16/24/32
If ncolors=0 And compression=#BI_bitfields
ncolors=3
EndIf
EndIf
bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
;Allocate enough memory to hold the bitmap
hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*height))
If hDIB=0
CloseFile(file)
MessageRequester("LOAD ERROR","Memory allocation failed")
ProcedureReturn #False
EndIf
;Seek to the palette
FileSeek(file,SizeOf(BITMAPFILEHEADER)+bih\biSize)
;Read the palette
id=bfh\bfOffBits-SizeOf(BITMAPFILEHEADER)-bih\biSize ;Palette size
If id=ncolors*4 ;Palette uses RGBQUAD
ReadData(file,hDIB+bhsize,ncolors*4)
Else ;Palette uses RGBTRIPLE
*pal=hDIB+bhsize ;Pointer to DIB palette
For count=0 To ncolors-1
*pal\rgbBlue=ReadByte(file) ;blue
*pal\rgbGreen=ReadByte(file) ;green
*pal\rgbRed=ReadByte(file) ;red
*pal+4
Next
EndIf
;Copy the info header to the DIB
bih\biSize=SizeOf(BITMAPINFOHEADER) ;Set biSize to 40 now
If compression=#BI_RLE4 Or compression=#BI_RLE8
bih\biCompression=0 ;Reset this if we're decoding a RLE bitmap
EndIf
bih\biSizeImage=pitch*height
bih\biClrUsed=ncolors
CopyMemory(bih,hDIB,SizeOf(BITMAPINFOHEADER))
;Seek to the pixel data, this is needed because sometimes
;the palette is larger than the entries it contains predicts
If bfh\bfOffBits>0
FileSeek(file,bfh\bfOffBits)
EndIf
Select bitcount
Case 1,4,8 ;1/4/8-bit bmp
;Read the pixel data
Select compression
Case #BI_RGB ;No compression
;Read the bitmap bits, bottom-up bitmaps only
ReadData(file,hDIB+bhsize+(ncolors*4),height*pitch)
Case #BI_RLE4 ;4-bit RLE
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
ix=0
iy=0
lownibble=0 ;Reset
While iy<height ;Ignore multiple bitmaps in OS/2 2.x
statusbyte=ReadByte(file) & 255
Select statusbyte ;First byte
Case 0 ;RLE_COMMAND=0, first byte is 0
statusbyte=ReadByte(file) & 255
Select statusbyte ;Second byte, Encoded mode=0/0..2
Case 0 ;RLE_ENDOFLINE=0
ix=0
iy+1
If iy>=height : Break : EndIf
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
lownibble=0 ;Reset
Case 1 ;RLE_ENDOFBITMAP=1
Break
Case 2 ;RLE_DELTA=2
deltax=ReadByte(file) & 255 ;Read the delta values
deltay=ReadByte(file) & 255
ix+(deltax/2) ;Apply them
iy+deltay
If iy>=height : Break : EndIf
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
Default ;Absolute mode=0/3..255
count=0 ;Get high nibble first
For id=0 To statusbyte-1 ;Read non-RLE pixels
If count=0
secondbyte=ReadByte(file) & 255
align=(secondbyte & 240) >> 4
Else
align=secondbyte & 15
EndIf
If lownibble=0 ;Set high nibble
PokeB(sline+ix,(PeekB(sline+ix) & 255) | (align << 4))
Else ;Set low nibble
PokeB(sline+ix,(PeekB(sline+ix) & 255) | align)
ix+1
EndIf
count=~count & 1
lownibble=~lownibble & 1
Next
align=statusbyte % 4 ;Align run to even number of bytes
If align=1 Or align=2
secondbyte=ReadByte(file) & 255
EndIf
EndSelect
Default ;Standard RLE mode, first byte is not 0
secondbyte=ReadByte(file) & 255
count=0 ;Get high nibble first
For id=0 To statusbyte-1 ;Read RLE pixels
If count=0
align=(secondbyte & 240) >> 4
Else
align=secondbyte & 15
EndIf
If lownibble=0 ;Set high nibble
PokeB(sline+ix,(PeekB(sline+ix) & 255) | (align << 4))
Else ;Set low nibble
PokeB(sline+ix,(PeekB(sline+ix) & 255) | align)
ix+1
EndIf
count=~count & 1
lownibble=~lownibble & 1
Next
EndSelect
Wend
Case #BI_RLE8 ;8-bit RLE
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
ix=0
iy=0 ;Reset
While iy<height ;Ignore multiple bitmaps in OS/2 2.x
statusbyte=ReadByte(file) & 255
Select statusbyte ;First byte
Case 0 ;RLE_COMMAND=0, first byte is 0
statusbyte=ReadByte(file) & 255
Select statusbyte ;Second byte, Encoded mode=0/0..2
Case 0 ;RLE_ENDOFLINE=0
ix=0
iy+1
If iy>=height : Break : EndIf
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
Case 1 ;RLE_ENDOFBITMAP=1
Break
Case 2 ;RLE_DELTA=2
deltax=ReadByte(file) & 255 ;Read the delta values
deltay=ReadByte(file) & 255
ix+deltax ;Apply them
iy+deltay
If iy>=height : Break : EndIf
sline=hDIB+bhsize+(ncolors*4)+(iy*pitch) ;Get scanline
Default ;Absolute mode=0/3..255
If statusbyte<width-ix ;Make sure run is not too long
count=statusbyte
Else
count=width-ix
EndIf
For id=0 To count-1 ;Read non-RLE pixels
secondbyte=ReadByte(file) & 255
PokeB(sline+ix,secondbyte)
ix+1
Next
If statusbyte & 1=1 ;Align run to even number of bytes
secondbyte=ReadByte(file) & 255
EndIf
EndSelect
Default ;Standard RLE mode, first byte is not 0
secondbyte=ReadByte(file) & 255
If statusbyte<width-ix ;Make sure run is not too long
count=statusbyte
Else
count=width-ix
EndIf
For id=0 To count-1 ;Read RLE pixels
PokeB(sline+ix,secondbyte)
ix+1
Next
EndSelect
Wend
Default ;Not BI_RGB=0, BI_RLE4=1 or BI_RLE8=2
CloseFile(file)
FreeMemory(hDIB)
MessageRequester("LOAD ERROR","Compression type not supported")
ProcedureReturn #False
EndSelect
Case 16,24,32 ;16/24/32-bit bmp
;Read the bitmap bits
ReadData(file,hDIB+bhsize+(ncolors*4),height*pitch)
EndSelect
CloseFile(file) ;Close the file
ProcedureReturn hDIB
EndProcedure
Procedure.l LoadBMP_(filename.s)
Protected *dib.BITMAPINFOHEADER
Protected bits.l,hDC.l,hBitmap.l
*dib=LoadBMP(filename)
If *dib=0 ;Avoid errors
ProcedureReturn #False
EndIf
bits=*dib+*dib\biSize+(*dib\biClrUsed*4) ;Pointer to bits
;Create the DDB bitmap
hDC=GetDC_(#Null)
hBitmap=CreateDIBitmap_(hDC,*dib,#CBM_INIT,bits,*dib,#DIB_RGB_COLORS)
FreeMemory(*dib) ;Free the DIB
ProcedureReturn hBitmap
EndProcedure
If OpenWindow(0,0,0,640,480,"Load BMP",#PB_Window_SystemMenu | #PB_Window_ScreenCentered) And CreateGadgetList(WindowID(0))
ButtonGadget(0,10,10,80,20,"Open File")
ImageGadget(1,10,50,300,300,0,#PB_Image_Border)
EndIf
Repeat
Select WaitWindowEvent()
Case #PB_Event_Gadget
Select EventGadget()
Case 0
Pattern.s="All Supported Formats|*.bmp"
filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
If filename
hBitmap.l=LoadBMP_(filename)
SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
EndIf
EndSelect
Case #PB_Event_CloseWindow
End
EndSelect
ForEver