tagCANDY CGI VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
VBレスキュー(花ちゃん)の Visual Basic 6.0用 掲示板
[ツリー表示へ]  [ワード検索]  [Home]

タイトル Re^4: GetDIbitsの使用方法について
投稿日: 2014/03/16(Sun) 21:31
投稿者魔界の仮面弁士
> ここまでの段階で、認識にズレはありますか?
続き:


では、AutoRedraw を使わずにメモリデバイスコンテキストを
用意するにはどうすれば良いでしょうか。
それには CreateCompatibleDC 関数を使います。

CreateCompatibleDC を使うと、指定されたデバイスと互換性のある
メモリデバイスコンテキストを作成することができます。

'=======================
' Sample 5:CreateCompatibleDC の生成
'-----------------------
Option Explicit
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE) As OLE_HANDLE
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Dim h1 As OLE_HANDLE, h2 As OLE_HANDLE
    h1 = GetDC(Picture1.hWnd)
    h2 = GetDC(Picture2.hWnd)

    Dim h3 As OLE_HANDLE, h4 As OLE_HANDLE
    h3 = CreateCompatibleDC(h1)
    h4 = CreateCompatibleDC(h2)

    DrawIcon h3, 0, 0, Me.Icon.Handle
    DrawIcon h4, 0, 0, Me.Icon.Handle

    DeleteObject h3
    DeleteObject h4

    ReleaseDC Picture1.hWnd, h1
    ReleaseDC Picture2.hWnd, h2
End Sub
' Picture1: 描画× 再描画×
' Picture2: 描画× 再描画×
'-----------------------

ちなみに、上記を実行しても何も表示されません。

なぜ表示されないのかを理解するには、
「AutoRedraw で管理されているメモリデバイスコンテキスト」

「CreateCompatibleDC で生成したメモリデバイスコンテキスト」
の違いを認識する必要があります。


まずひとつは、ここで生成したメモリデバイスコンテキストは、
画面描画とは無関係ということです。新たに生成したものだから当然ですね。


もうひとつは、作成されたばかりのメモリデバイスコンテキストは、
横×縦=1×1ドットの、モノクロ(1bit)ビットマップが『選択』された
状態であり、そのままでは使いものにならないということです。


このため、必要な幅、高さ、色の編成方法を指定してビットマップを作成し、
それを選択し直す必要があります。
その選択方法とは、既に御存知の SelectObjct API です。


問題となるのは、どうやってそのビットマップを用意するのか、という点ですが、
その方法の一つが、こちらも御存知の CreateCompatibleBitmap です。
これにより、PictureBox と互換性のあるビットマップを簡単に用意できます。

 メモリDC = CreateCompatibleDC(元のhDC)
 メモリBmp = CreateCompatibleBitmap(元のhDC, x, y)
 直前に選択されていたオブジェクト = SelectObject(メモリDC, メモリBmp)

上記 3 行目の SelectObject が、「元のhDC」に対してではなく、
「メモリDC」に対して行われていることに注意してください。



'=======================
' Sample 6:SelectObject での選択
'-----------------------
Option Explicit
Private Declare Function SelectObject Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hObject As OLE_HANDLE) As OLE_HANDLE
Private Declare Function CreateCompatibleBitmap Lib "gdi32" _
   (ByVal hDC As OLE_HANDLE, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long) As OLE_HANDLE
Private Declare Function CreateCompatibleDC Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE) As OLE_HANDLE
Private Declare Function GetDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE) As OLE_HANDLE
Private Declare Function ReleaseDC Lib "user32" _
    (ByVal hWnd As OLE_HANDLE, _
    ByVal hDC As OLE_HANDLE) As Long
Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long
Private Declare Function DrawIcon Lib "user32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal x As Long, _
    ByVal y As Long, _
    ByVal hIcon As OLE_HANDLE) As Long
Private Sub Form_Load()
    Picture1.AutoRedraw = True
    Picture2.AutoRedraw = False
    Picture1.ScaleMode = vbPixels
    Picture2.ScaleMode = vbPixels
End Sub

Private Sub Command1_Click()
    Dim h1 As OLE_HANDLE, h2 As OLE_HANDLE
    h1 = GetDC(Picture1.hWnd)
    h2 = GetDC(Picture2.hWnd)

    Dim h3 As OLE_HANDLE, h4 As OLE_HANDLE
    h3 = CreateCompatibleDC(h1)
    h4 = CreateCompatibleDC(h2)

    Dim hBmp1 As OLE_HANDLE, hBmp2 As OLE_HANDLE
    hBmp1 = CreateCompatibleBitmap(h3, Picture1.ScaleWidth, Picture1.ScaleHeight)
    hBmp2 = CreateCompatibleBitmap(h4, Picture2.ScaleWidth, Picture2.ScaleHeight)

    Dim hObj1 As OLE_HANDLE, hObj2 As OLE_HANDLE
    hObj1 = SelectObject(h3, hBmp1)   'hObj1 は 非ゼロ となるべき
    hObj2 = SelectObject(h4, hBmp2)   'hObj1 は 非ゼロ となるべき

    DrawIcon h3, 0, 0, Me.Icon.Handle
    DrawIcon h4, 0, 0, Me.Icon.Handle

    Dim hObj3 As OLE_HANDLE, hObj4 As OLE_HANDLE
    hObj3 = SelectObject(h3, hObj1)   'hObj3 は hBmp1 と同じ値になるはず
    hObj4 = SelectObject(h4, hObj2)   'hObj4 は hBmp2 と同じ値になるはず

    DeleteObject hBmp1
    DeleteObject hBmp2

    DeleteObject h3
    DeleteObject h4

    ReleaseDC Picture1.hWnd, h1
    ReleaseDC Picture2.hWnd, h2
End Sub
' Picture1: 描画× 再描画×
' Picture2: 描画× 再描画×
'-----------------------

だんだん長くなってきて大変ですが、重要なのはこの点。
 hObj1 = SelectObject(h3, hBmp1)
 hObj2 = SelectObject(h4, hBmp2)

これをもし、
 hObj1 = SelectObject(h3, hBmp1)
 hObj2 = SelectObject(h4, hBmp1)
としてしまうと、hObj2 は 0 になります。
既に hBmp1 は h3 で使用中だからです。

また、上記を
 hObj1 = SelectObject(h1, hBmp1)
 hObj2 = SelectObject(h2, hBmp1)
とすることもできません。これだと、ともに 0 になってしまいます。


この違いが、
 ' No15862
 ohbm = SelectObject(.Controls("Picture1").hdc, hbm)
 Debug.Print ohbm  ←※ゼロ以外の数値が表示されます
の結果と、
 ' No15851
 ohbm = SelectObject(Frame1DC, hbm)
 Debug.Print ohbm  '← 0 がPrintされる = Error?
の結果に現れてきていますね。

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。