スクリーンショット(U) <TOP>
BitBlt
ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
StretchBlt 拡縮をともなうグラフィックデバイス間のイメージを転送
SetStretchBltMode 指定されたデバイスコンテキストのビットマップ伸縮モードを設定
GetDesktopWindow Windowsのデスクトップウィンドウを識別
GetDC 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
GetWindowDC ウィンドウ全体のデバイスコンテキストを取得
ReleaseDC デバイスコンテキストを解放
ディスプレイ解像度(左:1680x1050 右:1024x768)
'================================================================ '= スクリーンショット(U) '= (BitBlt3.bas) '================================================================ #include "Windows.bi" ' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー 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_StretchBlt& Lib "gdi32" Alias "StretchBlt" (ByVal hDC&, ByVal X&, ByVal Y&, ByVal nWidth&, ByVal nHeight&, ByVal hSrcDC&, ByVal xSrc&, ByVal ySrc&, ByVal nSrcWidth&, ByVal nSrcHeight&, ByVal dwRop&) ' 指定されたデバイスコンテキストのビットマップ伸縮モードを設定 Declare Function Api_SetStretchBltMode& Lib "gdi32" Alias "SetStretchBltMode" (ByVal hDC&, ByVal nStretchMode&) ' Windowsのデスクトップウィンドウを識別。返されるポインタは、一時的なポインタ。後で使用するために保存しておくことはできない Declare Function Api_GetDesktopWindow& Lib "user32" Alias "GetDesktopWindow" () ' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得 Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&) ' ウィンドウ全体のデバイスコンテキストを取得 Declare Function Api_GetWindowDC& Lib "user32" Alias "GetWindowDC" (ByVal hWnd&) ' デバイスコンテキストを解放 Declare Function Api_ReleaseDC& Lib "user32" Alias "ReleaseDC" (ByVal hWnd&, ByVal hDC&) #define SRCCOPY &HCC0020 'そのまま転送 #define COLORONCOLOR 3 '取り除く点の情報を保存することなく削除 Var Shared Picture1 As Object Var Shared Check1 As Object Var Shared Button1 As Object Picture1.Attach GetDlgItem("Picture1") Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14 Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14 '================================================================ '= '================================================================ Declare Sub PrintScreen () Sub PrintScreen() Var phDC As Long Var hDesk As Long Var dhDC As Long Var Ret As Long phDC = Api_GetDC(Picture1.GethWnd) hDesk = Api_GetDesktopWindow() dhDC = Api_GetWindowDC(hDesk) If Check1.GetCheck = 1 Then Ret = Api_SetStretchBltMode(phDC, COLORONCOLOR) Ret = Api_StretchBlt(phDC, 0, 0, Picture1.GetWidth, Picture1.GetHeight, dhDC, 0, 0, GetDeviceCaps(8), GetDeviceCaps(10), SRCCOPY) Else Ret = Api_BitBlt(phDC, 0, 0, Picture1.GetWidth, Picture1.GetHeight, dhDC, 0, 0, SRCCOPY) End If Ret = Api_ReleaseDC(Picture1.GethWnd, phDC) End Sub '================================================================ '= '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var sx As Single Var sy As Single Var wpx As Single Var rsy As Single sx = GetDeviceCaps(8) sy = GetDeviceCaps(10) rsy = sy / sx wpx = Picture1.GetWidth Picture1.SetWindowSize wpx, wpx * rsy PrintScreen End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End