'================================================================
'= デスクトップイメージを転送
'=    (SetDIBitsToDevice.bas)
'================================================================
#include "Windows.bi"

#define BI_RGB 0                        '非圧縮
#define DIB_RGB_COLORS 0                'RGBカラーテーブル
#define SRCCOPY &HCC0020                'そのまま転送

Type BITMAPINFOHEADER                   '40バイト
    biSize          As Long             'イメージ バッファのバイト数
    biWidth         As Long             '幅
    biHeight        As Long             '高さ
    biPlanes        As Integer          '常に1
    biBitCount      As Integer          '1ピクセルあたりのカラービット数
    biCompression   As Long             '圧縮方法
    biSizeImage     As Long             'ピクセルデータの全バイト数
    biXPelsPerMeter As Long             '0または水平解像度
    biYPelsPerMeter As Long             '0または垂直解像度
    biClrUsed       As Long             'ビットマップを表示するための色数(0)
    biClrImportant  As Long             'ビットマップを表示するための重要な色数(0)
End Type

Type RGBQUAD
    rgbBlue     As Byte                 '青の輝度
    rgbGreen    As Byte                 '緑の輝度
    rgbRed      As Byte                 '赤の輝度
    rgbReserved As Byte                 '予約(常に0)
End Type

Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors As RGBQUAD                '256色の場合、bmiColors(255) As RGBQUADとする
End Type

' 指定されたデバイスコンテキストに関連するデバイスと互換性のあるメモリデバイスコンテキストを作成
Declare Function Api_CreateCompatibleDC& Lib "gdi32" Alias "CreateCompatibleDC" (ByVal hDC&)

' アプリケーションから直接書き込むことのできるDIBを作成
Declare Function Api_CreateDIBSection& Lib "gdi32" Alias "CreateDIBSection" (ByVal hDC&, pBitmapInfo As BITMAPINFO, ByVal un&, ByVal lplpVoid&, ByVal handle&, ByVal dw&)

' DIBのピクセルデータを取得
Declare Function Api_GetDIBits& Lib "gdi32" Alias "GetDIBits" (ByVal aHDC&, ByVal hBitmap&, ByVal nStartScan&, ByVal nNumScans&, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage&)

' DIBをデバイスコンテキスト上の矩形領域に描画
Declare Function Api_SetDIBitsToDevice& Lib "gdi32" Alias "SetDIBitsToDevice" (ByVal hDC&, ByVal x&, ByVal y&, ByVal dx&, ByVal dy&, ByVal SrcX&, ByVal SrcY&, ByVal Scan&, ByVal NumScans&, Bits As Any, BitsInfo As BITMAPINFO, ByVal wUsage&)

' 指定されたデバイスコンテキストのオブジェクトを選択
Declare Function Api_SelectObject& Lib "gdi32" Alias "SelectObject" (ByVal hDC&, ByVal hObject&)

' 指定されたデバイスコンテキストを削除
Declare Function Api_DeleteDC& Lib "gdi32" Alias "DeleteDC" (ByVal hDC&)

' ペン、ブラシ、フォント、ビットマップ、リージョン、パレットのいずれかの論理オブジェクトを削除し、そのオブジェクトに関連付けられていたすべてのシステムリソースを解放。オブジェクトを削除した後は、指定されたハンドルは無効になる
Declare Function Api_DeleteObject& Lib "gdi32" Alias "DeleteObject" (ByVal hObject&)

' ビットブロック転送を行う。コピー元からコピー先のデバイスコンテキストへ、指定された長方形内の各ピクセルの色データをコピー
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_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

Var Shared Button1 As Object

Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

Var Shared iBitmap As Long
Var Shared iDC As Long

ShowWindow -1
Cls

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var hDC As Long
    Var bi As BITMAPINFO
    Var Cnt As Long
    Var Ret As Long

    hDC = Api_GetDC(GethWnd)

    bi.bmiHeader.biSize = Len(bi.bmiHeader)
    bi.bmiHeader.biWidth = 300
    bi.bmiHeader.biHeight = 250
    bi.bmiHeader.biPlanes = 1
    bi.bmiHeader.biBitCount = 24
    bi.bmiHeader.biCompression = BI_RGB

    '幅 * 高さ * 3(RGB)
    Var bBytes(bi.bmiHeader.biWidth * bi.bmiHeader.biHeight * 3) As Byte

    '「0」の場合、ディスプレイのデバイスコンテキスト
    iDC = Api_CreateCompatibleDC(0)
    iBitmap = Api_CreateDIBSection(iDC, bi, DIB_RGB_COLORS, ByVal 0, ByVal 0, ByVal 0)

    Ret = Api_SelectObject(iDC, iBitmap)
    Ret = Api_BitBlt(iDC, 0, 0, bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, Api_GetDC(0), 0, 0, SRCCOPY)
    Ret = Api_GetDIBits(iDC, iBitmap, 0, bi.bmiHeader.biHeight, bBytes(1), bi, DIB_RGB_COLORS)

    For Cnt = 1 To (bi.bmiHeader.biWidth * bi.bmiHeader.biHeight * 3)
        If bBytes(Cnt) < 50 Then
            bBytes(Cnt) = 0
        Else
            bBytes(Cnt) = bBytes(Cnt) - 50
        End If
    Next Cnt

    Ret = Api_SetDIBitsToDevice(hDC, 0, 0, bi.bmiHeader.biWidth, bi.bmiHeader.biHeight, 0, 0, 0, bi.bmiHeader.biHeight, bBytes(1), bi, DIB_RGB_COLORS)

    Ret = Api_DeleteDC(iDC)
    Ret = Api_DeleteObject(iBitmap)
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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