Option Explicit

Private Type RECT
    Left    As Long
    Top     As Long
    Right   As Long
    Bottom  As Long
End Type

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 Long
Private Declare Function GetDesktopWindow Lib "user32" () 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 Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
'Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long


'ボタンをクリックしました
Private Sub Command1_Click()
    Dim hWndTask    As Long
    Dim hDCTask     As Long
    Dim lpRect      As RECT
    
    'タスクトレイのコンテナである
    'Shell_TrayWndのウィンドウハンドルを取得します
    hWndTask = FindWindowEx(GetDesktopWindow, 0&, "Shell_TrayWnd", vbNullString)
    'Shell_TrayWndからタスクトレイのウィンドウハンドルを取得します
    hWndTask = FindWindowEx(hWndTask, 0&, "TrayNotifyWnd", vbNullString)
    
    'ウィンドウハンドルの取得に失敗したら
    'メッセージボックスで知らせます
    If hWndTask = 0 Then
        MsgBox "取得に失敗しました", vbCritical
        Exit Sub
    End If
    
    'クライアント領域を取得します
    GetWindowRect hWndTask, lpRect
    'hWndからhDCを取得します
    hDCTask = GetDC(hWndTask)
    'ピクチャボックスに
    'タスクトレイの状態を描画を行います
    BitBlt Picture1.hdc, 0, 0, lpRect.Right, lpRect.Bottom, hDCTask, 0, 0, vbSrcCopy
    Picture1.Refresh
    'GetDCを使ったので解放します
    ReleaseDC hWndTask, hDCTask
End Sub