StretchDIBits to vb6 picturebox - 그림에 액세스 할 수 없습니다.

Question

일단 StretchBIBits를 사용하여 그림을 그림 상자에 넣은 다음에는 그 그림에 다시 액세스 할 수있는 방법을 찾지 못했습니다. 양식 (아래 코드)에는 그림 상자 2,3,4가 있습니다. pict 2는 디자인 타임에 이미지를 넣습니다. GetDIBits를 사용하여 픽셀을 읽고 StretchDIBits로 그림 3으로 설정할 수 있습니다. 그러나 이미지 3에서 GetDIBits를 사용하면 0 만 반환합니다. Pic4.picture = pic3.picture도 사진을 찍지 않습니다. stretchdibits를 사용하면 이미지를 그림 상자의 접근하기 어려운 부분에 넣는 것처럼 보입니까?

에만 그림 컨트롤의있는 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 

Answer 1

AutoRedraw이 True입니다 (코드에서 다른 그림 상자에 일부 도면을하지 FormLoad에 추가 기능이있다). 해당 설정을 다시 확인하십시오.