MS-IMEでモノルビを取得します。Text Services Framework(TSF)を利用して，文全体の読み仮名や，一つ一つの文字に対しての読み仮名を取得することができます。
※下のコードは今ひとつ不安定です。APIの定義が間違っているのかもしれません。
下のコードをフォームのコードにコピー・貼り付けをすれば動作します。
Option Explicit On
Option Strict On
Imports System.Runtime.InteropServices
Public Class Form1
Private WithEvents TextBox1 As New TextBox With {.Multiline = True, .Dock = DockStyle.Fill}
Private MsIme As Type = Type.GetTypeFromProgID("MSIME.Japan")
Private Language As IFELanguage = DirectCast(Activator.CreateInstance(MsIme), IFELanguage)
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Me.Controls.Add(TextBox1)
Language.Open()
Dim KanjiText As String = "天気予報によると，明日は晴れになるでしょう。"
Dim List As List(Of kanjiRuby) = getMonoRuby(KanjiText)
For Each l In List
Me.TextBox1.Text &= l.kanji & "(" & l.ruby & ")" & vbCrLf
Next
Language.Close()
Marshal.FinalReleaseComObject(Language)
End Sub
Public Function getMonoRuby(kanjiSentence As String) As List(Of kanjiRuby)
Dim resultPtr As IntPtr
Dim hr As Integer = Language.GetJMorphResult(FELANG_REQ.REV, FELANG_CMODE.MONORUBY, kanjiSentence.Length, kanjiSentence, 0, resultPtr)
Dim result As MORRSLT = DirectCast(Marshal.PtrToStructure(resultPtr, GetType(MORRSLT)), MORRSLT)
Dim length As Integer = kanjiSentence.Length
Dim kanjiRubyPosList = {New With {.kanji = "", .rubyPos = 0}}.ToList
kanjiRubyPosList.Clear()
For i As Integer = 0 To length
Dim kanji As String = If(i < length, kanjiSentence.Substring(i, 1), "")
Dim rubyPos As Integer = CInt(Marshal.ReadInt16(result.paMonoRubyPos, i * 2))
kanjiRubyPosList.Add(New With {kanji, rubyPos})
Next
For i As Integer = length To 0 Step -1
If kanjiRubyPosList(i).rubyPos = -1 Then
kanjiRubyPosList(i - 1).kanji &= kanjiRubyPosList(i).kanji
kanjiRubyPosList.Remove(kanjiRubyPosList(i))
End If
Next
Dim rubySentence As String = Marshal.PtrToStringUni(result.pwchOutput, CInt(result.cchOutput))
Dim kanjiRubyList As New List(Of kanjiRuby)
For i As Integer = 0 To kanjiRubyPosList.Count - 2
Dim kanji As String = kanjiRubyPosList(i).kanji
Dim rubyStartPos As Integer = kanjiRubyPosList(i).rubyPos
Dim rubyEndPos As Integer = kanjiRubyPosList(i + 1).rubyPos
Dim rubyLength As Integer = rubyEndPos - rubyStartPos
Dim ruby As String = rubySentence.Substring(rubyStartPos, rubyLength)
kanjiRubyList.Add(New kanjiRuby With {.kanji = kanji, .ruby = ruby})
Next
Return kanjiRubyList
End Function
Public Class kanjiRuby
Property kanji As String
Property ruby As String
End Class
End Class
Public NotInheritable Class Interface_ID
Public Const IID_IFECommon As String = "019F7151-E6DB-11d0-83C3-00C04FDDB82E"
Public Const IID_IFELanguage As String = "019F7152-E6DB-11d0-83C3-00C04FDDB82E"
Public Const IID_IFELanguage2 As String = "21164102-C24A-11d1-851A-00C04FCC6B14"
Public Const IID_IFEDictionary As String = "019F7153-E6DB-11d0-83C3-00C04FDDB82E"
End Class
<ComImport>
<Guid(Interface_ID.IID_IFELanguage)>
<InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
Public Interface IFELanguage
<PreserveSig>
Function Open() As Integer
<PreserveSig>
Function Close() As Integer
<PreserveSig>
Function GetJMorphResult(<[In]> dwRequest As FELANG_REQ,
<[In]> dwCMode As FELANG_CMODE,
<[In]> cwchInput As Integer,
<[In], MarshalAs(UnmanagedType.LPWStr)> pwchInput As String,
<[In]> ByRef pfCInfo As FELANG_CLMN,
<Out> ByRef ppResult As IntPtr) As Integer
<PreserveSig>
Function GetConversionModeCaps(<Out> ByRef pdwCaps As UInteger) As Integer
<PreserveSig>
Function GetPhonetic(<[In]> [string] As String,
<[In]> start As Integer,
<[In]> length As Integer,
<Out> ByRef phonetic As String) As Integer
<PreserveSig>
Function GetConversion(<[In], MarshalAs(UnmanagedType.BStr)> [string] As String,
<[In]> start As Integer,
<[In]> length As Integer,
<Out> ByRef result As String) As Integer
End Interface
Public Enum FELANG_REQ As UInteger
CONV = &H10000
RECONV = &H20000
REV = &H30000
End Enum
Public Enum FELANG_CLMN As UInteger
WBREAK = &H1
NOWBREAK = &H2
PBREAK = &H4
NOPBREAK = &H8
FIXR = &H10
FIXD = &H20
End Enum
Public Enum FELANG_CMODE As UInteger
MONORUBY = &H2
NOPRUNING = &H4
KATAKANAOUT = &H8
HIRAGANAOUT = &H0
HALFWIDTHOUT = &H10
FULLWIDTHOUT = &H20
BOPOMOFO = &H40
HANGUL = &H80
PINYIN = &H100
PRECONV = &H200
RADICAL = &H400
UNKNOWNREADING = &H800
MERGECAND = &H1000
ROMAN = &H2000
BESTFIRST = &H4000
USENOREVWORDS = &H8000
NONE = &H1000000
PLAURALCLAUSE = &H2000000
SINGLECONVERT = &H4000000
AUTOMATIC = &H8000000
PHRASEPREDICT = &H10000000
CONVERSATION = &H20000000
NAME = PHRASEPREDICT
NOINVISIBLECHAR = &H40000000
End Enum
<StructLayout(LayoutKind.Explicit, Size:=48, Pack:=1)>
Public Structure MORRSLT
<FieldOffset(0)> Public dwSize As UInt32
<FieldOffset(4)> Public pwchOutput As IntPtr
<FieldOffset(8)> Public cchOutput As UInt16
<FieldOffset(10)> Public pwchRead As IntPtr
<FieldOffset(14)> Public cchRead As UInt16
<FieldOffset(16)> Public pchInputPos As IntPtr
<FieldOffset(20)> Public pchOutPutIdxWDD As IntPtr
<FieldOffset(24)> Public pchReadIdxWDD As IntPtr
<FieldOffset(28)> Public paMonoRubyPos As IntPtr
<FieldOffset(32)> Public pWDD As IntPtr
<FieldOffset(36)> Public cWDD As Int32
<FieldOffset(40)> Public pPrivate As IntPtr
<FieldOffset(44)> Public BLKBuff As IntPtr
End Structure
検索
VB.NET Tips
3Dプリンター