拡張メタファイルの変更の例(VB)

説明：

キーワード：

サンプルコード：

Type RECTL
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Type EMR
    iType As Long
    nSize As Long
End Type

Type EMR_ELLIPSE
    e As EMR
    rclBox As RECTL
End Type

Type EMR_RECTANGLE
    e As EMR
    rclBox As RECTL
End Type

Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (ByRef Dest As Any, ByRef Src As Any, ByVal Length As Long)

' メタファイル中の楕円を長方形に変換
Private Sub Command1_Click()

    Dim SrcData(10000) As Byte '元のメタファイルの内容を格納するバッファ
    Dim DestData(10000) As Byte '新規メタファイルの内容を格納するバッファ
    Dim hSrcMetaFile As Long '複製元メタファイルのハンドル
    Dim hMemMetaFile As Long 'メモリ上の新規メタファイルのハンドル
    Dim hFileMetaFile As Long 'ファイル上の新規メタファイルのハンドル
    Dim r As RECT '描画する領域
    Dim BufSize As Long 'SrcDataに格納されたメタファイルの内容のサイズ
    Dim SrcIdx As Long, DestIdx As Long
    Dim RecordHeader As EMR 'メタファイルレコードのヘッダ
    Dim EllipseRecord As EMR_ELLIPSE '楕円描画用レコードの情報
    Dim RectangleRecord As EMR_RECTANGLE '長方形描画用レコードの情報
        
    '複製元メタファイルのオープン
    hSrcMetaFile = GetEnhMetaFile("c:\pic\test.emf")

    'メタファイルの内容を取得
    BufSize = GetEnhMetaFileBits(hSrcMetaFile, 10000, SrcData(0))

    SrcIdx = 0
    DestIdx = 0
    
    ' 楕円の描画を長方形の描画に置き換え
    While SrcIdx < BufSize
        'レコードのヘッダを取得
        MoveMemory RecordHeader, SrcData(SrcIdx), Len(RecordHeader)
        
        If RecordHeader.iType = EMR_ELLIPSE Then '楕円描画レコードの場合
            '楕円描画情報を取得
            MoveMemory EllipseRecord, SrcData(SrcIdx), Len(EllipseRecord)
            
            '長方形描画情報を作成
            RectangleRecord.e.iType = EMR_RECTANGLE
            RectangleRecord.e.nSize = Len(RectangleRecord)
            RectangleRecord.rclBox = EllipseRecord.rclBox
            
            '新規メタファイル用バッファに設定
            MoveMemory DestData(DestIdx), RectangleRecord, Len(RectangleRecord)
            DestIdx = DestIdx + Len(RectangleRecord)
        
        Else '楕円描画レコードでない場合
            'そのまま複製
            MoveMemory DestData(DestIdx), SrcData(SrcIdx), RecordHeader.nSize
            DestIdx = DestIdx + RecordHeader.nSize
        End If
        
        SrcIdx = SrcIdx + RecordHeader.nSize
    Wend
    
    'バッファの内容を元に新規メタファイルを作成
    hMemMetaFile = SetEnhMetaFileBits(BufSize, DestData(0))
    
    'ファイルに保存
    hFileMetaFile = CopyEnhMetaFile(hMemMetaFile, "c:\pic\new.emf")
    
    'メタファイルのクローズ
    DeleteEnhMetaFile hFileMetaFile
    DeleteEnhMetaFile hMemMetaFile
    DeleteEnhMetaFile hSrcMetaFile

End Sub