如何在VB中直接显示无格式256灰度级图像

核心提示：在具体应用中可能会要处理无格式的图像,在VB中可利用API函数SetDIBitsToDevice实现这一功能.下面是我在工作中用到的显示256X256大小,256灰度级图像的程序.DeclareFunctionGlobalAllocLib"kernel32"(ByValwFlagsAsLong,By

----在具体应用中可能会要处理无格式的图像,在VB中可利用API函数SetDIBitsToDevice实现这一功能.下面是我在工作中用到的显示256X256大小,256灰度级图像的程序.

DeclareFunctionGlobalAllocLib"kernel32"(ByValwFlagsAsLong,ByValdwBytesAsLong)AsLong
DeclareFunctionGlobalLockLib"kernel32"(ByValhMemAsLong)AsLong
DeclareFunctionGlobalUnlockLib"kernel32"(ByValhMemAsLong)AsLong
DeclareFunctionGlobalFreeLib"kernel32"(ByValhMemAsLong)AsLong

DeclareFunctionDeleteDCLib"gdi32"(ByValHDCAsLong)AsLong
DeclareFunctionDeleteObjectLib"gdi32"(ByValhObjectAsLong)AsLong

DeclareFunctionSetDIBitsToDeviceLib"gdi32"(ByValHDCAsLong,ByValxAsLong,ByValyAsLong,ByValdxAsLong,ByValdyAsLong,ByValSrcXAsLong,ByValSrcYAsLong,ByValScanAsLong,ByValNumScansAsLong,BitsAsAny,BitsInfoAsBITMAPINFO,ByValwUsageAsLong)AsLong

Typergbquad
rgbBlueAsByte
rgbGreenAsByte
rgbRedAsByte
rgbReservedAsByte
EndType

TypePALETTEENTRY
peRedAsByte
peGreenAsByte
peBlueAsByte
peFlagsAsByte
EndType

TypeBITMAPFILEHEADER
bfTypeAsInteger
bfSizeAsLong
bfReserved1AsInteger
bfReserved2AsInteger
bfOffBitsAsLong
EndType

TypeBITMAPINFOHEADER
biSizeAsLong
biWidthAsLong
biHeightAsLong
biplanesAsInteger
biBitCountAsInteger
biComPRessionAsLong
biSizeImageAsLong
biXPelsPerMeterAsLong
biYPelsPerMeterAsLong
biClrUsedAsLong
biClrImportantAsLong
EndType

TypeBITMAPINFO
bmiHeaderAsBITMAPINFOHEADER
bmiColors(0To255)Asrgbquad
EndType

GlobalConstSRCCOPY=&HCC0020'dest=source
GlobalConstsrcand=&H8800C6'dest=sourceanddest
GlobalConstsrcor=&HEE0086'dest=sourceordest
PublicConstCOLORONCOLOR=3
PublicConstDIB_RGB_COLORS=0'colortableinRGBs
PublicConstDIB_PAL_COLORS=1'
colortableinpaletteindices
GlobalConstGMEM_MOVEABLE=&H2

'--------以上为定义部分,可放在一个BAS文件中--------

DimxAsLong,iiAsInteger
Dimw1AsLong,h1AsLong
Dimbitmapinfo_hAsBITMAPINFOHEADER,
bitmapfile_hAsBITMAPFILEHEADER
DimlpInitInfoAsBITMAPINFO
Dimt_rgbquad(0To255)Asrgbquad
DimpLogPalAsLOGPALETTE
DimlengAsLong
Dimt_buf()AsByte'图像数据buffer

OnErrorGoToError_process
'Setuperrorhandler.
'Openthefile
pfile1$="c:\fcg\test.d"
'test.d为256X256大小,256灰度级的无格式图像文件
fd=FreeFile
w1=256'图像宽度
h1=256'图像高度
leng=w1*h1
ReDimt_buf(leng)AsByte

Openpfile1$ForBinaryAs#fd
Get#fd,,t_buf
Close'Closethefile

leng=w1*h1

bitmapfile_h.bfType=19778'"BM"
bitmapfile_h.bfSize=1078 h1*w1
bitmapfile_h.bfReserved1=0
bitmapfile_h.bfReserved2=0
bitmapfile_h.bfOffBits=1078

bitmapinfo_h.biSize=40
bitmapinfo_h.biWidth=w1
bitmapinfo_h.biHeight=h1
bitmapinfo_h.biPlanes=1
bitmapinfo_h.biBitCount=8
bitmapinfo_h.biCompression=0
bitmapinfo_h.biSizeImage=0
bitmapinfo_h.biXPelsPerMeter=0
bitmapinfo_h.biYPelsPerMeter=0
bitmapinfo_h.biClrUsed=256
Forii=0To255'设置色表为256灰度
t_rgbquad(ii).rgbBlue=CByte(ii)
t_rgbquad(ii).rgbGreen=CByte(ii)
t_rgbquad(ii).rgbRed=CByte(ii)
't_rgbquad.rgbReserved=0
Nextii

lpInitInfo.bmiHeader=bitmapinfo_h

Forii=0To255
lpInitInfo.bmiColors(ii)=t_rgbquad(ii)
Nextii

'picture1为一个picture控件,
用于显示无格式256灰度级图像
x=SetDIBitsToDevice(picture1.HDC,0,0,
w1,h1,0,0,0,h1,t_buf(0),lpInitInfo,
0)'显示图像
x=GlobalUnlock(hPal)'释放资源
x=GlobalFree(hPal)
GoToNormal_exit
Error_process:
Msgbox"程序运行出错!"
Normal_exit:->