フォントの英文表記名の取得 への返答

投稿で使用できる特殊コードの説明。(別タブで開きます。)
本名は入力しないようにしましょう。
投稿した後で削除するときに使うパスワードです。返答があった後は削除できません。
返答する人が目安にします。相手が小学生か社会人かで返答の仕方も変わります。
最初の投稿が質問の場合、質問者が解決時にチェックしてください。(以降も追加書き込み・返信は可能です。)
※「過去ログ」について書くときはその過去ログのURLも書いてください。

以下の返答は逆順(新しい順)に並んでいます。

投稿者 ぽく  (小学生) 投稿日時 2008/10/21 08:52:35
頑張ってくださいな。
それと僕は「ぼく(BOKU)」ではなく「ぽく(POKU)」です。
投稿者 うたひこ  (社会人) 投稿日時 2008/10/21 06:21:48
IDisposableな方のぼくさん、
わざわざ翻訳までしていただき、
ありがとうございます。



気付くのが遅かったのですが、
実はリンクを貼り間違えてまして…

http://www.geocities.jp/fjtkt/program/2004_0010.html

僕が最初に貼ったリンクは、
上に貼ったリンクの前段階に当たるもののようでした。

(実行ファイルがどーたらこーたらと言ったけど、
最初のリンク先ではそんなの配布してなかったです…
ごめんなさい。)

とはいえこれだけのヒントをいただいたので、
とりあえず通常のTrueTypeだけでも
なんとか英名を取得できるようにして、
こちらに掲載させていただこうと思います。

(OpenTypeとかまで考えると途方もないですね…。
 他のフォント形式は対応する気がないですが。)

投稿者 ぽく  (小学生) 投稿日時 2008/10/19 13:02:55
C++やDelphiみたいに
f.Read(構造体のポインタ,読み込むサイズ)
とか出来なかったからFileStreamのReadメソッドでちまちま読み込んでメンバに放り込んでってます。
サブルーチンに切り出して序にEndianの切り替えもやっちゃってます。
そこ以外は大体そのまんまなハズ。
あとEncodingがSHIFT-JISなのは適当です。

一応、再現は出来ていると思う。
只今のままだとttcファイルには対応していないし
フォント名が複数設定されていても一つしか取ってこないし
正直あまり使い物にならないかも

あくまで参考程度に見といてくだしゃい。

>ぼく
プレゼントじゃないけど教材にしていいよw
投稿者 ぽく  (小学生) 投稿日時 2008/10/19 12:35:52
サブルーチン

Private Function ReadUShort(ByRef fs As FileStream) As UInt16
    Dim buf(1) As Byte
    buf = ReadAndSwap(fs, buf.Length)
    Return BitConverter.ToUInt16(buf, 0)
End Function

Private Function ReadULong(ByRef fs As FileStream) As UInt32
    Dim buf(3) As Byte
    buf = ReadAndSwap(fs, buf.Length)
    Return BitConverter.ToUInt32(buf, 0)
End Function

