VBAからGDI+を使う資料集
inet上の達人の方々から御教示いただいたコードを少しアレンジさせてもらっています(切り貼りとも言います)。
  1. ホーム
  2. EMF
  3. emfを読む習作3


emfを読む習作、EMR_STRETCHDIBITSを読む

emfのEMR_STRETCHDIBITSを読む習作です。内部のbitmapのBitmpaHeaderも読んでます。


<実行結果>
96dpi,200pixel角のbmp画像をワークシートに貼り付けたものでの実行結果です
.pEmr.iType    81 
.pEmr.nSize    120120 
.rclBounds.Top -             0 
 199 
 0 
 199 
.cxSrc -       200 
.cySrc -       200 
.cxDest -      200 
.cyDest -      200 
.dwRop -       13369376 
.iUsageSrc -   0 
.offBmiSrc -   80 
.cbBmiSrc -    40 
.offBitsSrc -                120 
.cbBitsSrc     120000 
.xDest -       244 
.yDest -       0 
.xSrc -        0 
.ySrc -        0 

.biSize -      40 
.biWidth -  200 
.biHeight -                  200 
.biPlanes -    1 
.biBitCount - , 24 
.biCompression -             0 
.biSizeImage, -              120000 
.biXPelsPerMeter -           3780 
.biYPelsPerMeter -           3780 

biX(Y)PelsPerMeterにdip相当値が得られるかと思ったが、72dpi画像と96dpi画像は別の値になっているが、
96dpiと120dpiは同じ値であり、解像度(dpi)情報が何処にあるのか結局はっきりしません。

' メタファイル中のBITMAPの情報を取り出し
Sub getBitmapInfo()
  Dim SrcData() As Byte '元のメタファイルの内容を格納するバッファ
  Dim hSrcMetaFile As Long '複製元メタファイルのハンドル
  Dim r As RECT '描画する領域
  Dim BufSize As Long 'SrcDataに格納されたメタファイルの内容のサイズ
  Dim SrcIdx As Long, DestIdx As Long
  Dim RecordHeader As emr 'メタファイルレコードのヘッダ
  Dim strechDibRecord As EMRSTRETCHDIBITS
  Dim hFileMetaFile As Long
  Dim bmInfo As BITMAPINFO
  Dim offsetBmInfo As Long
  Dim offsetBmSrc As Long
  Dim topEMRSTRECHEDIBITS As Long
  Dim bitmapData() As Byte
  Dim strFileName As String
  Dim fnum As Long
  Dim bmifh As BITMAPFILEHEADER
      
  'ビットマップファイル名
  strFileName = "c:\test.bmp"
  '複製元メタファイルをクリップボードから取得
  Selection.Copy
  If OpenClipboard(0) Then
    hSrcMetaFile = GetClipboardData(CF_ENHMETAFILE)
    hSrcMetaFile = CopyEnhMetaFile(hSrcMetaFile, vbNullString)
    CloseClipboard
  End If
  If hSrcMetaFile = 0 Then
    MsgBox "emf取得に失敗"
    Exit Sub  ' 失敗
  End If
  'メタファイルの内容を取得
  BufSize = GetEnhMetaFileBits(hSrcMetaFile, ByVal 0, ByVal 0) '最終引数はCのNULL
  ReDim SrcData(BufSize)
  BufSize = GetEnhMetaFileBits(hSrcMetaFile, BufSize, SrcData(0))
  If BufSize = 0 Then
    MsgBox "GetEnhMetaFileBits failed!"
    Exit Sub
  End If
  SrcIdx = 0
  DestIdx = 0
  Do While SrcIdx < BufSize
      'レコードのヘッダを取得
      MoveMemory RecordHeader, SrcData(SrcIdx), Len(RecordHeader)
      If RecordHeader.iType = EMR_STRETCHDIBITS Then 'BitMapレコードの場合
          'BITMAP情報を取得
          MoveMemory strechDibRecord, SrcData(SrcIdx), Len(strechDibRecord)
          topEMRSTRECHEDIBITS = SrcIdx
          Exit Do
      End If
      SrcIdx = SrcIdx + RecordHeader.nSize
  Loop
  DeleteEnhMetaFile hSrcMetaFile
  With strechDibRecord
    Debug.Print ".pEmr.iType", .pEmr.iType
    Debug.Print ".pEmr.nSize", .pEmr.nSize
    Debug.Print ".rclBounds.Top - ", .rclBounds.Top
    Debug.Print .rclBounds.Bottom
    Debug.Print .rclBounds.Left
    Debug.Print .rclBounds.Right
    Debug.Print ".cxSrc - ", .cxSrc
    Debug.Print ".cySrc - ", .cySrc
    Debug.Print ".cxDest - ", .cxDest
    Debug.Print ".cyDest - ", .cyDest
    Debug.Print ".dwRop - ", .dwRop
    Debug.Print ".iUsageSrc - ", .iUsageSrc
    Debug.Print ".offBmiSrc - ", .offBmiSrc
    Debug.Print ".cbBmiSrc - ", .cbBmiSrc; ""
    Debug.Print ".offBitsSrc - ", .offBitsSrc
    Debug.Print ".cbBitsSrc", .cbBitsSrc
    Debug.Print ".xDest - ", .xDest
    Debug.Print ".yDest - ", .yDest
    Debug.Print ".xSrc - ", .xSrc
    Debug.Print ".ySrc - ", .ySrc

    'BitmpaHeaderを読む
    MoveMemory bmInfo, SrcData(topEMRSTRECHEDIBITS + .offBmiSrc), .cbBmiSrc 'LenB(bmInfo)
    With bmInfo.bmiHeader
      Debug.Print ".biSize - ", .biSize
      Debug.Print ".biWidth - "; .biWidth
      Debug.Print ".biHeight - ", , .biHeight
      Debug.Print ".biPlanes - ", .biPlanes
      Debug.Print ".biBitCount - ,"; .biBitCount
      Debug.Print ".biCompression - ", .biCompression
      Debug.Print ".biSizeImage, - ", .biSizeImage
      Debug.Print ".biXPelsPerMeter - ", .biXPelsPerMeter
      Debug.Print ".biYPelsPerMeter - ", .biYPelsPerMeter
    End With
  End With
End Sub

' メタファイルレコード列挙コールバック
Public Function EnumFunc(ByVal hdc As Long, ByVal pHandles As Long, ByVal pRecord As Long, _
  ByVal HandleNum As Long, ByVal pData As Long) As Long
  Dim eh As ENHMETARECORD 'EMR 'レコードのヘッダ
  
  'レコードのヘッダをehに格納
  RtlMoveMemory VarPtr(eh), pRecord, Len(eh)
'  Debug.Print getEMRtype(eh.iType)
  EnumFunc = 1
End Function