将选项卡拉伸到vb6 picturebox-can'；t访问图片

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

（在代码中，FormLoad中有一个额外的函数，它在另一个pic框中绘制一些图形）

---

只有当AutoRedraw为真时，才能访问图片控件的hDC。请仔细检查该设置。

谢谢谢谢谢谢！！！！我花了三天时间在这上面，现在它开始工作了！

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