ab.com コミュニティ

ActiveBasicを通したコミュニケーション
現在時刻 - 2018年7月21日(土) 18:51

All times are UTC+09:00




新しいトピックを投稿する  トピックへ返信する  [ 4 件の記事 ] 
作成者 メッセージ
投稿記事Posted: 2005年12月07日(水) 01:28 
オフライン

登録日時: 2005年6月07日(火) 22:06
記事: 18
住所: 長崎県
こんばんは、

「拡張メタファイル(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内で定義していただけると幸いです。


通報する
ページトップ
投稿記事Posted: 2005年12月08日(木) 18:40 
オフライン

登録日時: 2005年6月07日(火) 22:06
記事: 18
住所: 長崎県
さらに追加したいと思います。

※Declare宣言部分は上記サンプルと同じですので省略します。

・ImageBoxへ表示
 図形を描画したものをImageBoxへ表示します。
 図形はImageBoxの大きさに合わせて拡大縮小されます。
(あらかじめ、ImageBoxをメインウィンドウに配置してください)

まず、Declare宣言部分の下へ以下のグローバル変数を定義します
コード:
'保持しておくべき拡張メタファイルハンドル
Dim memKeepEMF As DWord

次に、MainWnd_Destroy()イベントに次のように書き加えます
コード:
Sub MainWnd_Destroy()

   '拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

	*****_DestroyObjects()
	PostQuitMessage(0)

End Sub

次に、CommandButton1がクリックされたときのイベントに以下のように
書き加えます。
コード:
Sub MainWnd_CommandButton1_Click()

   '一旦、拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

    'メモリデバイスコンテキストハンドル
    Dim memEMFDC As DWord 

    '図形の塗りつぶし色。
    Dim colorBrush As DWord 
    Dim colorOldBrush As DWord

    '図形の線色。
    Dim colorPen As DWord
    Dim colorOldPen As DWord

    'メモリ内に拡張メタファイルを作成。
    'CreateEnhMetaFileの第3引数が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)
    
    'メモリデバイスコンテキストへ描画する
    'ここでは☆形を描く

	Dim pPoint[9] As POINTAPI
	pPoint[0].x =   0 :pPoint[0].y =  30
	pPoint[1].x =  35 :pPoint[1].y =  30
	pPoint[2].x =  50 :pPoint[2].y =   0
	pPoint[3].x =  65 :pPoint[3].y =  30
	pPoint[4].x = 100 :pPoint[4].y =  30
	pPoint[5].x =  75 :pPoint[5].y =  55
	pPoint[6].x =  85 :pPoint[6].y = 100
	pPoint[7].x =  50 :pPoint[7].y =  75
	pPoint[8].x =  15 :pPoint[8].y = 100
	pPoint[9].x =  25 :pPoint[9].y =  55

	Polygon(memEMFDC,pPoint[0],10)

    '描画がすんだらメモリデバイスコンテキストのブラシとペンを戻す
    SelectObject(memEMFDC,colorOldBrush)
    SelectObject(memEMFDC,colorOldPen)

    'メモリデバイスコンテキストを閉じて
    '拡張メタファイルのハンドルを取得する

    memKeepEMF = CloseEnhMetaFile(memEMFDC)

    'イメージボックスへ拡張メタファイルを扱うように指示
    '定数「SS_ENHMETAFILE」はABで定義済みだが、ヘルプには記載されていない。
    '「SS_METAPICT」とすると失敗するのでご注意!
    SetWindowLong(GetDlgItem(hMainWnd,ImageBox1),GWL_STYLE,GetWindowLong(GetDlgItem(hMainWnd,ImageBox1),GWL_STYLE) Or SS_ENHMETAFILE Or WS_BORDER)
	
    'イメージボックスへ拡張メタファイルのハンドルを渡す
    SendMessage(GetDlgItem(hMainWnd,ImageBox1),STM_SETIMAGE,IMAGE_ENHMETAFILE,memKeepEMF)  
    UpdateWindow(GetDlgItem(hMainWnd,ImageBox1))

    '不要になったブラシとペンを破棄
    DeleteObject(colorBrush)
    DeleteObject(colorPen)

End Sub

・ファイルから読み込んでImageBoxへ表示
 ファイルに保存してある拡張メタファイルをImageBoxへ表示します。
 図形はImageBoxの大きさに合わせて拡大縮小されます。
(あらかじめ、ImageBoxをメインウィンドウに配置してください)

***12/10 15:20 追加訂正

最初に提示したサンプルのDeclare宣言に加えて、以下の宣言を追加します。
コード:
Declare Function GetEnhMetaFile Lib "gdi32" Alias "GetEnhMetaFileA" _
 (lpszMetaFile As BytePtr) As DWord

***************

次に、Declare宣言部分の下へ以下のグローバル変数を定義します
コード:
'保持しておくべき拡張メタファイルハンドル
Dim memKeepEMF As DWord

次に、MainWnd_Destroy()イベントに次のように書き加えます
コード:
Sub MainWnd_Destroy()

   '拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

	*****_DestroyObjects()
	PostQuitMessage(0)

End Sub

次に、CommandButton1がクリックされたときのイベントに以下のように
書き加えます。
コード:
Sub MainWnd_CommandButton1_Click()

   '一旦、拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

    '拡張メタファイルを読み込み、ハンドルを取得する
    'ファイル名は、実際に存在するものを指定すること

    memKeepEMF = GetEnhMetaFile("C:\Test.emf")

    'イメージボックスへ拡張メタファイルを扱うように指示
    '定数「SS_ENHMETAFILE」はABで定義済みだが、ヘルプには記載されていない。
    '「SS_METAPICT」とすると失敗するのでご注意!
    SetWindowLong(GetDlgItem(hMainWnd,ImageBox1),GWL_STYLE,GetWindowLong(GetDlgItem(hMainWnd,ImageBox1),GWL_STYLE) Or SS_ENHMETAFILE Or WS_BORDER)
    
    'イメージボックスへ拡張メタファイルのハンドルを渡す
    SendMessage(GetDlgItem(hMainWnd,ImageBox1),STM_SETIMAGE,IMAGE_ENHMETAFILE,memKeepEMF)  
    UpdateWindow(GetDlgItem(hMainWnd,ImageBox1))

End Sub



最後に編集したユーザー M.K on 2005年12月10日(土) 15:20 [ 編集 1 回目 ]

通報する
ページトップ
投稿記事Posted: 2005年12月09日(金) 11:02 
オフライン

登録日時: 2005年6月07日(火) 22:06
記事: 18
住所: 長崎県
さらにさらに追加したいと思います。(^^;

・クリップボードに含まれている拡張メタファイルをImageBoxへ貼り付ける

 クリップボードに含まれている拡張メタファイルをImageBoxへ貼り付けます。
 ImageBoxのサイズを、拡張メタファイル内に含まれる情報を使用して調整します。
(あらかじめ、ImageBoxをメインウィンドウに配置してください)

※Declare宣言部分へ上記宣言に加えて以下の定義と構造体を追加します。
コード:
Declare Function GetEnhMetaFileHeader Lib "gdi32" Alias "GetEnhMetaFileHeader" _
           (hEmf As DWord, cbBuffer As DWord, ByRef lpemh As ENHMETAHEADER) As DWord

'12/9 23:30 追加--------
Declare Function PlayEnhMetaFile Lib "gdi32" Alias "PlayEnhMetaFile" _
          (hdc As DWord, hemf As DWord,ByRef lpRect As RECT) As Long
'-------------------------

Type ENHMETAHEADER

    iType As DWord              'レコードタイプを表すメンバで常にEMR_HEADER(&h1)を示す
    nSize As DWord              'この構造体のサイズをバイト単位で表わす 
    rclBounds As RECT           'メタファイルの描画に必要な長方形を論理単位で表すRECTL(RECT)構造体 
    rclFrame As RECT            'rclBounds を 0.01 ミリ単位で表した RECTL 構造体  
    dSignature As DWord         '常に ENHMETA_SIGNATURE(&h464D4520) ("EMF "という文字列)
    nVersion As DWord           'メタファイルのバージョンを表すもので、常に &h10000 
    nBytes As DWord             '拡張メタファイルのバイト単位のサイズ 
    nRecords As DWord           '拡張メタファイルのレコード数 
    nHandles As Word            '拡張メタファイルの内部で非デフォルトのハンドルが用いられた時の
                                'ハンドルテーブルが持つハンドルの数 

    sReserved As Word           '予約済みのメンバで、常に0 

    nDescription As DWord       '拡張メタファイルの説明文が入っている配列の文字数
                                'この値が 0 を表すとき、記述が存在しないことを意味する 

    offDescription As DWord     'ENHMETAHEADER 構造体の先頭から数えて拡張メタファイルの説明文が
                                '入っている配列までのオフセットを意味する
                                'この値が 0 の時は、記述が存在しないことを表わす 

    nPalEntries As DWord        '拡張メタファイルのパレットエントリ数を意味する 
    szlDevice As SIZE           'ピクセル単位で参照デバイスの解像度 
    szlMillimeters As SIZE      '参照デバイスの解像度をミリ単位で表した数値

    cbPixelFormat As DWord      'ピクセルフォーマットのサイズ
    offPixelFormat As DWord     'ピクセルフォーマットのオフセット
    bOpenGL As DWord            'OpenGLレコードが含まれていればTURE、そうでなければFALSE

    'szlMicrometers As SIZE	'※(Win98/Me/2000/XPのみ)
                                '参照デバイスの解像度をマイクロメータ単位で表した数値
                                'Windows95/NT4でも機能させたい場合にはこのメンバはコメントアウトすること

End Type

次に、以下のグローバル変数を定義します
コード:
'保持しておくべき拡張メタファイルハンドル
Dim memKeepEMF As DWord
次に、MainWnd_Destroy()イベントに次のように書き加えます
コード:
Sub MainWnd_Destroy()

   '拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

	*****_DestroyObjects()
	PostQuitMessage(0)

End Sub
次に、CommandButton1がクリックされたときのイベントに以下のように
書き加えます。
コード:
Sub MainWnd_CommandButton1_Click()

    'クリップボードを開く
    OpenClipboard(NULL)

    '現在のクリップボードの内容に
    '拡張メタファイルが含まれていなければ何もしない

    If (GetClipboardData(CF_ENHMETAFILE)) = 0 Then

	 MessageBox(hMainWnd,"現在クリップボードに、拡張メタファイルはありません", _
                               "貼り付けできません!",MB_OK Or MB_ICONWARNING)

         CloseClipboard()
         Exit Sub

    End If
    
    '拡張メタファイルのヘッダー情報用構造体の定義
    Dim EMFHEAD As ENHMETAHEADER

    '上記構造体の初期化
    FillMemory(VarPtr(EMFHEAD),Len(EMFHEAD),0)

    '画像のサイズを代入するための構造体
    Dim nRect As RECT

    '一旦、拡張メタファイルのハンドルを破棄する
    DeleteEnhMetaFile(memKeepEMF)

    '拡張メタファイルをクリップボードから取り込む
    memKeepEMF = GetClipboardData(CF_ENHMETAFILE)

    'クリップボードを閉じる
    CloseClipboard()

    '拡張メタファイルの情報(ヘッダー)を取得する
    GetEnhMetaFileHeader(memKeepEMF,Len(EMFHEAD),EMFHEAD)

    '拡張メタファイルの情報(ヘッダー)からサイズ情報を取得する
    nRect = EMFHEAD.rclBounds

    'サイズ・位置を微調整する(順番厳守)

    '(高さ)Excelの表をコピーしたものは大きくなりやすいので
    ' * 0.3(30%程度に縮小)するとよい
    nRect.bottom = (nRect.bottom - nRect.top) '* 0.3    
                                                        
    '( 幅 )Excelの表をコピーしたものは大きくなりやすいので
    ' * 0.3(30%程度に縮小)するとよい
    nRect.right  = (nRect.right - nRect.left) '* 0.3    
    
    '左上座標(常に0とする)                                                    
    nRect.left   = 0
    nRect.top    = 0

	'(改良追加 2005/12/09 23:30)ここから--------------------
	'貼り付けた後、別のものをコピーすると
	'イメージボックスの内容が消えるので
	'メモリデバイスコンテキストへ描画して退避させる
	Dim TempDC As DWord
	TempDC = CreateEnhMetaFile(0,NULL,ByVal 0,0)

	PlayEnhMetaFile(TempDC,memKeepEMF,nRect)
	DeleteEnhMetaFile(memKeepEMF)

	'その結果をハンドルとして再取得する
	memKeepEMF = CloseEnhMetaFile(TempDC)

	'ここまで--------------------------------------------------

    'イメージボックスへ拡張メタファイルを扱うように指示
    '定数「SS_ENHMETAFILE」はヘルプには記載されていないが、ABで定義済み。
    '「SS_METAPICT」とすると失敗するのでご注意!
    SetWindowLong(GetDlgItem(hMainWnd,ImageBox1),GWL_STYLE, _
                  GetWindowLong(GetDlgItem(hMainWnd,ImageBox1), _
                  GWL_STYLE) Or SS_ENHMETAFILE Or WS_BORDER)
    
    '拡張メタファイルのサイズに合わせてイメージボックスもサイズ調整
    MoveWindow(GetDlgItem(hMainWnd,ImageBox1), _
               nRect.left,nRect.top,nRect.right,nRect.bottom,TRUE)

    'イメージボックスへ拡張メタファイルのハンドルを渡す
    SendMessage(GetDlgItem(hMainWnd,ImageBox1),STM_SETIMAGE,IMAGE_ENHMETAFILE,memKeepEMF) 

    'イメージボックスの再描画を促す
    UpdateWindow(GetDlgItem(hMainWnd,ImageBox1))

End Sub


通報する
ページトップ
 記事の件名:
投稿記事Posted: 2007年2月28日(水) 20:57 
M.Kさま

アラタシと申します。AB初心者です。
昔のトピックに返信して、見ていただけるのか分かりませんが・・・。
簡単なグラフをウィンドウに描画して、それを印刷したり、画像として保存したり
するプログラムを作っています。グラフをメタファイルとしてコピーして、イラスト
レータなどのドロー系ソフトにペーストし、編集したいと思っていたので、M.Kさ
んの作られたコードが非常に役に立っています。非常にありがたかったです。

質問ですが、

'メモリデバイスコンテキストを閉じて
memEMFhandle = CloseEnhMetaFile(memEMFDC)

となっていますが、最終的にこのメモリデバイスコンテキストはDeleteDC
しなくてもいいのでしょうか?

あと、これは本質的にABの問題ではないと思いますが、メタファイルをクリップ
ボードにコピーして、ドロー系ソフトにペーストしたとき、イラストレータでは、
線の一部が消えてなくなる、TextOutで書いたフォントが上下左右反転した
状態で表示される、Canvasではテキストが表示されない、などといった
現象が起こります。こんなのを少しでも回避する方法はないでしょうか・・・?


通報する
ページトップ
   
期間内表示:  ソート  
新しいトピックを投稿する  トピックへ返信する  [ 4 件の記事 ] 

All times are UTC+09:00


オンラインデータ

このフォーラムを閲覧中のユーザー: なし & ゲスト[1人]


トピック投稿:  可
返信投稿:  可
記事編集: 不可
記事削除: 不可
ファイル添付: 不可

検索:
ページ移動:  
cron
Powered by phpBB® Forum Software © phpBB Limited
Japanese translation principally by KONISHI Yohsuke