PureBasic Forums - English

Code: Select all

;- Structures

Structure CUTHEADER
 width.w ;Image width in pixels
 height.w ;Image height in scanlines
 reserved.w ;Reserved field (set to 0)
EndStructure

Procedure LoadCUT(filename.s)
 ;From "Dr. Halo File Format Summary", "File.c" by Joe C. Oliphant
 ;Loads 8-bit Dr. Halo files
 
 Protected ch.CUTHEADER
 Protected *dib.BITMAPINFOHEADER
 Protected *pal.RGBQUAD
 Protected bitcount.l,ncolors.l,palette.l,file.l,size.l,length.l
 Protected count.l,width.l,height.l,line.l,pitch.l,bhsize.l
 Protected hDIB.l,ix.l,iy.l,bits.l,pixel.l,run.l
 
 bitcount=8 ;Cut files are always 8-bit
 ncolors=1 << bitcount ;256 colors in DIB
 
 ;Allocate the temp palette
 palette=AllocateMemory(ncolors*4)
 If palette=0
  MessageRequester("LOAD ERROR","Memory allocation failed")
  ProcedureReturn #False
 EndIf
 
 ;Read the pal file, if any
 file=ReadFile(#PB_Any,Mid(filename,1,Len(filename)-3)+"pal")
 
 If file ;Pal file exists
 
  FileSeek(file,4) ;Seek to size
  size=ReadWord(file) ;Size of palette
  If size=0 ;Assume the pal header is 40 bytes
   size=Lof(file)-40
  EndIf
  FileSeek(file,Lof(file)-size) ;Seek past the pal header
  length=512-(Lof(file)-size) ;First 512-byte block
  
  *pal=palette ;Pointer to palette
  For count=0 To ncolors-1
   *pal\rgbRed=ReadWord(file) & 255 ;red
   *pal\rgbGreen=ReadWord(file) & 255 ;green
   *pal\rgbBlue=ReadWord(file) & 255 ;blue
   *pal+4
   length-6
   If length<6 ;Align to 512-byte blocks
    FileSeek(file,Loc(file)+length)
    length=512 ;Next block
   EndIf
  Next
  
  CloseFile(file) ;Close the file
  
 Else ;No pal file exists
 
  *pal=palette ;Pointer to palette
  For count=0 To ncolors-1 ;Build a greyscale palette
   *pal\rgbBlue=count & 255 ;blue
   *pal\rgbGreen=count & 255 ;green
   *pal\rgbRed=count & 255 ;red
   *pal+4
  Next
  
 EndIf
 
 ;Open the file
 file=ReadFile(#PB_Any,filename)
 If file=0
  MessageRequester("LOAD ERROR","File could not be opened")
  ProcedureReturn #False
 EndIf
 
 ;Read the header
 ReadData(file,ch,SizeOf(CUTHEADER))
 
 ;Calculate some information
 width=ch\width & $FFFF
 height=ch\height & $FFFF
 line=((width*bitcount)+7)/8 ;BYTE-aligned width
 pitch=(((width*bitcount)+31)/32)*4 ;DWORD-aligned width
 bhsize=SizeOf(BITMAPINFOHEADER) ;DIB info header size
 
 ;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
 
 ;Fill in the DIB palette
 CopyMemory(palette,hDIB+bhsize,ncolors*4)
 FreeMemory(palette) ;Free the temp palette
 
 ix=0 ;Reset
 iy=0
 bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
 
 ;Read the bits
 While iy<height
 
  length=ReadWord(file) & $FFFF ;Length of a scanline
  
  While length>0
  
   count=ReadByte(file) & 255 ;Run count is bits 0..6
   length-1
   
   If count & 127=0 ;End of a scanline
    Break
   EndIf
   
   If count>127 ;Run packet
   
    count-128
    pixel=ReadByte(file) & 255 ;Pixel index
    length-1
    
    For run=0 To count-1 ;RLE pixels
     PokeB(bits+ix,pixel)
     ix+1
     If ix>=line
      ix=0
      iy+1
      If iy>=height : Break : EndIf
      bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
     EndIf
    Next
    
   Else ;Raw packet
   
    For run=0 To count-1 ;Non-RLE pixels
     pixel=ReadByte(file) & 255 ;Pixel index
     length-1
     PokeB(bits+ix,pixel)
     ix+1
     If ix>=line
      ix=0
      iy+1
      If iy>=height : Break : EndIf
      bits=hDIB+bhsize+(ncolors*4)+(pitch*(height-1-iy))
     EndIf
    Next
    
   EndIf
   
  Wend
  
 Wend
 
 CloseFile(file) ;Close the file
 ProcedureReturn hDIB
 
EndProcedure

Procedure.l LoadCUT_(filename.s)

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