LoadPCX Procedure

hagibaba · Post by **hagibaba** » Fri Jun 01, 2007 9:35 pm

This code loads 1/4/8/24-bit RLE pcx files. I wrote this routine a few weeks ago but I have largely rewritten it. I have optimized it and tidied it up so it is a lot easier to read now. LoadPCX() returns a DIB and LoadPCX_() returns a DDB.

Last edited on 12 June 2007.

Code: Select all

;- Structures

Structure PCXHEADER
 manufacturer.b ;Magic number (10 = ZSoft pcx)
 version.b ;Version (5 = v3.0 with palette info)
 encoding.b ;Encoding (0 = uncompressed, 1 = PCX rle compressed)
 bitsperpixel.b ;Bits per pixel per plane
 xmin.w ;Left of image
 ymin.w ;Top of image
 xmax.w ;Right of image
 ymax.w ;Bottom of Image
 hdpi.w ;Horizontal resolution
 vdpi.w ;Vertical resolution
 colormap.b[48] ;Colormap for 16-color images
 reserved.b
 nplanes.b ;Number of planes (1, 3 or 4)
 bytesperline.w ;Bytes per row (always even)
 paletteinfo.w ;Palette information (1 = color or b&w, 2 = greyscale)
 hscreensize.w
 vscreensize.w
 filler.b[54] ;Reserved filler
EndStructure

