首先,特别感谢版上的各位大虾们热心的帮助,不过,小弟实在太菜了,
稍微变一下就不会了,还请大虾们帮忙看一下!!^_^
问题:如何把加载到DC中的图片的一部分信息拷贝到图片框(不借助图片框为中介(借助图片框的,我会的,嘿嘿!),
因为我一次要加载很多图片,借助大量的图片框或图片框数组,运行的时候会卡)Option ExplicitPrivate Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Const SRCCOPY = &HCC0020
Private Sub Form_Load()Dim lFirstDotColor As Long
Dim mDc As Long
Dim picLoad As PictureSet picLoad = LoadPicture(App.Path + "\" + "number.jpg") ''''''加载一张图片
mDc = CreateCompatibleDC(0) '建立Memory DCSelectObject mDc, picLoad.Handle '在该memoryDC上放上bitmap图lFirstDotColor = GetPixel(mDc, 0, 0) '获取图片左上角的像素信息With pic '''''''''设置图片框的属性
.AutoRedraw = True
.AutoSize = True
.ScaleMode = 3
.BorderStyle = 0
.Width = picLoad.Width / 10 '''''''''''''''''''截取原图像的部分信息,参见下面的bitblt函数
.Height = picLoad.Height '''''''''''''''''''但是,好像图片框的高度与宽度不对,怎么回事啊?
.BackColor = 0 ''''''''''''''''''''''''''''''''''''''''''''原图的大小是150pixels × 22 pixels,但是这里显示的ms是用twip为单位的,怎么回事! ^_^
End With
With Me
.BackColor = lFirstDotColor
End WithBitBlt pic.hDC, 0, 0, pic.Width, pic.Height, mDc, 0, 0, SRCCOPY
pic.RefreshCall DeleteDC(mDc) '''''''''删除DC
End Sub
这个问题在于:picLoad是Picture对象,而非PictureBox控件,所以要得到以像素为单位的尺寸可以使用下面的方法
PicW = ScaleX(picLoad.Width, vbHimetric, vbPixels) ' 图片宽
PicH = ScaleY(picLoad.Height, vbHimetric, vbPixels) ' 图片高另外也可以使用API函数GetObject:
Public Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End TypeDim bmpImage as BITMAP
GetObject picLoad.Handle, Len(bmpImage), bmpImage
debug.print bmpImage.bmWidth ' 图片宽
debug.print bmpImage.bmHeight ' 图片高
.Width = ScaleX(picLoad.Width, vbHimetric, vbTwips) / 10
.Height = ScaleY(picLoad.Height, vbHimetric, vbTwips)
End With