デスクトップの画面を取得する

<戻る

ここに載せてあるソースコードは、参考のために載せてあります

サンプルコードは、一番下にLZHとしてあります




Option Explicit

'早い話が下のようにするとデスクトップの画面を取得できます
'
'Picture1.ScaleMode=vbPixels
'BitBlt Picture1.hDC,0,0,Picture1.ScaleWidth,Picture1.ScaleHeight ,GetDC(GetDesktopWindow),0,0,vbsrccopy



'[API]

'デスクトップのhWndを取得する
Private Declare Function GetDesktopWindow Lib "user32" () As Long

'hWndをhDCにする
Private Declare Function GetDC Lib "user32" (ByVal hwnd 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 Sub Form_Load()
    'プロパティの初期設定をする
    'スクリーンの大きさを設定します
    Picture2.ScaleWidth = 1024
    Picture2.ScaleHeight = 768
    '
    Picture1.BackColor = vbBlack
    Picture2.BackColor = vbBlack
End Sub

'Picture2上でマウスが移動しました
Private Sub Picture2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lngScaleWidth1  As Long
    Dim lngScaleHeight1 As Long
    Dim lngScaleWidth2  As Long
    Dim lngScaleHeight2 As Long
    Dim lngDesktopHDC   As Long
    Dim lngSrcX         As Long
    Dim lngSrcY         As Long
    
    If Button = vbLeftButton Then
        'デスクトップのhWndを取得して
        'それからhDCを取得します
        lngDesktopHDC = GetDC(GetDesktopWindow)
        'よく使うプロパティの変数に代入をします
        lngScaleWidth1 = Picture1.ScaleWidth
        lngScaleHeight1 = Picture1.ScaleHeight
        lngScaleWidth2 = Picture2.ScaleWidth
        lngScaleHeight2 = Picture2.ScaleHeight
        
        'Picture1の画面をクリアにします
        Picture1.Cls
        'Picture1とPicture2の比率を計算して位置を算出します
        lngSrcX = X - (lngScaleWidth1 / lngScaleWidth2) * lngScaleWidth2
        lngSrcY = Y - (lngScaleHeight1 / lngScaleHeight2) * lngScaleHeight2
        '実際に描画します
        BitBlt Picture1.hDC, 0, 0, lngScaleWidth2, lngScaleHeight2, lngDesktopHDC, lngSrcX, lngSrcY, vbSrcCopy
        Picture1.Refresh
        
        'デスクトップのどの範囲を取得しているかを
        'Picture2で表示します
        Picture2.Cls
        Picture2.Line (lngSrcX, lngSrcY)-Step(lngScaleWidth1, lngScaleHeight1), vbWhite, BF
    End If
End Sub




<戻る

Sample70.lzh


http://hp.vector.co.jp/authors/VA015521/