'================================================================
'=　スクリーンショットを平行四辺形で表示

'=    (Windows2000以降)

'================================================================
#include "Windows.bi"

#define BI_RGB 0
#define DIB_RGB_COLORS 0       'ＲＧＢカラーテーブル
#define DIB_PAL_COLORS 1       'パレットカラーテーブル
#define PATCOPY &HF00021
#define PATINVERT &H5A0049
#define PATPAINT &HFB0A09

Type POINTAPI
    x As Long
    y As Long
End Type

Type BITMAPINFOHEADER          '40バイト
    biSize          As Long
    biWidth         As Long
    biHeight        As Long
    biPlanes        As Integer
    biBitCount      As Integer
    biCompression   As Long
    biSizeImage     As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed       As Long
    biClrImportant  As Long
End Type

Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
End Type

Type tBITMAP
    Header    As BITMAPINFO
    Bytes(63) As byte
End Type

' DIBとして定義されたパターンの論理ブラシを作成
Declare Function Api_CreateDIBPatternBrushPt& Lib "gdi32" Alias "CreateDIBPatternBrushPt" (lpPackedDIB As Any, ByVal iUsage&)

' 転送元DCの指定された四角形から、指定されたDCの指定した平行四辺形へ、カラーデータのビットブロック転送を行う
Declare Function Api_PlgBlt& Lib "gdi32" Alias "PlgBlt" (ByVal hdcDest&, lpPoint As POINTAPI, ByVal hdcSrc&, ByVal nXSrc&, ByVal nYSrc&, ByVal nWidth&, ByVal nHeight&, ByVal hbmMask&, ByVal xMask&, ByVal yMask&)

' ビットパターンを作成
Declare Function Api_PatBlt& Lib "gdi32" Alias "PatBlt" (ByVal hDC&, ByVal x&, ByVal y&, ByVal nWidth&, ByVal nHeight&, ByVal dwRop&)

' 指定されたウィンドウのクライアント領域または画面全体を表すディスプレイデバイスコンテキストのハンドルを取得
Declare Function Api_GetDC& Lib "user32" Alias "GetDC" (ByVal hWnd&)

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

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

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

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    cls
    Var hBrush As Long
    Var tBr As tBITMAP
    Var hOld As Long
    Var Pt(2) As POINTAPI
    Var Ret As Long
    Var hDC As Long

    '平行四辺形の傾き指定
    Pt(0).x = Val(GetDlgItemText("Edit1"))                      '左上x(可変)
    Pt(0).y = Val(GetDlgItemText("Edit2"))                      ' 〃 y(可変)
    Pt(1).x = 300                                               '右上x
    Pt(1).y = 0                                                 ' 〃 y
    Pt(2).x = 0                                                 '左下x
    Pt(2).y = 300                                               ' 〃 y

    hDC = Api_GetDC(GethWnd)                                    'フォームのデバイスコンテキスト
    'スクリーンショットのリサイズ
    Ret = Api_PlgBlt(hDC, Pt(0), Api_GetDC(0), 0, 0, GetDeviceCaps(8), GetDeviceCaps(10), ByVal 0&, ByVal 0&, ByVal 0&)

    'tBITMAP構造体の初期化
    tBr.Header.bmiHeader.biSize = Len(tBr.Header.bmiHeader)
    tBr.Header.bmiHeader.biCompression = BI_RGB
    tBr.Header.bmiHeader.biHeight = 8
    tBr.Header.bmiHeader.biPlanes = 1
    tBr.Header.bmiHeader.biWidth = 8
    tBr.Header.bmiHeader.biBitCount = 1

    For i = 0 To 7
        tBr.Bytes(i) = 128
    Next i

    hBrush = Api_CreateDIBPatternBrushPt(tBr, DIB_RGB_COLORS)   'パターンブラシ作成
    hOld = Api_SelectObject(hDC, hBrush)                        'フォームDCに対するBRUSH選択
    Ret = Api_PatBlt(hDC, 0, 0, 30, 30, PATCOPY)                'パターンブロック転送
    Ret = Api_DeleteObject(Api_SelectObject(hDC, hOld))         'パターンブラシを元に戻す
    Ret = Api_ReleaseDC(GethWnd, hDC)
End Sub

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