デスクトップイメージをフォームに転送          <TOP>


デスクトップイメージをフォームに転送します。

BitBlt ビットブロック転送

GetDesktopWindow ウィンドウハンドルを取得する関数

GetCursorPos マウスカーソル位置を取得する

GetDC ウィンドウのデバイスコンテキストのハンドルを取得する関数

ReleaseDC デバイスコンテキストの開放

 

デスクトップ上のマウス座標を左上としたイメージをフォームに転送します。

 

'================================================================
'= デスクトップの画像をフォームに転送
'=    (DesktopImageToForm.bas)
'================================================================
#include "Windows.bi"

'点を示すタイプ
Type POINTAPI
    X As Long
    Y As Long
End Type

' ビットブロック転送
Declare Function Api_BitBlt& Lib "gdi32" Alias "BitBlt" (ByVal hDestDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal dwRop&)

' ウィンドウハンドルを取得する関数
Declare Function Api_GetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" ()

'マウスカーソル位置を取得する
Declare Function Api_GetCursorPos& Lib "user32" Alias "GetCursorPos" (lpPoint As POINTAPI)

' ウィンドウのデバイスコンテキストのハンドルを取得する関数
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

' デバイスコンテキストの開放
Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&)

#define SRCCOPY &HCC0020                       'コピー元をそのままコピー

Var Shared Timer1 As Object
Timer1.Attach GetDlgItem("Timer1")

'================================================================
'= 
'================================================================
Declare Sub Mainform_Start edecl ()
Sub Mainform_Start()
    Timer1.SetInterval 10
    Timer1.Enable -1
End Sub

'================================================================
'= 画面のイメージをフォームにコピー
'================================================================
Declare Sub Timer1_Timer edecl ()
Sub Timer1_Timer()
    Var mXY As POINTAPI
    Var dTophWnd As Long
    Var dTopDC As Long
    Var FormDC As Long
    Var Ret As Long

    dTophWnd = Api_GetDesktopWindow()          'デスクトップハンドル取得
    dTopDC = Api_GetDC(dTophWnd)               'デスクトップデバイスコンテキスト取得
    FormDC = Api_GetDC(GethWnd)                'フォームデバイスコンテキスト取得
    Ret = Api_GetCursorPos(mXY)
    If mXY.X > GetDeviceCaps(8) - GetClientWidth Then mXY.X = GetDeviceCaps(8) - GetClientWidth
    If mXY.Y > GetDeviceCaps(10) - GetClientHeight Then mXY.Y = GetDeviceCaps(10) - GetClientHeight

    Ret = Api_BitBlt(FormDC, 0, 0, GetClientWidth, GetClientHeight, dTopDC, mXY.X, mXY.Y, SRCCOPY)
    Ret = Api_ReleaseDC(dTophWnd, dTopDC)
    Ret = Api_ReleaseDC(GethWnd, FormDC)
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End