パレットを考慮した拡張メタファイルの描画(VB)

説明：

キーワード：

サンプルコード：

Public Type PICTDESC_BMP
    cbSizeOfStruct As Long
    picType As Long
    hBitmap As Long
    hPal As Long
    Padding As Long
End Type

Public Const PICTYPE_BITMAP As Long = 1

Declare Function OleCreatePictureIndirect Lib "olepro32" ( _
    ByRef Desc As PICTDESC_BMP, _
    ByRef IID As GUID, _
    ByVal fOwn As Long, _
    ByRef IPic As IPicture) As Long

' パレットつきの拡張メタファイルを描画
Private Sub Command1_Click()

    Dim hEmf As Long '拡張メタファイルのハンドル
    Dim r As RECT '描画する領域
    Dim LogPal As LOGPALETTE 'パレット情報
    Dim hPal As Long 'パレットのハンドル
    Dim IPic As IPicture 'パレット用ピクチャオブジェクト
    Dim IID_IDispatch As GUID 'IDispatchインターフェースのGUID
    Dim Desc As PICTDESC_BMP 'パレット用ピクチャオブジェクトの作成情報
    
    '拡張メタファイルのオープン
    hEmf = GetEnhMetaFile("c:\pic\pal.emf")
    
    '描画領域の設定
    r.Left = 0
    r.Top = 0
    r.Right = 300
    r.Bottom = 300
    
    'パレットエントリの取得
    LogPal.palNumEntries = GetEnhMetaFilePaletteEntries(hEmf, 1000, LogPal.palPalEntry(0))
    
    ' パレットの作成
    LogPal.palVersion = &H300
    hPal = CreatePalette(LogPal)

    ' パレット用ピクチャオブジェクトの作成に用いる情報の初期化
    Desc.cbSizeOfStruct = Len(Desc)
    Desc.picType = PICTYPE_BITMAP
    Desc.hBitmap = 0
    Desc.hPal = hPal
    
    IID_IDispatch.Data1 = &H20400
    IID_IDispatch.data2 = 0
    IID_IDispatch.data3 = 0
    IID_IDispatch.data4(0) = &HC0
    IID_IDispatch.data4(1) = 0
    IID_IDispatch.data4(2) = 0
    IID_IDispatch.data4(3) = 0
    IID_IDispatch.data4(4) = 0
    IID_IDispatch.data4(5) = 0
    IID_IDispatch.data4(6) = 0
    IID_IDispatch.data4(7) = &H46
    
    'パレット用ピクチャオブジェクトの作成
    OleCreatePictureIndirect Desc, IID_IDispatch, 1, IPic
    
    '作成したオブジェクトをフォームのパレットとして設定
    Me.Palette = IPic
    Me.PaletteMode = vbPaletteModeCustom
    Me.Refresh

    '拡張メタファイルの描画
    PlayEnhMetaFile Picture1.hDC, hEmf, r
    
    '拡張メタファイルのクローズ
    DeleteEnhMetaFile hEmf

End Sub