|
 |
推荐文章 |
|
|
|
|
|
|
|
|
|
|
| 作者：冯才刚 日期：2005-8-4 11:33:41 |
|
|
---- 在 具 体 应 用 中 可 能 会 要 处 理 无 格 式 的 图 像, 在VB 中 可 利 用API 函 数SetDIBitsToDevice 实 现 这 一 功 能. 下 面 是 我 在 工 作 中 用 到 的 显 示256X256 大 小,256 灰 度 级 图 像 的 程 序.
Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Declare Function DeleteDC Lib "gdi32" (ByVal HDC As Long) As Long
Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Declare Function SetDIBitsToDevice Lib "gdi32" (ByVal HDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal SrcX As Long, ByVal SrcY As Long, ByVal Scan As Long, ByVal NumScans As Long, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage As Long) As Long
Type rgbquad
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Type PALETTEENTRY
peRed As Byte
peGreen As Byte
peBlue As Byte
peFlags As Byte
End Type
Type BITMAPFILEHEADER
bfType As Integer
bfSize As Long
bfReserved1 As Integer
bfReserved2 As Integer
bfOffBits As Long
End Type
Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors(0 To 255) As rgbquad
End Type
Global Const SRCCOPY = &HCC0020 ' dest=source
Global Const srcand = &H8800C6 ' dest=source and dest
Global Const srcor = &HEE0086 ' dest=source or dest
Public Const COLORONCOLOR = 3
Public Const DIB_RGB_COLORS = 0 ' color table in RGBs
Public Const DIB_PAL_COLORS = 1 '
color table in palette indices
Global Const GMEM_MOVEABLE = &H2
'--------以上为定义部分,可放在一个BAS文件中--------
Dim x As Long, ii As Integer
Dim w1 As Long, h1 As Long
Dim bitmapinfo_h As BITMAPINFOHEADER,
bitmapfile_h As BITMAPFILEHEADER
Dim lpInitInfo As BITMAPINFO
Dim t_rgbquad(0 To 255) As rgbquad
Dim pLogPal As LOGPALETTE
Dim leng As Long
Dim t_buf() As Byte '图像数据buffer
On Error GoTo Error_process
'Set up error handler.
' Open the file
pfile1$ = "c:\fcg\test.d"
' test.d为256X256大小,256灰度级的无格式图像文件
fd% = FreeFile
w1 = 256 '图像宽度
h1 = 256 '图像高度
leng = w1 * h1
ReDim t_buf(leng) As Byte
Open pfile1$ For Binary As #fd%
Get #fd%, , t_buf
Close ' Close the file
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
For ii = 0 To 255 '设置色表为256灰度
t_rgbquad(ii).rgbBlue = CByte(ii)
t_rgbquad(ii).rgbGreen = CByte(ii)
t_rgbquad(ii).rgbRed = CByte(ii)
' t_rgbquad.rgbReserved = 0
Next ii
lpInitInfo.bmiHeader = bitmapinfo_h
For ii = 0 To 255
lpInitInfo.bmiColors(ii) = t_rgbquad(ii)
Next ii
'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)
GoTo Normal_exit
Error_process:
Msgbox "程序运行出错!"
Normal_exit: |
|
|
|
|
|
特别声明： 本站除部分特别声明禁止转载的专稿外的其他文章可以自由转载，但请务必注明出处和原始作者。文章版权归文章原始作者所有。对于被本站转载文章的个人和网站，我们表示深深的谢意。如果本站转载的文章有版权问题请联系编辑人员，我们尽快予以更正。 |
|
|
|
|
|
责任编辑： 原点 |
投稿作者： 冯才刚 |
|
|
信息来源： 网络 |
录入时间： 2005-8-4 11:33:41 |
|
|
|
| |
|
设为首页
加入收藏
总编信箱
投稿或申请专栏请先 [登 陆]