テキスト（フォント）の幅を取得するには？

まさ 2004-02-11 09:00:08 No: 81946

テキスト（フォント）の幅を取得するにはどうすればよいでしょうか？

ActiveReportというOCXのRichEditを使っているのですが、あるリッチテキストによっては用紙右端からはみ出します。問い合わせたところバグらしく、自前で改行処理しようと思っています。

API等探してみたのですが、見当たりません。プリンタフォントへの変換はせず、Windowsフォントのみを扱うので、ttcファイルから抜き出すなり、APIで取得するなりで対応できると考えています。

岡田之仁 2004-02-11 17:10:30 No: 81947

GetTextExtentPoint32 や、GetCharacterPlacement をお調べ
下さい。尚、私はＶＢでは使ったことがないので・・・

以上。

まさ 2004-02-11 22:55:16 No: 81948

岡田さん回答ありがとうございます。

GetTextExtentPoint32を早速使ってみました。
文字列がリッチテキストボックスの端に達した位置を取得し、改行コードを
入れようと思ったのですが、結果から言うとうまくいきませんでした。
リッチテキストボックスの幅と、APIを使って取得した一行分のテキストの幅の
値が一致しないのです。

GetTextExtentPoint32の引数にリッチテキストボックスのハンドルを指定したところ、幅は取得できましたがフォントサイズを変えても幅は変わりません。
調べていると以下の記事があり（ＶＣですが）、ハンドルにフォントを指定しないといけないようです。
http://216.239.53.104/search?q=cache:tjhkHbjz7m4J:cgi23.plala.or.jp/a-w-h/mfc/horizon.html+%E3%83%87%E3%83%90%E3%82%A4%E3%82%B9%E3%82%B3%E3%83%B3%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88%E3%81%AB%E3%83%95%E3%82%A9%E3%83%B3%E3%83%88&hl=ja&lr=lang_ja&ie=UTF-8

そこでCreateFontでフォントを作成し、SelectObjectでリッチテキストボックスのハンドルに
割り当ててGetTextExtentPoint32を呼び出したところ、フォントサイズを大きくすると、幅も大きくなりました。

しかしリッチテキストボックスの幅が10500twipsに対し、取得できた幅が17640とずいぶん違います。
単位の考え方が違うのか、取得方法に誤りがあるのかわかりません。

コードをのせました（加工したので誤りがあるかも）

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Dim hDC as Long
    Dim lnghFont1, lnghFont2 as Long
    Dim udtSize as TSize

Lich1.SelStart = 1 'フォント名、フォントサイズ取得のため
Lich1.SelLength = 1 '最初の一文字（フォントは均一）

    lnghFont1 = CreateFont(0, 0, 0, 0, 0, False, False, False, _
                1, False, False, False, False, Lich1.SelFontName)
    MsgBox Lich1.SelFontSize '10.5
    MsgBox Lich1.SelFontName 'ＭＳＰ明朝

    hDC = GetDC(Lich1.hwnd)
    lnghFont2 = SelectObject(hDC, lnghFont1)

    Call GetTextExtentPoint32(hDC, Lich1.Text, LenB(Lich1.Text), udtSize)

    Call SelectObject(hDC, lnghFont2)
    'Call DeleteObject(lnghFont1) 'なぜかエラーがでるけどいまは無視
    Call ReleaseDC(Lich1.hwnd, hDC)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

以上よろしくお願いします。

まさ 2004-02-11 22:59:22 No: 81949

追記)
udtSize.cxは882(pt?)となるので、882 / 72(inch変換) * 1440(twips変換)=17640です。
たぶん単位換算が違う気がします。SIZE構造体の単位がわかりません・・・。

岡田之仁 2004-02-12 01:50:05 No: 81950

確認ですが・・・

計算時に指定しているフォント情報と、実際にRichTextBoxに
設定しているフォント情報は同じになっていますか？

以上。

まさ 2004-02-12 07:30:18 No: 81951

フォントサイズ、フォント名共に同じにしています。
いまはテストのためフォントを均一にしていますが、これがうまくいったら
フォント情報が変った時点で上記の処理を繰り返そうと思っています。

岡田之仁 2004-02-12 16:08:00 No: 81952

