デバイスコンテキスト関連

デバイスコンテキスト関連2012.11.23

デバイスコンテキスト（以下DC）とは、ディスプレイやプリンタなどの表示デバイスと、アプリケーションの仲介を行うWindowsの仕組みです。Windowsアプリケーションは、特定のデバイスを意識しなくとも、このDCに対して描画を行なえばよいのです。
VBAでは、Win32APIなどを用いフォームに描写したり、画像を扱う際に使用することがあります。
ここでは、デバイスコンテキストのハンドル取得に関する、サンプルコードとメモを記載します。

【お薦め】マクロ・プロシージャを管理する無料のツール！
　Excelマクロ管理ツール

ポイント

・GetDC関数（Win32API）
・GetWindowDC関数（Win32API）
・ReleaseDC関数（Win32API）
・CreateCompatibleDC関数（Win32API）
・DeleteDC関数（Win32API）

DCのハンドルを取得したら、解放、作成したら、削除しなければならない。
GetDC、GetWindowDC関数の後はReleaseDC関数で解放、また、CreateCompatibleDC関数でデバイスコンテキストを作った場合は、これをDeleteDC関数で削除する。

サンプルコード

次はDC関連のWin32API関数のサンプルコードである。VBAでWin32APIを宣言する場合、「宣言セクション」（各モジュールの最上部）に記述しなければならない。
DC関連の関数の返り値は、関数が成功するとハンドル番号、失敗すると「0」を返す。

●64ビットOfficeへの対応
Win32APIの使用時に気をつけることは、64ビット版のOfficeへの対応である。対応させるためには重要な点が2つある。
1つ目は、Declare の後に、Ptrsafe 属性を設定すること。2つ目は、変数の型の変更。分岐によって、32ビット用の宣言と、64ビット用の宣言を行うことで、互換性を持たすことができる。次は、分岐による関数宣言例である（宣言セクションに記述）。

#If VBA7 Then
    Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr '64bit
#Else
    Declare Function GetActiveWindow Lib "user32" () As Long
#End If

パソコン環境によっては、上記コードの一部が赤く表示されることもあるが、動作に問題はなくコードを実行できる。

GetDC・ReleaseDC関数

指定したウィンドウのDCの取得・解放

【宣言】

#If VBA7 Then
    '64ビット
    Declare PtrSafe Function GetDC Lib "user32" ( _
        ByVal hwnd As LongPtr) As LongPtr
    Declare PtrSafe Function ReleaseDC Lib "user32" ( _
        ByVal hwnd As LongPtr, _
        ByVal hDC As LongPtr) As Long
#Else
    Declare Function GetDC Lib "user32" ( _
        ByVal hwnd As Long) As Long
    Declare Function ReleaseDC Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal hDC As Long) As Long
#End If

hwnd・・・ウィンドウハンドル
hDC・・・既定のデバイスコンテキストハンドル
GetDC関数の引数に「0」を指定すると、スクリーン全体のDCハンドルを取得する。
ウィンドウのハンドルを指定した場合、そのウィンドウのクライアント領域のDCハンドルを取得する。

【使用例１】

Sub Get_DC_1()
    Dim hDC As Long
    hDC = GetDC(0)
    MsgBox hDC 'スクリーン全体のDCハンドル
    Call ReleaseDC(0, hDC)
End Sub

【使用例２】
　次は、ユーザーフォームにスクリーンの一部を描写するサンプル。

予めユーザーフォームを挿入し、フォームのモジュールに以下のコードを貼り付ける。
フォームを表示した後、クリックすると、画像が描写される。

#If VBA7 Then
    Private Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetDC Lib "user32" ( _
        ByVal hwnd As LongPtr) As LongPtr
    Private Declare PtrSafe Function ReleaseDC Lib "user32" ( _
        ByVal hwnd As LongPtr, _
        ByVal hDC As LongPtr) As Long
    Private Declare PtrSafe Function BitBlt Lib "gdi32" ( _
        ByVal hDC As LongPtr, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal w As Long, _
        ByVal h As Long, _
        ByVal hdcS As LongPtr, _
        ByVal xS As Long, _
        ByVal yS As Long, _
        ByVal dwRop As Long) As Long
#Else
    Private Declare Function GetActiveWindow Lib "user32" () As Long
    Private Declare Function GetDC Lib "user32" ( _
        ByVal hwnd As Long) As Long
    Private Declare Function ReleaseDC Lib "user32" ( _
        ByVal hwnd As Long, _
        ByVal hDC As Long) As Long
    Private Declare Function BitBlt Lib "gdi32" ( _
        ByVal hDC As Long, _
        ByVal x As Long, _
        ByVal y As Long, _
        ByVal w As Long, _
        ByVal h As Long, _
        ByVal hdcS As Long, _
        ByVal xS As Long, _
        ByVal yS As Long, _
        ByVal dwRop As Long) As Long
#End If
'BitBlt　ラスタオペレーション
Private Const SRCCOPY = &HCC0020 'コピー元をそのままコピー先にコピー

Private Sub UserForm_Click()
    Dim hDC As Long
    Dim fHwnd As Long
    Dim hfDC As Long
    hDC = GetDC(0) 'スクリーン全体のDCハンドルを取得
    fHwnd = GetActiveWindow() 'フォームのハンドル取得
    hfDC = GetDC(fHwnd) 'フォームのDCハンドルを取得
    'スクリーンの一部をフォームに描写
    Call BitBlt(hfDC, 0, 0, 200, 200, hDC, 0, 0, SRCCOPY)
    Call ReleaseDC(fHwnd, hfDC)
    Call ReleaseDC(0, hDC)
End Sub

CreateCompatibleDC・DeleteDC関数

ウィンドウと互換性のあるDCの作成・削除。ウィンドウのDCを直接使うのではなく、メモリ上にそのウィンドウと互換性のあるDCを作成し使う場合に使用する。

【宣言】

#If VBA7 Then
    '64ビット
    Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" ( _
        ByVal hDC As LongPtr) As LongPtr
    Declare PtrSafe Function DeleteDC Lib "gdi32" ( _
        ByVal hDC As LongPtr) As Long
#Else
    Declare Function CreateCompatibleDC Lib "gdi32" ( _
        ByVal hDC As Long) As Long
    Declare Function DeleteDC Lib "gdi32" ( _
        ByVal hDC As Long) As Long
#End If

hDC・・・既定のデバイスコンテキストハンドル
メモリデバイスコンテキストは、メモリ内にのみ存在する。
「0」を指定すると、現在のスクリーンと互換性のあるメモリデバイスコンテキストが作成される。
メモリDCを作成した時点では、その表示はモノクロームで、高さと幅は 1 × 1 ピクセル。
メモリDCを使って描画操作を行う前に、適切な幅と高さを備えたビットマップをメモリDCで選択しなければならない。

【使用例】

Sub Get_DC_2()
    Dim DC As Long
    DC = CreateCompatibleDC(0) 'スクリーンDCと互換性のあるDCを作成
    MsgBox DC 'スクリーンDCと互換性のある作成したDCのハンドル
    Call DeleteDC(DC)
End Sub

これらの関数を利用したコードは次を参照

トップ　>　備忘録　>　デバイスコンテキスト関連