VB6でGdipCreateBitmapFromResource関数を使用するには？ (ID:87350)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

ども、何とか解決に近づいたので、現状報告と疑問点について質問させて下さい。

GdipCreateBitmapFromResource関数を諦め、以下の様にしました。
FindResource()、LoadResource()、LockResource()を使用し、メモリにリソースをロードする関数を作りました。
これで、LoadLibraryEx(szModuleName, 0, LOAD_LIBRARY_AS_DATAFILE)で得たモジュールのハンドルを使用しても失敗無くビットマップを表示できる様です。
この方法は、PNGやTIFF等のリソースも表示できるので、メモリにストリームを作ってGdipCreateBitmapFromStream関数に渡す様にしました。

ここからが質問です。
下記の自作関数CreateStreamOnResourceで作成したストリームをCommand1_Click()内の Set oStream = Nothing にてグローバルメモリを開放してるつもりです。
MSDNによると、CreateStreamOnHGlobal関数の第２引き数(fDeleteOnRelease)をTRUE(1)にした場合、ストリームを開放すると、自動的にグローバルメモリが開放される旨が書かれています。
この場合のストリームの開放とは、Set oStream = Nothing でいいでしょうか？
宜しくお願いします。

Option Explicit
Private m_lToken As Long

Private Type GdiplusStartupInput
    GdiplusVersion As Long
    DebugEventCallback As Long
    SuppressBackgroundThread As Long
    SuppressExternalCodecs As Long
End Type

Private Declare Function GdiplusStartup Lib "gdiplus" ( _
        token As Long, inputbuf As GdiplusStartupInput, _
        Optional ByVal outputbuf As Long = 0) As Long
Private Declare Function GdiplusShutdown Lib "gdiplus" ( _
        ByVal token As Long) As Long

Private Declare Function GdipCreateFromHDC Lib "gdiplus" ( _
        ByVal hdc As Long, graphics As Long) As Long
Private Declare Function GdipGetImageWidth Lib "gdiplus" ( _
        ByVal image As Long, Width As Long) As Long
Private Declare Function GdipGetImageHeight Lib "gdiplus" ( _
        ByVal image As Long, Height As Long) As Long
Private Declare Function GdipDrawImageRectI Lib "gdiplus" ( _
        ByVal graphics As Long, ByVal image As Long, _
        ByVal X As Long, ByVal Y As Long, _
        ByVal Width As Long, ByVal Height As Long) As Long
Private Declare Function GdipDeleteGraphics Lib "gdiplus" ( _
        ByVal graphics As Long) As Long
Private Declare Function GdipDisposeImage Lib "gdiplus" ( _
        ByVal image As Long) As Long

' Private Declare Function GdipLoadImageFromStream Lib "gdiplus" _
        (ByVal stream As Long, image As Long) As Long
Private Declare Function GdipCreateBitmapFromStream Lib "gdiplus" ( _
        ByVal stream As Long, bitmap As Long) As Long

Private Declare Function LoadLibraryEx Lib "kernel32" _
        Alias "LoadLibraryExA" (ByVal lpLibFileName As String, _
        ByVal hFile As Long, ByVal dwFlags As Long) As Long
Private Const LOAD_LIBRARY_AS_DATAFILE As Long = 2
' Private Const LOAD_WITH_ALTERED_SEARCH_PATH As Long = 8
Private Declare Function FreeLibrary Lib "kernel32" ( _
        ByVal hLibModule As Long) As Long

Private Declare Function FindResource Lib "kernel32" _
        Alias "FindResourceA" (ByVal hModule As Long, _
        ByVal lpName As String, ByVal lpType As String) As Long
Private Declare Function LoadResource Lib "kernel32" ( _
        ByVal hModule As Long, ByVal hResInfo As Long) As Long
Private Declare Function SizeofResource Lib "kernel32" ( _
        ByVal hModule As Long, ByVal hResInfo As Long) As Long
Private Declare Function LockResource Lib "kernel32" ( _
        ByVal hResData As Long) As Long
Private Declare Function FreeResource Lib "kernel32" ( _
        ByVal hResData As Long) As Long

Private Declare Function GlobalAlloc Lib "kernel32" ( _
        ByVal uFlags As Long, ByVal dwBytes As Long) As Long
Private Const GMEM_MOVEABLE As Long = &H2
Private Const GMEM_ZEROINIT As Long = &H40
Private Const GHND = (GMEM_MOVEABLE Or GMEM_ZEROINIT)
Private Declare Function GlobalLock Lib "kernel32" ( _
        ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" ( _
        ByVal hMem As Long) As Long
' Private Declare Function GlobalFree Lib "kernel32.dll" ( _
        ByVal hMem As Long) As Long

Private Declare Sub MoveMemory Lib "kernel32" _
        Alias "RtlMoveMemory" (Destination As Any, _
        Source As Any, ByVal Length As Long)
Private Declare Function CreateStreamOnHGlobal Lib "ole32.dll" ( _
        ByVal hGlobal As Long, ByVal fDeleteOnRelease As Long, _
        ppstm As Any) As Long