いろいろ試してみましたが・・・
あくまで固定幅フォントとして計算されてしまっているようで
RichTextBoxのWidthギリギリでのサイズ判定・改行挿入には、
なりませんでした。

ただし、約１文字程度短い部分で改行が入りますので、バリア
ブルピッチのフォントであれば、固定幅フォントの同じ文字列
長を超えることは、無いはずですので、はみ出しはしないと、
思います。

尚・・・（MSDNのヘルプ抜粋）
デバイスの中には、通常のセル配列に文字を配置しないデバイス
（すなわちカーニングを実行するデバイス）もあるため、文字列
内の個々の文字のサイズの総計と文字列全体のサイズとが一致し
ないことがあります。
とあります。

上記の固定幅よりは短い部分での改行となるはずですので、安全
ではありますが、見栄え上、不細工な場合はあるかもしれません。

プログラムは、このようにしてみました。

szFont = RichTextBox1.Font.Name + Chr$(0)

lnghFont1 = CreateFont(0, 0, 0, 0, 0, False, False, False, SHIFTJIS_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS, PROOF_QUALITY, VARIABLE_PITCH Or FF_DONTCARE, szFont)

    hdc = GetDC(RichTextBox1.hwnd)
    lnghFont2 = SelectObject(hdc, lnghFont1)

    p = 0
    For i = 1 To Len(RichTextBox1.Text)
        lRet = GetTextExtentPoint32(hdc, RichTextBox1.Text, i, udtSize)
        If lRet > 0 Then
            If udtSize.cx * 15 >= RichTextBox1.Width Then
                p = i
                Debug.Print CStr(p)
                Exit For
            End If
        End If
    Next i

    lRet = SelectObject(hdc, lnghFont2)
    lRet = DeleteObject(lnghFont1)
    lRet = ReleaseDC(RichTextBox1.hwnd, hdc)

    If p > 0 Then
        sz = RichTextBox1.Text
        RichTextBox1.Text = Left$(sz, p) & vbCrLf & Right$(sz, Len(sz) - p)
    End If

※  すみません。
    座標系の換算の部分で、『15』倍していますが・・・
    これをどこからかＡＰＩで取得できるはずですが、
    忘れました。多分、ビデオカード等にもよりますが、
    確か、『15』か『16』あたりで良かったはずです。

もし違ったら、知っている方、突っ込みお願いします。

※  それと・・・
    掲載された、コード中の『DeleteObject』の部分で、
    エラーが出る・・・とあります。これは基本的におか
    しいです。ちゃんと、エラーコード見て判断した方が
    他に問題があったりします。
    私の環境では、エラーしませんでした。
    ご参考までに。

以上。

まさ 2004-02-12 23:29:23 No: 81953

岡田さんいつもありがとうございます（サンプルまで・・・ (^^;
上記のコードを使ってみたのですが、うまくいきませんでした。

”abcdefghijklmnopqrstuvwxyz01234567890あいうえお”という文字列だと、
RichTextBoxではrとsの間で切れているのですが、yとzの間で切れます。

うーん、環境の問題もあるのでしょうか？

http://qutto.netfirms.com/LinefeedProblem.zip
※DeleteObjectではエラーはでませんでした。

まさ 2004-02-13 00:00:21 No: 81954

追記)
http://qutto.netfirms.com/LinefeedProblem2.zip
ちょっと修正しました。zipファイルはURLを直接入力して取得して下さい。

CreateFontの第1引数（文字の高さ）が0になっていますが、MSDNにあるとおりに指定してみました。
それでもずれています。う〜む

岡田之仁 2004-02-13 00:18:29 No: 81955

環境の問題があるかも・・・

LinefeedProblem2.zipを解凍して、そのまま実行しますと、
こちらの環境では、『p』と『q』の間で改行されます。
p = i - 1
としてやれば、丁度なんですが・・・

こちらは、WinXP SP1 + VisualStudio6 SP5
同じ設定のプログラムを動作させて、違う結果が出る場合
今回は、フォントの問題があるようですが・・・
現時点では、これだ！と言うものを見つけられていません。

何か解れば、アップさせて頂きますが・・・残念です。

以上。