散布図で各プロットに対応する文字が表示されています。
それらの文字は全て同一です。
他にも、軸ラベルなどがあります。
このemf(或いはwmfでも可)ファイルをVBから編集することで
フォントサイズを全て一定の比率・・例えば1.5倍とか0.7倍
などに変更することは可能でしょうか？
よろしくお願いします。
（拡張）メタファイルは、拡大縮小に対応していますので、この場合
文字フォントの大きさのみを変更したいと言うことでしょうか？
一応、機能的には可能です。
ただ大昔にやったので、どうやったか覚えてません・・・
DXF => MetaFile 変換やりました。後にMetaFileの表示でレイヤ的な
部分や文字情報の変更とか加工処理を別途行いましたから可能なはず
です。（あくまではず・・・）
以上。
オショウさん、早速のレスありがとうございます。
上の質問がチョット判りにくいですね。
> 散布図で各プロットに対応する文字が表示されています。
> それらの文字は全て同一です。
文字は異なっていますが、サイズは同一です。
詳しく言えば、統計解析システム R で散布図を作成しemfで出力しています。
http://www.okada.jp.org/RWiki/?RjpWiki
データ数が大きいので、emfファイルをVBで作った簡易ビューアで拡大表示
させています。
その際に、文字サイズも同時に拡大しますので、例えばグラフが２倍に
なったら、文字サイズは1/2にして、拡大表示させたときの文字サイズを
一定にさせたかったのです。
> ただ大昔にやったので、どうやったか覚えてません・・・
残念です！
ただ、可能性がありそうなことが判っただけでも嬉しいです。
今、MSのENHMET.HLP(仕様書？)を読んでいますが、よく判りません（汗
引き続き、皆様の情報をお待ちしています。
宜しくお願いします。
EnumEnhMetaFile
GetEnhMetaFileBits
これらを使って・・・
レコードを列挙・抽出を行い、別の加工後のメタファイルに
出力させながら、該当の要素を修正してやれば、欲しい機能
が実現できるはずです。結構力技かも・・・です。
※ 要素の抽出と言う方法がミソ！
※ 1992〜1993年に作ったソースコードを偶然引っ張りだせ
ましたので・・・ヒーコラ・・・
DXF ファイルから要素を列挙・抽出して、MetaFile向け
のGDI命令に変更して変換を実現していましたので、方法
としては、実現できるはずです。
※ 要素の抽出の際、文字列情報が、どんなIDになっている
のか、調べる必要があると思います。
ちょっともう調べるのが面倒・・・すいません・・・
以上。がんばって下さい！
片方で EnumEnhMetaFile で列挙しながら、もう片方で EnhMetaDC に
PlayEnhMetaFileRecord で記録することにして、列挙側では Font の
設定に関係ありそうな EMR、例えば EMREXTCREATEFONTINDIRECTW など
を監視して、もし該当するのが来たら、その時だけ加工した EMR を
記録側に送るとか。
オショウ様、K.J.K.様 コメントありがとうございます。
聞けば聞くほど壁がはっきりし、簡単には出来そうにない予感が・・・
別なアプローチで、フォントサイズを変更した２つのemfファイルを
比較したりもしているのですが、ファイルサイズ自体も変化しています。
現時点では、Ｒに適当なタイミングで、都度emfファイルを出力させる
ことで逃げる仕様にしました。
とりあえず、この話題は閉めることとさせていただきます。
オショウ様、K.J.K.様のアドバイスを元に連休中に少しトライしてみました。
⇒ 下記を参考にフォント高さを変更することには成功しました。
http://nienie.com/~masapico/api_GetEnhMetaFileBits.html
http://park7.wakwak.com/~efc21/cgi-bin/exqalounge.cgi?print+200708/07080129.txt
◆ しかし、文字の長さ(矩形表示領域?)が変更されず、文字高さを小さくすると
文字と文字の間隔が広くなり、逆に大きくすると文字が重なりだします。
Type EMREXTTEXTOUT
pEmr As EMR
rclBounds As RECTL
iGraphicsMode As Long
exScale As Double
eyScale As Double
emrtext As emrtext
End Type
Type EXTLOGFONT
elfLogFont As LOGFONT
elfFullName(LF_FULLFACESIZE) As Byte
elfStyle(LF_FACESIZE) As Byte
elfVersion As Long
elfStyleSize As Long
elfMatch As Long
elfReserved As Long
elfVendorId(ELF_VENDOR_SIZE) As Byte
elfCulture As Long
elfPanose As PANOSE
End Type
Type EMREXTCREATEFONTINDIRECT
pEmr As EMR
ihFont As Long
elfw As EXTLOGFONT
End Type
Const EMR_EXTCREATEFONTINDIRECTW = 82
Const EMR_EXTTEXTOUTW = 84
While SrcIdx < BufSize
'レコードのヘッダを取得
MoveMemory RecordHeader, SrcData(SrcIdx), Len(RecordHeader)
If RecordHeader.iType = EMR_EXTCREATEFONTINDIRECTW Then
MoveMemory E_CREATEFONTINDIRECT, SrcData(SrcIdx), Len(E_CREATEFONTINDIRECT)
'フォント高さを半減
E_CREATEFONTINDIRECT.elfw.elfLogFont.lfHeight = E_CREATEFONTINDIRECT.elfw.elfLogFont.lfHeight * sScale
'E_CREATEFONTINDIRECT.elfw.elfLogFont.lfWidth ・・ は個々の文字幅！
'新規メタファイル用バッファに設定
MoveMemory DestData(DestIdx), E_CREATEFONTINDIRECT, Len(E_CREATEFONTINDIRECT)
DestIdx = DestIdx + RecordHeader.nSize
ElseIf RecordHeader.iType = EMR_EXTTEXTOUTW Then
MoveMemory E_TEXTOUT, SrcData(SrcIdx), RecordHeader.nSize 'Len(E_TEXTOUT)ではカタカナが１文字長さで固まる
With E_TEXTOUT.rclBounds
Debug.Print .Left, .Top, .Right, .Bottom '0 0 -1 -1 のみ
End With
'新規メタファイル用バッファに設定
MoveMemory DestData(DestIdx), E_TEXTOUT, RecordHeader.nSize 'Len(E_TEXTOUT)ではカタカナが１文字長さで固まる
DestIdx = DestIdx + RecordHeader.nSize
'文字描画レコードでない場合 → そのまま複製
Else
MoveMemory DestData(DestIdx), SrcData(SrcIdx), RecordHeader.nSize
DestIdx = DestIdx + RecordHeader.nSize
End If
SrcIdx = SrcIdx + RecordHeader.nSize
Wend
◆ 矩形領域はEMREXTTEXTOUTW構造体のrclBoundsかなとも思ったのですが、入っているデータは
With E_TEXTOUT.rclBounds
Debug.Print .Left, .Top, .Right, .Bottom '0 0 -1 -1 のみ
End With
でした。
また、上にもコメント入れていますがEMR_EXTTEXTOUTWの際には、
MoveMemory E_TEXTOUT, SrcData(SrcIdx), Len(E_TEXTOUT) ではカタカナが１文字長さの矩形領域に
重なって表示されます。
→漢字は正しく表示されます。
APIの扱いがよく判っていない為だと思いますが、お気づきの点がありましたらご教授頂ければ幸いです。
EMREXTTEXTOUT.emrtext.rcl や EXTLOGFONT.elfLogFont.lfWidth の値などを
換えてみるとどうなりますか?
K.J.K.様 お世話になります。
> EMREXTTEXTOUT.emrtext.rcl や EXTLOGFONT.elfLogFont.lfWidth の値などを
> 換えてみるとどうなりますか?
EMREXTTEXTOUT.emrtext.rclは
Debug.Print .Left, .Top, .Right, .Bottom で全て
0 , 0 , -1 , -1 のみ返します。
EXTLOGFONT.elfLogFont.lfWidth はフォント自体(１文字？)の幅でしょうか？
→ 値は 0 となっています。省略値？
個人的には、何か上位オブジェクトの矩形領域などを参照している気がします。
⇒あまり関係ないでしょうが、下記のDrawTextでソースの雰囲気からです。
http://www.f3.dion.ne.jp/~element/msaccess/clgdiplusdoc.html#VI-F
Public Function DrawText(pText As String, pSize As Long, Optional pFontName As String, _
Optional pX1 As Long, Optional pY1 As Long, Optional pX2 As Long = -1, Optional pY2 As Long = -1, _
Optional pAlignHoriz As Long = 1, Optional pAlignVert As Long = 1, _
Optional pPenColor As Long = 0, Optional pPenAlpha As Integer = 255, _
Optional pBackColor As Long = -1, Optional pBackAlpha As Integer = 255, _
Optional pItalic As Boolean, Optional pBold As Boolean, _
Optional pUnderline As Boolean, Optional pStrikeout As Boolean, _
Optional pAntialiase As Boolean = False, Optional pOnlyGetSize As Boolean = False) As Boolean
' Conversion si controle de reference
If Not gCtrlRef Is Nothing Then
pX1 = CtrlToImgX(pX1, gCtrlRef, True)
pY1 = CtrlToImgY(pY1, gCtrlRef, True)
pX2 = CtrlToImgX(pX2, gCtrlRef, True)
pY2 = CtrlToImgY(pY2, gCtrlRef, True)
End If
DrawText = PrivDrawText(pText, pSize, pFontName, pX1, pY1, pX2, pY2, _
pAlignHoriz, pAlignVert, pPenColor, pPenAlpha, pBackColor, pBackAlpha, _
pItalic, pBold, pUnderline, pStrikeout, pAntialiase, pOnlyGetSize)
End Function
Private Function PrivDrawText(pText As String, pSize As Long, Optional ByVal pFontName As String, _
Optional pX1 As Long, Optional pY1 As Long, Optional pX2 As Long = -1, Optional pY2 As Long = -1, _
Optional ByVal pAlignHoriz As Long = 1, Optional ByVal pAlignVert As Long = 1, _
Optional pPenColor As Long = 0, Optional pPenAlpha As Integer = 255, _
Optional pBackColor As Long = -1, Optional pBackAlpha As Integer = 255, _
Optional pItalic As Boolean, Optional pBold As Boolean, _
Optional pUnderline As Boolean, Optional pStrikeout As Boolean, _
Optional pAntialiase As Boolean = False, Optional pOnlyGetSize As Boolean = False, _
Optional pImage As String = "") As Boolean
Dim lGraphics As Long
Dim lFontFamily As Long, lFont As Long
Dim lTextBrush As Long, lBackBrush As Long
Dim lTextRect As RECTF
Dim lCalcRect As RECTF
Dim lStrFormat As Long
Dim lBitmap As Long
Dim lwidth As Single, lheight As Single
Dim lCenter As Boolean
Dim lStyle As Long
On Error GoTo gestion_erreurs
If pImage = "" Then
ConvertTo32Bits gBitmapWork
lBitmap = gBitmapWork
Else
lBitmap = gImgList(pImage)
End If
' Rectangle de positionnement du texte
' Dimensions de l'image
GdipGetImageDimension lBitmap, lwidth, lheight
If pX2 = -1 And pY2 = -1 Then
lCenter = True
End If
If pX2 = -1 Then pX2 = lwidth
If pY2 = -1 Then pY2 = lheight
lTextRect.Left = pX1
lTextRect.Top = pY1
lTextRect.Right = pX2 - pX1
lTextRect.Bottom = pY2 - pY1
以下省略します。
よろしくお願いします。
GetEnhMetaFileBits を用いずに、動的に EnumEnhMetaFile + PlayEnhMetaFileRecord
で行うとどうなりますか?
K.J.K.様
> GetEnhMetaFileBits を用いずに、動的に EnumEnhMetaFile + PlayEnhMetaFileRecord
> で行うとどうなりますか?
http://nienie.com/~masapico/api_sample_metafile03_vb.html
上記ののサンプルを見ながらトライしていましたが、最初は
RtlMoveMemory VarPtr(eh), pRecord, Len(eh) が上手く機能しないのか
eh.iTypeが全て0となり、海外のサイトを参考にしながら
EnumEnhMetaFile + PlayEnhMetaFileRecordでiTypeを確認しながら単純再生は
出きるようになりました。
しかし、パラメータの変更など、MoveMemoryが上手くできず？
挫折しました。
その後、下記の記載を見つけました。
http://msdn.microsoft.com/en-us/library/dd162591(VS.85).aspx
http://msdn.microsoft.com/en-us/library/cc230576(PROT.10).aspx
offDx
Offset to intercharacter spacing array.
これを如何に使うかがヒントかと思い下記の情報も得ました。
http://social.microsoft.com/Forums/ja-JP/os_windowsprotocols/thread/85805191-98f2-4087-a829-5e65cc3bd21e
しかし、結局どう使って良いのかわからず、試しに
emrtext.offDx = 0
としたところ、上手く文字間隔が詰まりました。
→ emrtext.offDx = 0 とすることで指定条件が解除され、標準的な配置に
されたのでしょうか？
とりあえず、これで様子見ですが上記ＨＰなどの情報を含め、何かお気づきの
点がありましたらご教授願います。
offDx = 0 でいけるというのは面白いですね。
本来そこには影響を与えていないようにも思えますが、
やはり何かしらのリセット効果があるのかも知れません。