Private Function CreateStreamOnResource(ByVal sModuleName As String, _
                                        ByVal vName As Variant, _
                                        ByVal vType As Variant, _
                                        oStream As IUnknown) As Long
    Dim hModule As Long
    Dim hResource As Long
    Dim lResSize As Long
    Dim hResData As Long
    Dim pResData As Long
    Dim hGlobal As Long
    Dim pGlobal As Long
    Dim hr As Long

CreateStreamOnResource = 1
    hModule = LoadLibraryEx(sModuleName, 0, LOAD_LIBRARY_AS_DATAFILE)
    If hModule = 0 Then Exit Function

If IsNumeric(vType) Then vType = "#" & CStr(vType)
    If IsNumeric(vName) Then vName = "#" & CStr(vName)
    hResource = FindResource(hModule, vName, vType)

If hResource <> 0 Then
        lResSize = SizeofResource(hModule, hResource)
        hResData = LoadResource(hModule, hResource)
        If lResSize > 0 And hResData <> 0 Then
            pResData = LockResource(hResData)
            If pResData <> 0 Then
                Select Case vType
                    Case "#2"  ' BITMAP
                        hGlobal = GlobalAlloc(GHND, lResSize + 14)
                    Case Else
                        hGlobal = GlobalAlloc(GHND, lResSize)
                End Select

If hGlobal <> 0 Then
                    pGlobal = GlobalLock(hGlobal)
                    If pGlobal <> 0 Then
                        Select Case vType
                        Case "#2"  ' BITMAP
                            Dim nBitCount As Integer
                            Dim lCompression As Long
                            Dim lClrUsed As Long
                            Dim lOffBits As Long

Call MoveMemory(nBitCount, ByVal pResData + 14, 2) ' biBitCount
                            Call MoveMemory(lCompression, ByVal pResData + 16, 4) ' biCompression
                            Call MoveMemory(lClrUsed, ByVal pResData + 32, 4) ' biClrUsed
                            
                            If lClrUsed = 0 Then
                                Select Case nBitCount
                                    Case 1, 4, 8
                                        lOffBits = 4 * (2 ^ nBitCount)
                                    Case 24
                                        lOffBits = 0
                                    Case 16, 32
                                        lOffBits = IIf(lCompression = 0, 12, 0)
                                End Select
                            Else
                                lOffBits = lClrUsed * 4
                            End If
                            lOffBits = lOffBits + 14 + 40
                            
                            Call MoveMemory(ByVal pGlobal, &H4D42, 2) ' bfType: "BM"
                            Call MoveMemory(ByVal pGlobal + 2, lResSize + 14, 4) ' bfSize
                            Call MoveMemory(ByVal pGlobal + 10, lOffBits, 4) ' bfOffBits
                            Call MoveMemory(ByVal pGlobal + 14, ByVal pResData, lResSize)
                        Case Else
                            Call MoveMemory(ByVal pGlobal, ByVal pResData, lResSize)
                        End Select
                        Call GlobalUnlock(hGlobal)
                        
                        hr = CreateStreamOnHGlobal(hGlobal, 1, oStream)
                        CreateStreamOnResource = hr
                    End If
                End If
            End If
            Call FreeResource(hResData)
        End If
    End If
    Call FreeLibrary(hModule)
End Function

Private Sub Command1_Click()
    Const RT_BITMAP As Long = 2
    Dim sModuleName As String
    Dim vName As Variant
    Dim vType As Variant
    Dim hModule As Long
    Dim oStream As IUnknown
    Dim lBitmap As Long
    Dim lStatus As Long
    Dim lHeight As Long
    Dim lWidth As Long
    Dim lGraphics As Long
    
    sModuleName = "C:\Windows\Explorer.exe"
    vName = 150
    vType = RT_BITMAP

hModule = LoadLibraryEx(sModuleName, 0, LOAD_LIBRARY_AS_DATAFILE)
    If (hModule = 0) Then Exit Sub

If (CreateStreamOnResource(sModuleName, vName, vType, oStream) = 0) Then
        lStatus = GdipCreateBitmapFromStream(ObjPtr(oStream), lBitmap)
        If (lStatus = 0) Then
            lStatus = GdipGetImageHeight(lBitmap, lHeight)
            lStatus = GdipGetImageWidth(lBitmap, lWidth)
            If (lStatus = 0) Then
                lStatus = GdipCreateFromHDC(Picture1.hdc, lGraphics)
                If (lStatus = 0) Then
                    lStatus = GdipDrawImageRectI(lGraphics, lBitmap, 0, 0, lWidth, lHeight)
                    Call GdipDeleteGraphics(lGraphics)
                End If
            End If
            Call GdipDisposeImage(lBitmap)
        End If
        Set oStream = Nothing  ' これで、いいのかな？
    End If

Call FreeLibrary(hModule)

If (lStatus <> 0) Then MsgBox "GDI+ Error " & lStatus
End Sub

Private Sub Form_Load()
    Dim gsi As GdiplusStartupInput
    gsi.GdiplusVersion = 1
    Call GdiplusStartup(m_lToken, gsi)
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call GdiplusShutdown(m_lToken)
End Sub

←解決時は質問者本人がここをチェックしてください。

戻る