Memorandum

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

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

ポイント

・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ハンドルを取得する。

【使用例1】

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

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


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

#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

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

ページトップへ戻る
Copyright(C) 2009- 坂江 保 All Rights Reserved.