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

タイトル ： Re: GetDIbitsの使用方法について
投稿日： 2014/03/15(Sat) 18:23
投稿者： 魔界の仮面弁士
スレッドが深くなってきたので、仕切りなおして：

> 環境：WndowsXP SP3 VB6
> Frameの代わりにPictureBoxを使用するとうまくいきますが

上記について、現象を再現可能なコードを提示できますか?


WinXP 環境が無く、Win7 で検証したためなのかもしれませんが、
当方では相手が PictureBox であろうと Frame であろうと、
GetDC に対して SelectObject した場合にはゼロが返されました。


GetDC API で得た hDC を使うのではなく、PictureBox1.hDC に対して SelectObject するのなら、
(AutoRedraw = True なときのみ)非ゼロを返してきましたが…。



Option Explicit

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 SelectObject Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hObject As OLE_HANDLE) As OLE_HANDLE

Private Enum DIB
    RGB_COLORS = 0
    PAL_COLORS = 1
    PAL_INDICES = 2
End Enum

Private Declare Function GetDIBits Lib "gdi32" _
    (ByVal hDC As OLE_HANDLE, _
    ByVal hBmp As OLE_HANDLE, _
    ByVal uStartScan As Long, _
    ByVal cScanLines As Long, _
    ByRef lpvBits As Any, _
    ByRef lpbi As Any, _
    ByVal wUsage As DIB) As Long

Private Declare Function DeleteObject Lib "gdi32" _
    (ByVal hObject As OLE_HANDLE) As Long

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 GetDesktopWindow Lib "user32" () As OLE_HANDLE

Private Declare Function BitBlt Lib "gdi32" _
    (ByVal hdcDest As OLE_HANDLE, _
    ByVal nXDest As Long, _
    ByVal nYDest As Long, _
    ByVal nWidth As Long, _
    ByVal nHeight As Long, _
    ByVal hdcSrc As OLE_HANDLE, _
    ByVal nXSrc As Long, _
    ByVal nYSrc As Long, _
    ByVal dwRop As RasterOpConstants) As Long


Private Type BITMAPINFOHEADER
    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

Private Type RGBQUAD
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End Type

Private Type BITMAPINFO
    bmiHeader As BITMAPINFOHEADER
    bmiColors(255) As RGBQUAD
End Type

Private Sub Command1_Click()
    Dim F_Hnd     As OLE_HANDLE
    Dim Frame1DC  As OLE_HANDLE
    Dim D_Hnd     As OLE_HANDLE
    Dim D_hDC     As OLE_HANDLE

    F_Hnd = Me.Frame1.hWnd
    Frame1DC = GetDC(F_Hnd)

    D_Hnd = GetDesktopWindow()
    D_hDC = GetDC(D_Hnd)

    BitBlt Frame1DC, 0, 0, Me.Frame1.Width, Me.Frame1.Height, D_hDC, 400, 400, vbSrcCopy

    ReleaseDC D_Hnd, D_hDC
    ReleaseDC F_Hnd, Frame1DC
End Sub

Private Sub Command2_Click()
    Me.ScaleMode = vbPixels

    '32ビットカラーの場合
    Dim bmpinfo As BITMAPINFO
    With bmpinfo.bmiHeader
        .biSize = Len(bmpinfo.bmiHeader)
        .biWidth = Me.Frame1.Width
        .biHeight = Me.Frame1.Height
        .biPlanes = 1
        .biBitCount = 32
        .biCompression = 0
        .biSizeImage = .biWidth * .biHeight * 4
        .biClrUsed = 0
    End With

    Dim pixel() As RGBQUAD

    Dim F_Hnd As OLE_HANDLE
    F_Hnd = Me.Frame1.hWnd

    Dim Frame1DC As OLE_HANDLE
    Frame1DC = GetDC(F_Hnd)

    Dim hbm As OLE_HANDLE
    hbm = CreateCompatibleBitmap(Frame1DC, bmpinfo.bmiHeader.biWidth, bmpinfo.bmiHeader.biHeight)
    Debug.Print hbm

    Dim ohbm As OLE_HANDLE
    ohbm = SelectObject(Frame1DC, hbm)
    Debug.Print ohbm

    ReDim pixel(Me.Frame1.Width * Me.Frame1.Height)
    GetDIBits Frame1DC, ohbm, 0, bmpinfo.bmiHeader.biHeight, pixel(0), bmpinfo, DIB.RGB_COLORS

    SelectObject Frame1DC, ohbm

    DeleteObject hbm
    ReleaseDC F_Hnd, Frame1DC
End Sub
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

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