「拡張メタファイル(EMF)」を扱うサンプルを書いてみました。
※いずれも、メインウィンドウの「CommandButton1」がクリックされたときの
ものとして記述しています。
機会があれば再生を行うサンプルも提示する予定です。
・クリップボードへコピー
図形を描画して拡張メタファイル形式でクリップボードへコピーします。
コピーしたものはExcelやWordなどに貼り付けることが出来ます。
コード: 全て選択
' このファイルには、ウィンドウ [MainWnd] に関するイベントをコーディングします。
' ウィンドウ ハンドル: hMainWnd
' TODO: この位置にグローバルな変数、構造体、定数、関数を定義します。
'拡張メタファイル用APIの定義(一部分ですが...)
Declare Function CreateEnhMetaFile Lib "gdi32" Alias "CreateEnhMetaFileA" _
(hdcRef As DWord, lpFileName As BytePtr, ByRef lpRect As RECT, _
lpDescription As BytePtr) As DWord
Declare Function CopyEnhMetaFile Lib "gdi32" Alias "CopyEnhMetaFileA" _
(ByVal hemfSrc As DWord, lpszFile As BytePtr) As DWord
Declare Function CloseEnhMetaFile Lib "gdi32" (hdc As DWord) As DWord
Declare Function DeleteEnhMetaFile Lib "gdi32" (hEmf As DWord) As DWord
Sub MainWnd_CommandButton1_Click()
'メモリデバイスコンテキストハンドル
Dim memEMFDC As DWord
'メタファイルハンドル
Dim memEMFhandle As DWord
'図形の塗りつぶし色。
Dim colorBrush As DWord
Dim colorOldBrush As DWord
'図形の線色。
Dim colorPen As DWord
Dim colorOldPen As DWord
'メモリ内に拡張メタファイルを作成。
'CreateEnhMetaFileの第3引数(RECT)がByVal 0となっているが、
'描画するもののサイズに沿って変更されるので問題ない
memEMFDC = CreateEnhMetaFile(0, NULL, ByVal 0, 0)
'メモリデバイスコンテキストのブラシを交換する
'ブラシ色=黄色
colorBrush = CreateSolidBrush(RGB(255,255,0))
colorOldBrush = SelectObject(memEMFDC,colorBrush)
'メモリデバイスコンテキストのペンを交換する
'青色・太さ2の実線
colorPen = CreatePen(PS_SOLID,2,RGB(0,0,255))
colorOldPen = SelectObject(memEMFDC,colorPen)
'メモリデバイスコンテキストへ描画する
'ここでは角丸四角形を描く
RoundRect(memEMFDC,0,0,200,100,20,20)
'描画がすんだらメモリデバイスコンテキストのブラシとペンを戻す
SelectObject(memEMFDC,colorOldBrush)
SelectObject(memEMFDC,colorOldPen)
'メモリデバイスコンテキストを閉じて
'拡張メタファイルのハンドルを取得する
memEMFhandle = CloseEnhMetaFile(memEMFDC)
'拡張メタファイルをクリップボードへコピーする
OpenClipboard(NULL)
EmptyClipboard()
SetClipboardData(CF_ENHMETAFILE,memEMFhandle)
CloseClipboard()
'不要になったブラシとペンを破棄
DeleteObject(colorBrush)
DeleteObject(colorPen)
'拡張メタファイルのハンドルを破棄する
DeleteEnhMetaFile(memEMFhandle)
End Sub
図形を描画して拡張メタファイル形式でファイルに保存します。
コード: 全て選択
Sub MainWnd_CommandButton1_Click()
'メモリデバイスコンテキストハンドル
Dim memEMFDC As DWord
'メタファイルハンドル
Dim memEMFhandle As DWord
'図形の塗りつぶし色。
Dim colorBrush As DWord
Dim colorOldBrush As DWord
'図形の線色。
Dim colorPen As DWord
Dim colorOldPen As DWord
'メモリ内に拡張メタファイルを作成。
'CreateEnhMetaFileの第3引数(RECT)がByVal 0となっているが、
'描画するもののサイズに沿って変更されるので問題ない
memEMFDC = CreateEnhMetaFile(0, NULL, ByVal 0, 0)
'メモリデバイスコンテキストのブラシを交換する
'ブラシ色=黄色
colorBrush = CreateSolidBrush(RGB(255,255,0))
colorOldBrush = SelectObject(memEMFDC,colorBrush)
'メモリデバイスコンテキストのペンを交換する
'青色・太さ2の実線
colorPen = CreatePen(PS_SOLID,2,RGB(0,0,255))
colorOldPen = SelectObject(memEMFDC,colorPen)
'メモリデバイスコンテキストへ描画する
'ここでは角丸四角形を描く
RoundRect(memEMFDC,0,0,200,100,20,20)
'描画がすんだらメモリデバイスコンテキストのブラシとペンを戻す
SelectObject(memEMFDC,colorOldBrush)
SelectObject(memEMFDC,colorOldPen)
'メモリデバイスコンテキストを閉じて
'拡張メタファイルのハンドルを取得する
memEMFhandle = CloseEnhMetaFile(memEMFDC)
'拡張メタファイルをファイルへ保存する(拡張子はEMFとすること)
CopyEnhMetaFile(memEMFhandle,"C:\Test.emf")
'不要になったブラシとペンを破棄
DeleteObject(colorBrush)
DeleteObject(colorPen)
'拡張メタファイルのハンドルを破棄する
DeleteEnhMetaFile(memEMFhandle)
End Sub
拡張メタファイル用APIをAB内で定義していただけると幸いです。