一旦我使用StretchBIBits将图像放入图片框中，我无法找到方法，无论如何都可以再次访问该图片。表格（下面的代码）有图片框2,3,4。 pict 2在设计时放入了一个图像。我可以使用GetDIBits读取像素，并使用StretchDIBits将它们设置为pic 3。但是在图像3上使用GetDIBits似乎只返回零。 Pic4.picture = pic3.picture也没有得到图片。因此，使用stretchdibits似乎将图像放入图片框中无法访问的部分？
（在代码中，FormLoad中有一个额外的函数，可以在另一个图片框中进行绘图）
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, lpPoint As Long) As Long
Private Declare Function LineTo 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
Private Const SRCCOPY = &HCC0020
Private Declare Function DeleteDC Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function GetStockObject Lib "gdi32" (ByVal nIndex As Long) As Long
Private Const BLACK_PEN = 7
Private Const WHITE_BRUSH = 0
Private Const NULL_BRUSH = 5
Private Declare Function Rectangle Lib "gdi32" (ByVal hdc As Long, ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" (ByVal H As Long, ByVal W As Long, ByVal E As Long, ByVal O As Long, ByVal W As Long, ByVal I As Long, ByVal u As Long, ByVal S As Long, ByVal C As Long, ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Const ANSI_CHARSET = 0
Private Declare Function SetBkMode Lib "gdi32" (ByVal hdc As Long, ByVal nBkMode As Long) As Long
Private Declare Function GetBkMode Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function SetDIBits Lib "gdi32" (ByVal hdc As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Declare Function StretchDIBits 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 wSrcWidth As Long, ByVal wSrcHeight As Long, lpBits As Any, lpBitsInfo As BITMAPINFO, ByVal wUsage As Long, ByVal dwRop As Long) As Long
Private Const TRANSPARENT = 1
Private Type BITMAPINFOHEADER '40 bytes
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
Private Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Private Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Private Const BI_RGB = 0&
Private Const DIB_RGB_COLORS = 0 ' color table in RGBs
Private Sub Form_Load()
Dim mem_dc As Long
Dim mem_bm As Long
Dim orig_bm As Long
Dim wid As Long
Dim hgt As Long
Dim old_font As Long
Dim new_font As Long
Dim old_bk_mode As Long
Picture1.ScaleMode = vbPixels
wid = Picture1.ScaleWidth
hgt = Picture1.ScaleHeight
' Create the device context.
mem_dc = CreateCompatibleDC(hdc)
' Create the bitmap.
mem_bm = CreateCompatibleBitmap(mem_dc, wid, hgt)
' Make the device context use the bitmap.
orig_bm = SelectObject(mem_dc, mem_bm)
' Give the device context a white background.
SelectObject mem_dc, GetStockObject(WHITE_BRUSH)
Rectangle mem_dc, 0, 0, wid, hgt
SelectObject mem_dc, GetStockObject(NULL_BRUSH)
' Draw the on the device context.
SelectObject mem_dc, GetStockObject(BLACK_PEN)
MoveToEx mem_dc, 0, 0, ByVal 0&
LineTo mem_dc, wid, hgt
MoveToEx mem_dc, 0, hgt, ByVal 0&
LineTo mem_dc, wid, 0
' Do not fill the background.
old_bk_mode = GetBkMode(mem_dc)
SetBkMode mem_dc, TRANSPARENT
' Give the DC a font.
new_font = CreateFont(40, 0, 0, 0, _
700, 0, 0, 0, ANSI_CHARSET, _
0, 0, 0, 0, "Times New Roman")
old_font = SelectObject(mem_dc, new_font)
' Draw some text.
TextOut mem_dc, 20, 20, "Hello", Len("Hello")
' Destroy the new font.
SelectObject mem_dc, old_font
DeleteObject new_font
' Restore the original background fill mode.
SetBkMode mem_dc, old_bk_mode
' Copy the device context into the PictureBox.
Picture1.AutoRedraw = True
BitBlt Picture1.hdc, 0, 0, wid, hgt, _
mem_dc, 0, 0, SRCCOPY
Picture1.Picture = Picture1.Image
' Delete the bitmap and dc.
SelectObject mem_dc, orig_bm
DeleteObject mem_bm
DeleteDC mem_dc
End Sub
Private Sub cmdMG_Click()
MakeGray Picture2
End Sub
'The MakeGray subroutine prepares some data structures and then uses the GetDIBits API function to get the picture's bitmap data. It chnges each picel's red, green, and blue components to the average of those three values. It then uses SetDIBits to save the changes into the PictureBox.
' Convert a color image to gray scale.
Private Sub MakeGray(ByVal picColor As PictureBox)
Dim bitmap_info As BITMAPINFO
Dim pixels() As Byte
Dim bytes_per_scanLine As Long
Dim pad_per_scanLine As Long
Dim x As Integer
Dim y As Integer
Dim ave_color As Byte
Const pixR = 1
Const pixG = 2
Const pixB = 3
' Prepare the bitmap description.
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = picColor.ScaleWidth
' Use negative height to scan top-down.
.biHeight = picColor.ScaleHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
bytes_per_scanLine = ((((.biWidth * .biBitCount) + _
31) \ 32) * 4)
pad_per_scanLine = bytes_per_scanLine - (((.biWidth _
* .biBitCount) + 7) \ 8)
.biSizeImage = bytes_per_scanLine * Abs(.biHeight)
End With
' Load the bitmap's data.
ReDim pixels(1 To 4, 1 To picColor.ScaleWidth, 1 To picColor.ScaleHeight)
Dim rv As Long
'read image pixels from pic box 2
rv = GetDIBits(Picture2.hdc, Picture2.Image, _
0, Picture2.ScaleHeight, pixels(1, 1, 1), _
bitmap_info, DIB_RGB_COLORS)
' Modify the pixels.
For y = 1 To picColor.ScaleHeight
For x = 1 To picColor.ScaleWidth
ave_color = CByte((CInt(pixels(pixR, x, y)) + _
pixels(pixG, x, y) + _
pixels(pixB, x, y)) \ 3)
pixels(pixR, x, y) = ave_color
pixels(pixG, x, y) = ave_color
pixels(pixB, x, y) = ave_color
Next x
Next y
'write modified pixels to pic box 3
rv = StretchDIBits(Picture3.hdc, 0, 0, 200, 200, 0, 0, 200, 200, _
pixels(1, 1, 1), bitmap_info, DIB_RGB_COLORS, vbSrcCopy)
'clear pixel array
ReDim pixels(0)
ReDim pixels(1 To 4, 1 To picColor.ScaleWidth, 1 To picColor.ScaleHeight)
'get pixels from image 3
rv = GetDIBits(Picture3.hdc, Picture3.Image, _
0, Picture2.ScaleHeight, pixels(1, 1, 1), _
bitmap_info, DIB_RGB_COLORS)
'set to image 4
rv = StretchDIBits(Picture4.hdc, 0, 0, 200, 200, 0, 0, 200, 200, _
pixels(1, 1, 1), bitmap_info, DIB_RGB_COLORS, vbSrcCopy)
End Sub
答案 0 :(得分：2)
您只能访问Picture控件的hDC，AutoRedraw为True。请仔细检查该设置。