Programming Field - プログラミング Tips

VB 6.0 における画像ハンドルの変換

スポンサーリンク

VB 6.0(5.0 も?)での画像の読み込みは、多くは LoadPicture メソッド(stdoleライブラリなどに定義)を使用しますが、「実行可能ファイルからのアイコンの抽出」などで作成した画像のハンドルを IPictureDisp (または IPictureStdPicture)にするには、LoadPicture は使用できません。そこで、Win32API を利用してオブジェクトを作成します。

※ VB.NET では、System.Drawing.Icon.FromHandle などを使用します。「実行可能ファイルからのアイコンの抽出 for VB.NET」では HICON から System.Drawing.Icon への変換を行っています。

使用する API は、OleCreatePictureIndirect です。(この関数をキーワードに検索すると、結構 VB 関連でヒットするようです。)

定義

[VB 6.0]

Public Type PICTDESC
    cbSizeOfStruct As Long
    picType As Long
    Handle As Long       ' hbitmap, hmeta, hicon, hemf
    Param1 As Long       ' hpal, xExt, 0, 0
    Param2 As Long       ' 0, yExt, 0, 0
End Type

Public Const PICTYPE_UNINITIALIZED As Long = (-1)
Public Const PICTYPE_NONE          As Long = 0
Public Const PICTYPE_BITMAP        As Long = 1
Public Const PICTYPE_METAFILE      As Long = 2
Public Const PICTYPE_ICON          As Long = 3
Public Const PICTYPE_ENHMETAFILE   As Long = 4

Public Type IID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(0 To 7) As Byte
End Type

Public Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
    (ByRef pPictDesc As PICTDESC, ByRef riid As IID,
    ByVal fOwn As Long, ByRef ppvObj As Any) As Long

PICTDESC

cbSizeOfStruct
PICTDESC のサイズを指定します。Len(<変数>) と指定します。
picType
画像の種類を指定します。PICTYPE_ で始まる定数を指定します。
Handle
画像のハンドルを指定します。このハンドルは Win32API の画像関連の関数(CreateDIBSectionExtractIconLoadImage など)で作成されたものです。具体的には HBITMAPHMETAFILEHICONHENHMETAFILE です。
Param1
この値は picType の値によって異なります。

ビットマップ (PICTYPE_BITMAP)
この値には、必要であれば HPALETTE のパレットハンドルを指定します。必要が無いなら 0 を指定します。(hpal)
メタファイル (PICTYPE_METAFILE)
この値には、メタファイルの幅を Twips 単位で指定します。(xExt)
アイコン (PICTYPE_ICON)、拡張メタファイル (PICTYPE_ENHMETAFILE)
この値は使用しないので、0 を指定します。
Param2
この値は picType の値によって異なります。

メタファイル (PICTYPE_METAFILE)
この値には、メタファイルの高さを Twips 単位で指定します。(yExt)
ビットマップ (PICTYPE_BITMAP)、アイコン (PICTYPE_ICON)、拡張メタファイル (PICTYPE_ENHMETAFILE)
この値は使用しないので、0 を指定します。

IID

この構造体は GUID と同じですが、stdole に定義されている GUID は使えない(!)ので、とりあえず定義しています。

OleCreatePictureIndirect

pPictDesc
PICTDESC 構造体の変数を指定します。呼び出す前に必要事項を設定しておきます。
riid
ppvObj で取得するインターフェイスの IID を指定します。サンプルを参照してください。
fOwn
作成したオブジェクト自身が画像のハンドルを破棄するかどうかを TRUE(1) か FALSE(0) で指定します。特別なことが無い限り、1 を指定して破棄を任せるほうが無難です。
ppvObj
作成されるオブジェクトを保持するオブジェクト変数を指定します。この変数にオブジェクトを受け取るので、変数の値は Nothing としておきます。指定する変数の型は、厳密には IID に依存します(下記参照)が、(すべてのインターフェイスをひとつのオブジェクトがインプリメントしているためなのか)型にこだわる必要はありません。

IID が IID_IPicture のとき
(stdole.)IPicture インターフェイス(非表示メンバ)の変数を指定します。
IID が IID_IPictureDisp のとき
(stdole.)IPictureDisp インターフェイスの変数を指定します。
IID が IID_IDispatch のとき
Object 型の変数を指定します。

サンプル

以下は、VBA (Visual Basic for Applications; 今回は Excel マクロを使用)で試してみたコードで、Sheet1 の上に Image1 という「イメージ コントロール」(「コントロール ツールボックス」から追加)を貼り付けた状態で実行したものです。

書くと非常に長くなるので、宣言部は省略しています。上記のものを使用してください。

MyExtractIcon「実行可能ファイルからのアイコンの抽出」の VB 6.0 サンプルを使用してください。

' hIcon からピクチャオブジェクトを作成する関数
Public Function CreateIconPicture(ByVal hIcon As Long) As stdole.IPictureDisp
    Dim pic As stdole.IPictureDisp
    Dim hr As Long
    Dim pd As PICTDESC
    Dim IID_IPictureDisp As IID
    ' IID を作成します。
    ' IID_IPictureDisp = {7BF80981-BF32-101A-8BBB-00AA00300CAB}
    IID_IPictureDisp.Data1 = &H7BF80981
    IID_IPictureDisp.Data2 = &HBF32
    IID_IPictureDisp.Data3 = &H101A
    IID_IPictureDisp.Data4(0) = &H8B
    IID_IPictureDisp.Data4(1) = &HBB
    IID_IPictureDisp.Data4(2) = &H0
    IID_IPictureDisp.Data4(3) = &HAA
    IID_IPictureDisp.Data4(4) = &H0
    IID_IPictureDisp.Data4(5) = &H30
    IID_IPictureDisp.Data4(6) = &HC
    IID_IPictureDisp.Data4(7) = &HAB
    pd.Handle = hIcon
    pd.cbSizeOfStruct = Len(pd)
    pd.picType = PICTYPE_ICON
    Set pic = Nothing
    ' ハンドルの解放はオブジェクトに任せます。
    hr = OleCreatePictureIndirect(pd, IID_IPictureDisp, 1, pic)
    ' hr が負の値のときはエラーが発生しています。
    If hr < 0 Then
        ' hr が負の値のときはそのまま Err.Raise に使用できます。
        Call VBA.Information.Err().Raise(hr)
        Exit Function
    End If
    Set CreateIconPicture = pic
End Function

' ImageHandle 関数は、Index を指定するだけでアイコンを設定します。
' 戻り値は使用済みのアイコンのハンドルです。
' シートの A1 に「=ImageHandle(3)」などと入力してテストできます。
Public Function ImageHandle(ByVal Index As Long, Optional ByVal IconFile As String) As Long
    If Len(IconFile) = 0 Then IconFile = "shell32.dll"
    ImageHandle = MyExtractIcon(IconFile, Index, False)
    If ImageHandle = 0 Then Exit Function
    Set Sheet1.Image1.Picture = CreateIconPicture(ImageHandle)
End Function

最終更新日: 2006/09/15