Procedure.l LoadPCX(filename.s)
 ;From "PCX loader for B+" by Snarkbait
 ;Loads 1/4/8/24-bit RLE Paintbrush files
 
 Protected ph.PCXHEADER
 Protected *dib.BITMAPINFOHEADER
 Protected *pal.RGBQUAD
 Protected file.l,width.l,height.l,bitcount.l,totalbytes.l,pitch.l
 Protected bhsize.l,ncolors.l,hDIB.l,count.l,ix.l,iy.l,plane.l
 Protected byte.l,rle.l,sline.l,id.l,nibble.l
 
 ;Open the file
 file=ReadFile(#PB_Any,filename)
 If file=0
  MessageRequester("LOAD ERROR","File could not be opened")
  ProcedureReturn #False
 EndIf
 
 ;Read the pcx header
 ReadData(file,ph,SizeOf(PCXHEADER))
 
 ;Calculate some information
 width=(ph\xmax & $FFFF)-(ph\xmin & $FFFF)+1
 height=(ph\ymax & $FFFF)-(ph\ymin & $FFFF)+1
 bitcount=ph\nplanes*ph\bitsperpixel
 totalbytes=ph\nplanes*(ph\bytesperline & $FFFF) ;BYTE-aligned width
 pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned width
 bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
 If bitcount<=8 ;1/4/8-bit
  ncolors=1 << bitcount ;2/16/256 colors in DIB
 Else
  ncolors=0 ;No DIB palette
 EndIf
 
 ;Allocate the DIB
 hDIB=AllocateMemory(bhsize+(ncolors*4)+(pitch*height))
 If hDIB=0
  CloseFile(file)
  MessageRequester("LOAD ERROR","Memory allocation failed")
  ProcedureReturn #False
 EndIf
 
 ;Fill in the DIB info header
 *dib=hDIB ;Pointer to DIB
 With *dib
  \biSize=SizeOf(BITMAPINFOHEADER)
  \biWidth=width
  \biHeight=height
  \biPlanes=1
  \biBitCount=bitcount
  \biCompression=#BI_RGB
  \biSizeImage=pitch*height
  \biXPelsPerMeter=0
  \biYPelsPerMeter=0
  \biClrUsed=ncolors
  \biClrImportant=0
 EndWith
 
 ;Read the color map
 *pal=hDIB+bhsize ;Pointer to DIB palette
 For count=0 To 16-1
  *pal\rgbRed=ph\colormap[count*3] ;red
  *pal\rgbGreen=ph\colormap[(count*3)+1] ;green
  *pal\rgbBlue=ph\colormap[(count*3)+2] ;blue
  *pal+4
 Next
 
 FileSeek(file,Lof(file)-769) ;Seek to the 256 color palette
 
 ;Read the palette
 byte=ReadByte(file) & 255 ;Palette header marker
 If ph\version=5 And byte=12 ;If there is a palette
  *pal=hDIB+bhsize ;Pointer to DIB palette
  For count=0 To 256-1
   *pal\rgbRed=ReadByte(file) ;red
   *pal\rgbGreen=ReadByte(file) ;green
   *pal\rgbBlue=ReadByte(file) ;blue
   *pal+4
  Next
 EndIf
 
 FileSeek(file,SizeOf(PCXHEADER)) ;Seek to the bits
 
 ix=0
 iy=0
 plane=0 ;Reset
 
 If ph\nplanes=1 And ph\bitsperpixel<=8 ;1/4/8-bit pcx
  
  ;Flip the bitmap vertical as pcx files are top-down
  sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
  
  While iy<height ;Instead of by filesize
  
   byte=ReadByte(file) & 255 ;Run byte
   
   If byte>191 ;Top 2 bits are set
   
    rle=byte & 63 ;Low 6 bits are run
    byte=ReadByte(file) & 255 ;Color byte
    
    For count=0 To rle-1
     PokeB(sline+ix,byte)
     ix+1 ;Pixel size
     If ix>=totalbytes
      ix=0
      iy+1
      If iy>=height : Break : EndIf
      sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
     EndIf
    Next
    
   Else ;There is no run byte
   
    PokeB(sline+ix,byte)
    ix+1 ;Pixel size
    If ix>=totalbytes
     ix=0
     iy+1
     If iy>=height : Break : EndIf
     sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
    EndIf
    
   EndIf
   
  Wend
  
 ElseIf ph\nplanes=4 And ph\bitsperpixel=1 ;4-bit pcx
 
  sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
  
  While iy<height ;Instead of by filesize
  
   byte=ReadByte(file) & 255 ;Run byte
   
   If byte>191 ;Top 2 bits are set
   
    rle=byte & 63 ;Low 6 bits are run
    byte=ReadByte(file) & 255 ;Color byte
    
    For count=0 To rle-1
     For id=0 To 7 ;Bits loop
      nibble=((byte & (1 << (7-id))) >> (7-id)) << plane ;1/2/4/8
      If id & 1=0 : nibble << 4 : EndIf ;High nibble if even
      PokeB(sline+ix,(PeekB(sline+ix) & 255) | nibble) ;Build nibbles
      ix+(id & 1) ;Add if odd
     Next
     
     If ix>=totalbytes
      ix=0
      plane+1
      If plane>=ph\nplanes
       plane=0
       iy+1
       If iy>=height : Break : EndIf
       sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
      EndIf
     EndIf
    Next
    
   Else ;There is no run byte
   
    For id=0 To 7 ;Bits loop
     nibble=((byte & (1 << (7-id))) >> (7-id)) << plane ;1/2/4/8
     If id & 1=0 : nibble << 4 : EndIf ;High nibble if even
     PokeB(sline+ix,(PeekB(sline+ix) & 255) | nibble) ;Build nibbles
     ix+(id & 1) ;Add if odd
    Next
    
    If ix>=totalbytes
     ix=0
     plane+1
     If plane>=ph\nplanes
      plane=0
      iy+1
      If iy>=height : Break : EndIf
      sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
     EndIf
    EndIf
    
   EndIf
   
  Wend
 
 ElseIf ph\nplanes=3 And ph\bitsperpixel=8 ;24-bit pcx
 
  sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
  
  While iy<height ;Instead of by filesize
  
   byte=ReadByte(file) & 255 ;Run byte
   
   If byte>191 ;Top 2 bits are set
   
    rle=byte & 63 ;Low 6 bits are run
    byte=ReadByte(file) & 255 ;Color byte
    
    For count=0 To rle-1
     PokeB(sline+ix+(2-plane),byte) ;Red, green or blue
     ix+3 ;Pixel size
     If ix>=totalbytes
      ix=0
      plane+1
      If plane>=ph\nplanes
       plane=0
       iy+1
       If iy>=height : Break : EndIf
       sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
      EndIf
     EndIf
    Next
    
   Else ;There is no run byte
   
    PokeB(sline+ix+(2-plane),byte) ;Red, green or blue
    ix+3 ;Pixel size
    If ix>=totalbytes
     ix=0
     plane+1
     If plane>=ph\nplanes
      plane=0
      iy+1
      If iy>=height : Break : EndIf
      sline=hDIB+bhsize+(ncolors*4)+((height-1-iy)*pitch)
     EndIf
    EndIf
    
   EndIf
   
  Wend
 
 Else ;Not 1/4/8/24-bit
 
  CloseFile(file)
  FreeMemory(hDIB)
  MessageRequester("LOAD ERROR","Image type not supported")
  ProcedureReturn #False
  
 EndIf
 
 CloseFile(file) ;Close the file
 ProcedureReturn hDIB
 
EndProcedure

Procedure.l LoadPCX_(filename.s)

 Protected *dib.BITMAPINFOHEADER
 Protected bits.l,hDC.l,hBitmap.l
 
 *dib=LoadPCX(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 PCX",#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|*.pcx"
     filename.s=OpenFileRequester("Choose An Image File To Open","",Pattern,0)
     If filename
      hBitmap.l=LoadPCX_(filename)
      SendMessage_(GadgetID(1),#STM_SETIMAGE,#IMAGE_BITMAP,hBitmap)
     EndIf
   EndSelect
  Case #PB_Event_CloseWindow
   End
 EndSelect
ForEver

Dr. Dri · Post by **Dr. Dri** » Fri Jun 01, 2007 10:14 pm

if you want a more readable code you can do things like that :

Code: Select all

*hDIB.BITMAPINFOHEADER = AllocateMemory(bhsize + (ncolors*4) + (pitch*height))

;[...]

*hDIB\biSize = SizeOf(BITMAPINFOHEADER)
*hDIB\biWidth = width
*hDIB\biHeight = height
*hDIB\biPlanes = 1
*hDIB\biBitCount = bitcount
*hDIB\biCompression = #BI_RGB
*hDIB\biSizeImage = pitch*height
*hDIB\biXPelsPerMeter = 0
*hDIB\biYPelsPerMeter = 0
*hDIB\biClrUsed = ncolors
*hDIB\biClrImportant = 0

Dri

hagibaba · Post by **hagibaba** » Sun Jun 03, 2007 11:56 am

Hi Dr Dri,

you're right. It would be better. I'll update these entrys to do that. Thanks for the tip.

Dr. Dri · Post by **Dr. Dri** » Sun Jun 03, 2007 5:46 pm

hagibaba wrote:Hi Dr Dri,

you're right. It would be better. I'll update these entrys to do that. Thanks for the tip.

I'm the one who should thank for the tip

Dri

hagibaba · Post by **hagibaba** » Mon Jun 04, 2007 6:53 am

Ok, where is my thanks then!