VB6でGdipCreateBitmapFromResource関数を使用するには？

解決

ノリスケ 2004-12-13 23:05:44 No: 87345 IP: [192.*.*.*]

VB6でGDI+を使用し、モジュール(DLL, EXE)内のリソースからビットマップを表示しようとしています。
現状は、GdipCreateBitmapFromResource関数の戻り値が2(InvalidParameter)で失敗します。
恐らく、引き数の指定に誤りがあると思うのですが、うまくいきません。
以下は、現状のテストコードです。
解決策についてアドバイスお願いします。

Option Explicit

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 Declare Function FreeLibrary Lib "kernel32" ( _
        ByVal hLibModule As Long) As Long

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 GdipCreateBitmapFromResource Lib "gdiplus" ( _
        ByVal hInstance As Long, ByVal lpBitmapName As Long, _
        bitmap 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 Sub Command1_Click()
    Dim sModuleName As String
    Dim sName As String
    Dim hModule As Long
    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"
    sName = "#150"

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

    lStatus = GdipCreateBitmapFromResource(hModule, StrPtr(sName), 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

    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

編集削除

魔界の仮面弁士 2004-12-13 23:27:27 No: 87346 IP: [192.*.*.*]

最初に確認しておきたいのですが、お使いの環境の
「C:\Windows\Explorer.exe」には、#150のBitmapリソースが
含まれているのでしょうか?

もし含まれていなければ、InvalidParameter(=2)のエラーが
発生した時に、Err.LastDllError の値が、1814
(指定されたリソース名がイメージファイルに見つかりません。)
になっているかと思います。

編集削除

ノリスケ 2004-12-13 23:54:20 No: 87347 IP: [192.*.*.*]

説明不足で申し訳ありません。

>「C:\Windows\Explorer.exe」には、#150のBitmapリソースが
> 含まれているのでしょうか?

存在します。Resource Hacker で確認しました。

> もし含まれていなければ、InvalidParameter(=2)のエラーが
> 発生した時に、Err.LastDllError の値が、1814
> (指定されたリソース名がイメージファイルに見つかりません。)
> になっているかと思います。

GdipCreateBitmapFromResource関数コール直後の
Err.LastDllError の値は、0 でした。

尚、他のEXEやDLLでも全て同じエラー(InvalidParameter)で失敗します。
宜しくお願いします。

編集削除

魔界の仮面弁士 2004-12-14 10:03:26 No: 87348 IP: [192.*.*.*]

>>「C:\Windows\Explorer.exe」には、#150のBitmapリソースが
>> 含まれているのでしょうか?
> 存在します。Resource Hacker で確認しました。

あら、そうですか。MAKEINTRESOURCE を利用して、
sName = "#150"
lStatus = GdipCreateBitmapFromResource(hModule, StrPtr(sName), lBitmap)
ではなく、
lStatus = GdipCreateBitmapFromResource(hModule, 150, lBitmap)
ならばいけるかと思いましたが……関係無さそうですね。

> GdipCreateBitmapFromResource関数コール直後の
> Err.LastDllError の値は、0 でした。

LastDllErrorも無しですか…ちょっと検討がつきません。

こちらでは同じコードで、Win2000機/WinXP機、どちらも表示されたのですが…。
(Win2000機の方には、セキュリティ対策済みのGDI+再頒布モジュールをインストールしました)

編集削除

ノリスケ 2004-12-14 12:48:18 No: 87349 IP: [192.*.*.*]

魔界の仮面弁士さんレスありがとうございます。

> こちらでは同じコードで、Win2000機/WinXP機、どちらも表示されたのですが…。
当方の環境を書き忘れていました。Win98です。
...ということは、環境依存の現象ということですね。残念！

>> 他のEXEやDLLでも全て同じエラー(InvalidParameter)で失敗します。

これは、誤りでしたので、訂正します。
いろいろ試した結果、LoadLibraryEx()関数の第３引き数(dwFlags)の指定を変更してやると、成功したり、失敗したりする様です。例えば、

１．LoadLibraryEx(sModuleName, 0, LOAD_LIBRARY_AS_DATAFILE)  では、
    "Shell32.dll", "#130" の場合、表示される。
    "C:\Windows\Explorer.exe", "#150" の場合、表示されない。
    但し、他のDLL, EXEでもLoadLibraryEx関数の戻り値は非ゼロです。
２．LoadLibraryEx(sModuleName, 0, 0)  では、
    上記DLL, EXE 共に、表示される。しかし、他のEXEでは、LoadLibraryEx関数
    の戻り値がゼロ(hModule=0)で、表示されない場合が多い。

それと、hModule<>0 で、表示される場合と表示されない場合に、
GdipCreateBitmapFromResource関数のGDI+ StatusとErr.LastDllErrorを調べてみると、妙な結果になりました。
・表示される場合
  GDI+ Status = 0 (Ok)
  Err.LastDllError = 87 (パラメータが正しくありません。)
・表示されない場合
  GDI+ Status = 2 (InvalidParameter)
  Err.LastDllError =  0 (操作は正常に終了しました。)

他の方法を検討してみたいと思います。
解決したら、報告します。
いろいろとありがとうございました。

編集削除

ノリスケ 2004-12-15 13:11:47 No: 87350 IP: [192.*.*.*]

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

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

編集削除

ノリスケ 2004-12-16 18:49:43 No: 87351 IP: [192.*.*.*]

使用上問題ない様なので、解決とします。
ありがとうございました。

編集削除