They deal with creating, loading and saving windows bitmaps.
You can get the original source code here:
http://www.codeproject.com/clipboard/dib2clipboard.asp
Edit: I have removed the BITMAP parameter in CreateDIB, LoadDIB and LoadBMP and added a new procedure GetBMP to get the BITMAP info. I think it's neater this way.
Last edited on 27 Jan 2007.
Code: Select all
;Windows DIB Procedures
;http://www.codeproject.com/clipboard/dib2clipboard.asp
;Credits: John Simmons
;Author: hagibaba
;Date: 24 Jan 2007
;Note: the "wincap32.zip" is in the "DIB2Clipboard.zip"
;CreateDIB()
;
;Parameters:
;dwWidth.l - Width for new bitmap in pixels.
;dwHeight.l - Height for new bitmap in pixels.
;wBitCount.w - Bits per pixel for new DIB (1, 4, 8 or 24).
;
;Returns: Handle to new DIB.
;
;Description:
;This function allocates memory for and initializes a new DIB by
;filling in the BITMAPINFOHEADER, allocating memory for the color
;table, and allocating memory for the bitmap bits. As with all
;DIBs, the header, color table and bits are all in one contiguous
;memory block. This function is similar to the CreateBitmap()
;Windows API. The color table and bitmap bits are left
;uninitialized (zeroed) in the returned DIB.
Procedure.l CreateDIB(dwWidth.l,dwHeight.l,wBitCount.w)
Protected hDIB.l
Protected bi.BITMAPINFOHEADER
Protected lpbi.l ;pointer to BITMAPINFOHEADER
Protected dwLen.l ;size of memory block
Protected dwBytesPerLine.l ;number of bytes per scanline
;Make sure bits per pixel is valid
If wBitCount<=1
wBitCount=1
ElseIf wBitCount<=4
wBitCount=4
ElseIf wBitCount<=8
wBitCount=8
Else
wBitCount=24 ;if greater than 8-bit, force to 24-bit
EndIf
;Initialize BITMAPINFOHEADER
bi\biSize=SizeOf(BITMAPINFOHEADER)
bi\biWidth=dwWidth ;fill in width from parameter
bi\biHeight=dwHeight ;fill in height from parameter
bi\biPlanes=1 ;must be 1
bi\biBitCount=wBitCount ;bits per pixel from parameter
bi\biCompression=#BI_RGB ;none
bi\biSizeImage=0 ;0's here mean "default"
bi\biXPelsPerMeter=0
bi\biYPelsPerMeter=0
bi\biClrUsed=0
bi\biClrImportant=0
;Now determine the size of the color table
If wBitCount<>24 ;no color table for 24-bit, default size otherwise
bi\biClrUsed=1 << wBitCount ;standard size table (2, 16, 256 or 0)
EndIf
;Calculate size of memory block required to store the DIB.
;This block should be big enough to hold the BITMAPINFOHEADER,
;the color table and the bits.
dwBytesPerLine=((dwWidth*wBitCount)+31)/32*4
dwLen=bi\biSize+(bi\biClrUsed*SizeOf(RGBQUAD))+(dwBytesPerLine*dwHeight)
;Allocate memory block to store our bitmap
hDIB=GlobalAlloc_(#GHND,dwLen)
If hDIB=0 ;major bummer If we couldn't get memory block
ProcedureReturn #False
EndIf
lpbi=GlobalLock_(hDIB) ;lock memory and get pointer to it
;Use our BITMAPINFOHEADER to fill in the first part of our DIB
CopyMemory(bi,lpbi,bi\biSize)
;Since we don't know what the color table and bits should contain,
;just leave these blank.
GlobalUnlock_(hDIB) ;unlock the DIB
ProcedureReturn hDIB ;return handle to the DIB
EndProcedure
;LoadDIB()
;
;Parameters:
;lpFileName.s - Specifies the file to load a DIB from.
;
;Returns: A handle to a DIB, or False if unsuccessful.
;
;NOTE: The DIB API were not written to handle OS/2 DIBs; this
;function will reject any file that is not a Windows DIB.
;
;Description:
;Loads the specified DIB from a file, allocates memory for it,
;and reads the disk file into the memory.
Procedure.l LoadDIB(lpFileName.s)
Protected hFile.l
Protected hDIB.l
Protected hDIBtmp.l ;used for GlobalRealloc()
Protected bfh.BITMAPFILEHEADER
Protected bi.BITMAPINFOHEADER
Protected lpbi.l ;pointer to BITMAPINFOHEADER
Protected dwNumColors.l ;number of colors in table
Protected dwOffBits.l ;offset to bits
hFile=ReadFile(#PB_Any,lpFileName) ;open the file to read
If hFile=0 ;the file can't be opened
ProcedureReturn #False
EndIf
;Allocate memory for header & color table, we'll enlarge this as needed
hDIB=GlobalAlloc_(#GMEM_MOVEABLE,SizeOf(BITMAPINFOHEADER)+(256*SizeOf(RGBQUAD)))
If hDIB=0 ;major bummer if we couldn't get memory block
ProcedureReturn #False
EndIf
lpbi=GlobalLock_(hDIB) ;lock memory and get pointer to it
If lpbi=0 ;if we couldn't lock memory
GlobalFree_(hDIB)
CloseFile(hFile)
ProcedureReturn #False
EndIf
;Read the BITMAPFILEHEADER from our file
ReadData(hFile,bfh,SizeOf(BITMAPFILEHEADER))
If bfh\bfType<>$4d42 ;check header marker is "BM"
GlobalUnlock_(hDIB)
GlobalFree_(hDIB)
CloseFile(hFile)
ProcedureReturn #False
EndIf
;Read the BITMAPINFOHEADER
ReadData(hFile,lpbi,SizeOf(BITMAPINFOHEADER))
;Fill in a BITMAPINFOHEADER to make things clearer
bi\biSize=PeekL(lpbi)
bi\biWidth=PeekL(lpbi+4)
bi\biHeight=PeekL(lpbi+8)
bi\biPlanes=PeekW(lpbi+12)
bi\biBitCount=PeekW(lpbi+14)
bi\biCompression=PeekL(lpbi+16)
bi\biSizeImage=PeekL(lpbi+20)
bi\biXPelsPerMeter=PeekL(lpbi+24)
bi\biYPelsPerMeter=PeekL(lpbi+28)
bi\biClrUsed=PeekL(lpbi+32)
bi\biClrImportant=PeekL(lpbi+36)
;Check to see that it's a Windows DIB, we'll not support the OS/2 DIB
If bi\biSize=SizeOf(BITMAPCOREHEADER)
GlobalUnlock_(hDIB)
GlobalFree_(hDIB)
CloseFile(hFile)
ProcedureReturn #False
EndIf
;Now determine the size of the color table
dwNumColors=bi\biClrUsed ;get number of colors in table
If dwNumColors=0
If bi\biBitCount<>24 ;no color table for 24-bit, default size otherwise
dwNumColors=1 << bi\biBitCount ;standard size table (2, 16, 256 or 0)
EndIf
EndIf
;Fill in some default values if they are zero
If bi\biClrUsed=0
bi\biClrUsed=dwNumColors
PokeL(lpbi+32,bi\biClrUsed)
EndIf
If bi\biSizeImage=0
bi\biSizeImage=(((bi\biWidth*bi\biBitCount)+31)/32*4)*bi\biHeight
PokeL(lpbi+20,bi\biSizeImage) ;DWORD-aligned Width * Height
EndIf
;Get a proper-sized buffer for header, color table and bits
GlobalUnlock_(hDIB)
hDIBtmp=GlobalReAlloc_(hDIB,bi\biSize+(dwNumColors*SizeOf(RGBQUAD))+bi\biSizeImage,0)
If hDIBtmp=0 ;can't resize buffer for loading
GlobalFree_(hDIB)
CloseFile(hFile)
ProcedureReturn #False
Else
hDIB=hDIBtmp
EndIf
lpbi=GlobalLock_(hDIB) ;lock memory and get pointer to it
;Read the color table
ReadData(hFile,lpbi+bi\biSize,dwNumColors*SizeOf(RGBQUAD))
;Offset to the bits from start of DIB header
dwOffBits=bi\biSize+(dwNumColors*SizeOf(RGBQUAD))
;If the bfOffBits field is non-zero, then the bits might *not* be
;directly following the color table in the file
If bfh\bfOffBits<>0
FileSeek(hFile,bfh\bfOffBits)
EndIf
;Read the bits
ReadData(hFile,lpbi+dwOffBits,bi\biSizeImage)
GlobalUnlock_(hDIB) ;unlock the DIB
CloseFile(hFile) ;close the file
ProcedureReturn hDIB ;return handle to the DIB
EndProcedure
;SaveDIB()
;
;Parameters:
;hDIB.l - Handle to the dib to save.
;lpFileName.s - Specifies the full pathname to save DIB under.
;
;Returns: 0 if successful, or one of:
;ERR_INVALIDHANDLE=20, ERR_OPEN=4, ERR_LOCK=3, #ERR_NOT_DIB=1.
;
;Description:
;Saves the specified DIB into the specified file name on disk. No error
;checking is done, so if the file already exists, it will be overwritten.
Procedure.w SaveDIB(hDIB.l,lpFileName.s)
Protected bmfHdr.BITMAPFILEHEADER ;header for bitmap file
Protected bi.BITMAPINFOHEADER
Protected lpbi.l ;pointer to DIB info structure
Protected hFile.l ;file handle for opened file
Protected dwDIBSize.l ;size of DIB header and bits
Protected dwBmBitsSize.l ;size of bitmap bits only
If hDIB=0 ;handle invalid
ProcedureReturn 20 ;#ERR_INVALIDHANDLE=20
EndIf
hFile=CreateFile(#PB_Any,lpFileName) ;open the file to read
If hFile=0 ;the file can't be opened
ProcedureReturn 4 ;#ERR_OPEN=4
EndIf
lpbi=GlobalLock_(hDIB) ;get a pointer to the DIB memory
If lpbi=0 ;if we couldn't lock memory
CloseFile(hFile)
ProcedureReturn 3 ;#ERR_LOCK=3
EndIf
;Fill in a BITMAPINFOHEADER to make things clearer
bi\biSize=PeekL(lpbi)
bi\biWidth=PeekL(lpbi+4)
bi\biHeight=PeekL(lpbi+8)
bi\biPlanes=PeekW(lpbi+12)
bi\biBitCount=PeekW(lpbi+14)
bi\biCompression=PeekL(lpbi+16)
bi\biSizeImage=PeekL(lpbi+20)
bi\biXPelsPerMeter=PeekL(lpbi+24)
bi\biYPelsPerMeter=PeekL(lpbi+28)
bi\biClrUsed=PeekL(lpbi+32)
bi\biClrImportant=PeekL(lpbi+36)
;Check to see that it's a Windows DIB, we'll not support the OS/2 DIB
If bi\biSize<>SizeOf(BITMAPINFOHEADER)
GlobalUnlock_(hDIB)
CloseFile(hFile)
ProcedureReturn 1 ;#ERR_NOT_DIB=1
EndIf
;Now determine the size of the color table
If bi\biClrUsed=0
If bi\biBitCount<>24 ;no color table for 24-bit, default size otherwise
bi\biClrUsed=1 << bi\biBitCount ;standard size table (2, 16, 256 or 0)
EndIf
EndIf
;Fill in file type (first 2 bytes must be "BM" for a bitmap)
bmfHdr\bfType=(Asc("M") << 8) | Asc("B") ;DIB header marker as "BM"
;To calculate the size of the DIB, find size of DIB header plus size
;of color table. Since the first DWORD in both BITMAPINFOHEADER and
;BITMAPCOREHEADER contains the size of the structure, let's use this.
;Partial calculation of the DIB header and color table
dwDIBSize=bi\biSize+(bi\biClrUsed*SizeOf(RGBQUAD))
;It's an RLE bitmap, we can't calculate size, so trust biSizeImage field
If bi\biCompression=#BI_RLE8 Or bi\biCompression=#BI_RLE4
dwDIBSize+bi\biSizeImage
Else
;It's not RLE, so size is DWORD-aligned Width * Height
dwBmBitsSize=(((bi\biWidth*bi\biBitCount)+31)/32*4)*bi\biHeight
dwDIBSize+dwBmBitsSize ;add the bits size
;Now, since we have calculated the correct size, why don't we
;fill in the biSizeImage field.
PokeL(lpbi+20,dwBmBitsSize) ;bi\biSizeImage
EndIf
;Calculate the file size by adding DIB size to BITMAPFILEHEADER
bmfHdr\bfSize=dwDIBSize+SizeOf(BITMAPFILEHEADER)
bmfHdr\bfReserved1=0 ;these must be zero
bmfHdr\bfReserved2=0
;Now, calculate the offset the actual bitmap bits will be in
;the file; it's the bitmap file header plus the DIB info header,
;plus the size of the color table.
bmfHdr\bfOffBits=SizeOf(BITMAPFILEHEADER)+bi\biSize+(bi\biClrUsed*SizeOf(RGBQUAD))
;Write the file header
WriteData(hFile,bmfHdr,SizeOf(BITMAPFILEHEADER))
;Write the DIB header and the bits
WriteData(hFile,lpbi,dwDIBSize)
GlobalUnlock_(hDIB) ;unlock the DIB
CloseFile(hFile) ;close the file
ProcedureReturn 0 ;Success code, no errors occured
EndProcedure
;DestroyDIB()
;
;Parameter: hDIB.l - Handle to the DIB to free.
;Returns: Null if the function succeeds.
;Description: Frees memory associated with a DIB.
Procedure.l DestroyDIB(hDIB.l)
ProcedureReturn GlobalFree_(hDIB)
EndProcedure
;LoadBMP()
;
;Description: This does the same thing as LoadDIB() except that it
;converts 1, 4 and 8 bit DIBs to 24 bit. It does not work with RLE bitmaps.
Procedure.l LoadBMP(lpFileName.s) ;Loads a 24-bit DIB
Protected hFile.l
Protected hDIB.l
Protected bfh.BITMAPFILEHEADER
Protected bi.BITMAPINFOHEADER
Protected lpbi.l ;pointer to BITMAPINFOHEADER
Protected dwBitCount.l ;bits per pixel
Protected dwNumColors.l ;number of colors in table
Protected dwLen.l ;size of memory block
Protected dwBytesPerLine.l ;number of bytes per scanline
Protected ix.l,iy.l,ib.l ;loop variables
Protected offset.l,byte.l,index.l ;temporary values
Protected Dim col.b(256*SizeOf(RGBQUAD)) ;color table array
hFile=ReadFile(#PB_Any,lpFileName) ;open the file to read
If hFile=0 ;the file can't be opened
ProcedureReturn #False
EndIf
;Read the BITMAPFILEHEADER from our file
ReadData(hFile,bfh,SizeOf(BITMAPFILEHEADER))
If bfh\bfType<>$4d42 ;check header marker is "BM"
CloseFile(hFile)
ProcedureReturn #False
EndIf
;Read the BITMAPINFOHEADER
ReadData(hFile,bi,SizeOf(BITMAPINFOHEADER))
;Check to see that it's a Windows DIB, we'll not support the OS/2 DIB
If bi\biSize=SizeOf(BITMAPCOREHEADER)
CloseFile(hFile)
ProcedureReturn #False
EndIf
dwBitCount=bi\biBitCount ;get bits per pixel, we need this later
dwNumColors=bi\biClrUsed ;get number of colors in table
;Now determine the size of the color table
If dwNumColors=0
If dwBitCount<>24 ;no color table for 24-bit, default size otherwise
dwNumColors=1 << dwBitCount ;standard size table (2, 16, 256 or 0)
EndIf
EndIf
;Read the color table to an array
ReDim col.b(dwNumColors*SizeOf(RGBQUAD)) ;resize col()
ReadData(hFile,col(),dwNumColors*SizeOf(RGBQUAD))
;Calculate size of memory block required to store the DIB
dwBytesPerLine=((bi\biWidth*24)+31)/32*4 ;DWORD-aligned scanline (pitch)
dwLen=bi\biSize+(dwBytesPerLine*bi\biHeight) ;info header + bits
;Reinitialize the BITMAPINFOHEADER as 24-bit
bi\biSize=SizeOf(BITMAPINFOHEADER)
bi\biWidth=bi\biWidth ;width is same
bi\biHeight=bi\biHeight ;height is same
bi\biPlanes=1 ;must be 1
bi\biBitCount=24
bi\biCompression=#BI_RGB ;none
bi\biSizeImage=dwBytesPerLine*bi\biHeight ;0's here mean "default"
bi\biXPelsPerMeter=0
bi\biYPelsPerMeter=0
bi\biClrUsed=0
bi\biClrImportant=0
;Allocate memory block to store our bitmap
hDIB=GlobalAlloc_(#GHND,dwLen)
If hDIB=0 ;major bummer if we couldn't get memory block
CloseFile(hFile)
ProcedureReturn #False
EndIf
lpbi=GlobalLock_(hDIB) ;lock memory and get pointer to it
;Use our BITMAPINFOHEADER to fill in the first part of our DIB
CopyMemory(bi,lpbi,bi\biSize)
;If the bfOffBits field is non-zero, then the bits might *not* be
;directly following the color table in the file
If bfh\bfOffBits<>0
FileSeek(hFile,bfh\bfOffBits) ;start of bits
EndIf
Select dwBitCount ;can be 1, 4, 8 or 24 bits per pixel
Case 1 ;convert 1-bit data to 24-bit
For iy=0 To bi\biHeight-1
offset=dwBytesPerLine*iy ;start of scanline
For ix=0 To bi\biWidth-1
If ix % 8=0 ;every 8th pixel
byte=ReadByte(hFile)
If byte<0 : byte+256 : EndIf ;can't have a minus value for col()
For ib=0 To 7 ;one byte is 8 pixels
index=byte & (1 << (7-ib)) ;mask byte with bits (highest bit first)
If index : index=1 : Else : index=0 : EndIf ;index to 0 or 1
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3),col(index*4))
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3)+1,col((index*4)+1))
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3)+2,col((index*4)+2))
Next
EndIf
Next
Next
Case 4 ;convert 4-bit data to 24-bit
For iy=0 To bi\biHeight-1
offset=dwBytesPerLine*iy ;start of scanline
For ix=0 To bi\biWidth-1
If ix % 2=0 ;every 2nd pixel
byte=ReadByte(hFile)
If byte<0 : byte+256 : EndIf ;can't have a minus value for col()
For ib=0 To 1 ;one byte is 2 pixels
If ib=0 : index=byte >> 4 : EndIf ;bits 4..7 (high nibble first)
If ib=1 : index=byte & 15 : EndIf ;bits 0..3
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3),col(index*4))
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3)+1,col((index*4)+1))
PokeB(lpbi+bi\biSize+offset+(ix*3)+(ib*3)+2,col((index*4)+2))
Next
EndIf
Next
Next
Case 8 ;convert 8-bit data to 24-bit
For iy=0 To bi\biHeight-1
offset=dwBytesPerLine*iy ;start of scanline
For ix=0 To bi\biWidth-1
byte=ReadByte(hFile) ;one byte is one pixel
If byte<0 : byte+256 : EndIf ;can't have a minus value for col()
PokeB(lpbi+bi\biSize+offset+(ix*3),col(byte*4))
PokeB(lpbi+bi\biSize+offset+(ix*3)+1,col((byte*4)+1))
PokeB(lpbi+bi\biSize+offset+(ix*3)+2,col((byte*4)+2))
Next
Next
Case 24 ;read the 24-bit data directly
ReadData(hFile,lpbi+bi\biSize,bi\biSizeImage)
EndSelect
GlobalUnlock_(hDIB) ;unlock the DIB
CloseFile(hFile) ;close the file
Dim col.b(0) ;delete the array
ProcedureReturn hDIB ;return handle to the DIB
EndProcedure
;GetBMP()
;
;Description: This works like GetObject_() does with LoadImage_().
;It is used to get BITMAP information about a DIB in memory.
Procedure.l GetBMP(hDIB.l,*bmp.BITMAP) ;Gets BITMAP info about a DIB
Protected lpbi.l ;pointer to BITMAPINFOHEADER
lpbi=GlobalLock_(hDIB) ;lock memory and get pointer to it
If lpbi=0 ;if we couldn't lock memory
ProcedureReturn #False ;fails
EndIf
;Get BITMAP info from BITMAPINFOHEADER
*bmp\bmType=0 ;must be zero
*bmp\bmWidth=PeekL(lpbi+4) ;biWidth
*bmp\bmHeight=PeekL(lpbi+8) ;biHeight
*bmp\bmWidthBytes=((PeekL(lpbi+4)*PeekW(lpbi+14))+31)/32*4 ;DWORD-aligned Width
*bmp\bmPlanes=PeekW(lpbi+12) ;biPlanes
*bmp\bmBitsPixel=PeekW(lpbi+14) ;biBitCount
*bmp\bmBits=lpbi+PeekL(lpbi)+(PeekL(lpbi+32)*SizeOf(RGBQUAD)) ;biSize+(biClrUsed*4)
GlobalUnlock_(hDIB) ;unlock the DIB
ProcedureReturn #True ;succeeds
EndProcedure
;FreeBMP()
;
;Description: This does the same thing as DestroyDIB().
;It is a convenience function for use with LoadBMP().
Procedure.l FreeBMP(hDIB.l) ;Frees a DIB from memory
ProcedureReturn GlobalFree_(hDIB)
EndProcedure
;Start of main code
BMP.BITMAP
hBMP=CreateDIB(256,128,8)
;hBMP=LoadDIB("Data/Cube.bmp")
;hBMP=LoadBMP("Data/Cube.bmp")
GetBMP(hBMP,BMP)
save=SaveDIB(hBMP,"Data/Test.bmp")
FreeBMP(hBMP)
Debug "hBMP="+Str(hBMP)
Debug "save="+Str(save)
Debug "bmType="+Str(BMP\bmType)
Debug "bmWidth="+Str(BMP\bmWidth)
Debug "bmHeight="+Str(BMP\bmHeight)
Debug "bmWidthBytes="+Str(BMP\bmWidthBytes)
Debug "bmPlanes="+Str(BMP\bmPlanes)
Debug "bmBitsPixel="+Str(BMP\bmBitsPixel)
Debug "bmBits="+Str(BMP\bmBits)
