デスクトップイメージをフォームに転送 <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