Programming Field - プログラミング Tips

定義

[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 の画像関連の関数(CreateDIBSection、ExtractIcon、LoadImage など)で作成されたものです。具体的には HBITMAP、HMETAFILE、HICON、HENHMETAFILE です。

Param1

この値は picType の値によって異なります。

ビットマップ (PICTYPE_BITMAP)

この値には、必要であれば HPALETTE のパレットハンドルを指定します。必要が無いなら 0 を指定します。(hpal)

メタファイル (PICTYPE_METAFILE)

この値には、メタファイルの幅を Twips 単位で指定します。(xExt)

アイコン (PICTYPE_ICON)、拡張メタファイル (PICTYPE_ENHMETAFILE)

この値は使用しないので、0 を指定します。

Param2

この値は picType の値によって異なります。(メタファイル以外では使用しないため、メタファイルを使わない場合は理論上省略できますが、通常は Param2 も定義しておきます。

メタファイル (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