StretchDIBits到vb6的picturebox - 不能访问图片

Question

我似乎无法找到一种方法，一旦我用StretchBIBits将图像放入一个picturebox，以任何方式再次访问该图片。表格（代码如下）有2,3,4个图片框。图片2在设计时放置了一张图片。我可以用GetDIBits读取像素，并使用StretchDIBits将它们设置为图片3。但在图像3上使用GetDIBits似乎只返回零。 Pic4.picture = pic3.picture也没有照片。那么使用stretchdibits似乎会将图像放入picturebox的一个无法访问的部分？

（代码中有一个在FormLoad一个额外的功能，做一些图中另一个PIC盒）

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 

Answer 1

只能访问一个画面控制的HDC为自动重为True。请仔细检查该设置。