対象ウィンドウを無理矢理アクティブにしなければならないので、いささか強引。その辺は各自で修正してください。
'矩形の位置などを格納する Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type
'アクティブウインドウのハンドルを取得する
'ウインドウの位置、サイズを取得する
'Windowのデバイスコンテキストを取得する
'ビットマップを転送する
'デバイスコンテキストを解放する
'指定のウインドウをアクティブなウインドウにする
'待ち時間を設定する
'--------------------------------------------------------------- ' 関数名: CaptureWindow ' 機能 : 指定ウィンドウをキャプチャーする ' 引数 : (in)hTargetWnd … キャプチャーするウィンドウのハンドル ' 返り値: 正常:0以外、 エラー:0 '--------------------------------------------------------------- Public Function CaptureWindow(ByVal hTargetWnd As Long, ByVal hDestDC As Long) As Long Dim udtRect As RECT Dim hTargetDC As Long 'ウインドウをアクティブにする Call SetForegroundWindow(hTargetWnd) Call Sleep(50) 'ちょいと時間稼ぎ 'ウインドウのサイズを得る Call GetWindowRect(hTargetWnd, udtRect) 'ウインドウのデバイスコンテキストを得る hTargetDC = GetWindowDC(hTargetWnd) '転送 With udtRect Call BitBlt(hDestDC, 0, 0, .Right - .Left, .Bottom - .Top, hTargetDC, 0, 0, vbSrcCopy) End With 'デバイスコンテキストを解放する CaptureWindow = ReleaseDC(hTargetWnd, hTargetDC) End Function 以下は呼び出し側のコード。第1引数のハンドルはどうにか入手してください。Spy++あたりがあればいいかな。
Private Sub Form_Load() Me.AutoRedraw = True Call CaptureWindow(&H605C2, Me.hdc) Me.Refresh End Sub |