为窗体form1的菜单"抓图"的click事件过程补写代码

Question

为窗体form1的菜单"抓图"的click事件过程补写代码,实现下述功能,调用Bitblt函数,将屏幕中以(0,0)为左上角,长度和宽度分别为sx,sy的区域图形复制到picture控件piccopy中?Private Sub mCopyScreen_Click()
    Dim hDC As Long, sx As Integer, sy As Integer
    
    Me.Hide
    DoEvents
    
    picCopy.Width = Screen.Width
    picCopy.Height = Screen.Height
    
    picCopy.AutoRedraw = True
    
    hDC = GetDC(0)
    sx = Screen.Width \ Screen.TwipsPerPixelX
    sy = Screen.Height \ Screen.TwipsPerPixelY
   
 '补写代码地方    ReleaseDC 0, hDC
    
    picCopy.AutoRedraw = False
    
    SetPicture
    Me.Show
End Sub

Answer 1

Option Explicit
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 GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As LongPrivate Sub mCopyScreen_Click()
    Dim hdc As Long, sx As Integer, sy As Integer
    
    Me.Hide
    DoEvents
    
    piccopy.Width = Screen.Width
    piccopy.Height = Screen.Height
    
    piccopy.AutoRedraw = True
    
    hdc = GetDC(0)
    sx = Screen.Width \ Screen.TwipsPerPixelX
    sy = Screen.Height \ Screen.TwipsPerPixelY
   
    '补写代码地方
    BitBlt piccopy.hdc, 0, 0, sx, sy, hdc, 0, 0, SRCCOPY
    ReleaseDC 0, hdc
    
    piccopy.AutoRedraw = False
    
    'SetPicture
    Me.ShowEnd Sub

Answer 2

BitBlt piccopy.hdc, 0, 0, sx, sy, hdc, 0, 0, SRCCOPY
这一句是补写，前面的是铺垫