Private Function ReadAndSwap(ByRef fs As FileStream, ByVal size As IntegerAs Byte()
    Dim buf(size - 1) As Byte
    fs.Read(buf, 0, buf.Length)
    Array.Reverse(buf)
    Return buf
End Function

投稿者 ぽく  (小学生) 投稿日時 2008/10/19 12:33:33
メイン処理

Imports System.IO
Imports System.Text

Private Function GetFontNameFromFile(ByVal fontFilePath As StringAs String
    Dim strRet As String = String.Empty

    Using fs As New FileStream(fontFilePath, FileMode.Open, FileAccess.Read)
        '***************ファイルヘッダー読込*************** 
        Dim ttOffsetTable As New TT_OFFSET_TABLE
        With ttOffsetTable
            .uMajorVersion = ReadUShort(fs)
            .uMinorVersion = ReadUShort(fs)
            .uNumOfTables = ReadUShort(fs)
            .uSearchRange = ReadUShort(fs)
            .uEntrySelector = ReadUShort(fs)
            .uRangeShift = ReadUShort(fs)
        End With

        'バージョンが1.0じゃないなら終了 
        If ttOffsetTable.uMajorVersion <> 1 Or ttOffsetTable.uMinorVersion <> 0 Then
            Return strRet
        End If

        '***************オフセットテーブル検索*************** 
        Dim tblDir As New TT_TABLE_DIRECTORY
        Dim found As Boolean = False

        For i As Integer = 0 To ttOffsetTable.uNumOfTables
            With tblDir
                .Initialize()
                fs.Read(.szTag, 0, .szTag.Length)
                .uCheckSum = ReadULong(fs)
                .uOffset = ReadULong(fs)
                .uLength = ReadULong(fs)
            End With

            'テーブル名チェック 
            Dim enc As Encoding = Encoding.GetEncoding("SHIFT-JIS")
            Dim s As String = enc.GetString(tblDir.szTag)
            If StrComp(s, "name") = 0 Then
                found = True
                Exit For
            End If
        Next

        If Not found Then Return strRet

        '***************Nameテーブルヘッダ読込*************** 
        fs.Seek(tblDir.uOffset, SeekOrigin.Begin)
        Dim ttNTHeader As New TT_NAME_TABLE_HEADER
        With ttNTHeader
            .uFSelector = ReadUShort(fs)
            .uNRCount = ReadUShort(fs)
            .uStorageOffset = ReadUShort(fs)
        End With

        '***************Nameテーブルレコード読込*************** 
        Dim ttRecord As New TT_NAME_RECORD
        For j As Integer = 0 To ttNTHeader.uNRCount
            With ttRecord
                .uPlatformID = ReadUShort(fs)
                .uEncodingID = ReadUShort(fs)
                .uLanguageID = ReadUShort(fs)
                .uNameID = ReadUShort(fs)
                .uStringLength = ReadUShort(fs)
                .uStringOffset = ReadUShort(fs)
            End With

            'NameID = 1 がフォント名らしい 
            If ttRecord.uNameID <> 1 Then Continue For

            '現在のポジションを保持 
            Dim nPos As Integer = fs.Position
            fs.Seek(tblDir.uOffset + ttRecord.uStringOffset + ttNTHeader.uStorageOffset, SeekOrigin.Begin)

            'フォント名取得 
            Dim buf(ttRecord.uStringLength - 1) As Byte
            fs.Read(buf, 0, ttRecord.uStringLength)
            Dim enc As Encoding = Encoding.GetEncoding("SHIFT-JIS")
            strRet = enc.GetString(buf)

            If strRet <> "" Then Exit For

            fs.Seek(nPos, SeekOrigin.Begin)
        Next

        Return strRet
    End Using
End Function
投稿者 ぽく  (小学生) 投稿日時 2008/10/19 12:29:20
ちょっと書き殴ってみた。

'***************構造体定義*************** 
Public Structure TT_OFFSET_TABLE
    Public uMajorVersion As UShort
    Public uMinorVersion As UShort
    Public uNumOfTables As UShort
    Public uSearchRange As UShort
    Public uEntrySelector As UShort
    Public uRangeShift As UShort
End Structure

Public Structure TT_TABLE_DIRECTORY
    'Public szTag() As Char 
    Public szTag() As Byte
    Public uCheckSum As UInt32
    Public uOffset As UInt32
    Public uLength As UInt32

    Public Sub Initialize()
        ReDim szTag(3)
    End Sub
End Structure

Public Structure TT_NAME_TABLE_HEADER
    Public uFSelector As UShort
    Public uNRCount As UShort
    Public uStorageOffset As UShort
End Structure

Public Structure TT_NAME_RECORD
    Public uPlatformID As UShort
    Public uEncodingID As UShort
    Public uLanguageID As UShort
    Public uNameID As UShort
    Public uStringLength As UShort
    Public uStringOffset As UShort
End Structure


長いので分割
投稿者 うたひこ  (社会人) 投稿日時 2008/10/19 05:56:55
すみません、リンク先をさらによく見たところ、
リンク先の元になっているコードへのリンクが貼られており、
さらにまた別の言語で書かれているようでした。

http://www.codeguru.com/Cpp/G-M/gdi/fonthandlinganddetection/article.php/c3659/

多分、CかC++だと思うのですが、やはりよくわかりませんので、
どなたかお分かりの方がいらっしゃいましたら、
アドバイスお願いいたします。
投稿者 うたひこ  (社会人) 投稿日時 2008/10/19 05:47:15
その後、
「ttf ヘッダ 読み込み」「otf ヘッダ 読み込み」
などのワードで検索したところ、
下記の記事を発見しました。

http://www.geocities.jp/fjtkt/program/2004_0006.html

ページ上にて配布されているサンプルプログラムで
フォントフォルダをトレースしてみたところ、
自分の目的の情報を取得できました。

恐らくはこちらに掲載されているサンプルコードで
目的の情報が取得できると思うのですが、
Delphi6で記述されているようなので、
僕にはよくわかりませんでした。

このコードをVBに書き直すつもりですが、
・文法
・データ型の対応関係
などが全然わからないので、
もしDelphi使いの方がいらっしゃいましたら、
アドバイス下さるようよろしくお願いいたします。
投稿者 うたひこ  (社会人) 投稿日時 2008/10/18 07:07:50

お世話になっております。



VB2005ExpressEditionを用いて、
データをSVGファイル形式に書き出すクラスを開発しています。

http://www.hcn.zaq.ne.jp/___/REC-SVG11-20030114/index.html
こちらの仕様書と、
このファイル形式への出力をサポートするいくつかのソフトウェアから
出力されたファイルを参考に開発しています。

このファイル中のtext要素には、font-family属性として、
フォントファミリーを指定することができますが、
英名表記のフォントファミリー名しか
(少なくとも僕の使用しているソフトウェアでは)
読み込まれないみたいなのです。

FontFamilyクラスのNameプロパティや
ToStringメソッドでは、和文フォント名しか取得できず、
GetNameメソッドというものを発見して以下のように試してみても、
やはり和文フォント名しか取得できませんでした。

    'Sub Main() 
    '    Using F As Drawing.FontFamily = New Drawing.FontFamily("MS Gothic") 
    '        For i As Integer = 0 To Integer.MaxValue 
    '            Console.WriteLine(F.GetName(i)) 
    '        Next 
    '        Console.Read() 
    '    End Using 

    'End Sub 
    Sub Main()
        Using F As Drawing.FontFamily = Drawing.SystemFonts.DefaultFont.FontFamily
            For i As Integer = 0 To Integer.MaxValue
                Console.WriteLine(F.GetName(i))
            Next
            Console.Read()
        End Using
    End Sub


フォントファイルには、確か、ヘッダ部分に和名や英名などの
メタ情報が記載されているはずだと記憶していますが、
そういった情報はどのようにしたら取得できるでしょうか?

調べてみたところ、
http://hpcgi1.nifty.com/MADIA/VBBBS/wwwlng.cgi?print+200311/03110121.txt
このような類似情報を発見しましたが、こちらも未解決となっているようです。
問題自体はこのリンク先のものと全く同じです。

何かいい手はないでしょうか?
よろしくお願いいたします。