PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

LoadBMP Procedure

https://www.purebasic.fr/english/viewtopic.php?t=27255

Page 1 of 1

LoadBMP Procedure

Posted: Sun May 27, 2007 1:43 am
by hagibaba
This code will load Windows, OS/2 1.x and OS/2 2.x bitmaps. It will even load bitmaps that PB's LoadImage() and Paint won't load! I improved the algorithm for 4-bit RLE as the FreeImage code doesn't work for all 4-bit RLE bitmaps. LoadBMP() returns a DIB and LoadBMP_() returns a DDB.

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
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited