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

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



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
このような類似情報を発見しましたが、こちらも未解決となっているようです。
問題自体はこのリンク先のものと全く同じです。

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

その後、
「ttf ヘッダ　読み込み」「otf ヘッダ　読み込み」
などのワードで検索したところ、
下記の記事を発見しました。

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

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

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

このコードをVBに書き直すつもりですが、
・文法
・データ型の対応関係
などが全然わからないので、
もしDelphi使いの方がいらっしゃいましたら、
アドバイス下さるようよろしくお願いいたします。

すみません、リンク先をさらによく見たところ、
リンク先の元になっているコードへのリンクが貼られており、
さらにまた別の言語で書かれているようでした。

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

多分、CかC++だと思うのですが、やはりよくわかりませんので、
どなたかお分かりの方がいらっしゃいましたら、
アドバイスお願いいたします。

ちょっと書き殴ってみた。

'***************構造体定義*************** 

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

長いので分割

メイン処理

Imports System.IO

Imports System.Text



Private Function GetFontNameFromFile(ByVal fontFilePath As String) As 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

サブルーチン

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 Integer) As Byte()

    Dim buf(size - 1) As Byte

    fs.Read(buf, 0, buf.Length)

    Array.Reverse(buf)

    Return buf

End Function

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

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

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

>ぼく
プレゼントじゃないけど教材にしていいよｗ

IDisposableな方のぼくさん、
わざわざ翻訳までしていただき、
ありがとうございます。



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

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

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

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

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

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

頑張ってくださいな。
それと僕は「ぼく(BOKU)」ではなく「ぽく(POKU)」です。