スクリーンショット(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