VBでのカナの自動入力方法について

VBで名前など、漢字で入力したのを、カナの自動入力できる方法はどのようにすればいいでしょうか？
（ACCESSにおけるカナ自動入力と同じ方法のようなものです）

No.2 ベストアンサー 回答者： TAGOSAKU7 回答日時： 2002/11/01 09:51

過去スレ 「InputManを使えで解決」

http://oshiete1.goo.ne.jp/kotaeru.php3?q=42751


それ以外に力技で作ることも可能です。
（InputManが現実にあるように）
しかしこの方法は、かなり作りこまないと、実用には難しいと思います。
簡単なフリガナ取得サンプルを載せておきます。

この方法は今は亡き「Visual Basic増強作戦」という超有名サイトで公開されていた、IMEの操作サンプルを元に作ったものです。完全体ではないので、かなりの改造を必要とします。

※サンプル構成
Project1
├Form1（フォーム）
│├TextBox1
│└TextBox2
└Class1（クラス）


－－－ Form1 －－－
Option Explicit
Dim clsKana As Class1

Private Sub Form_Load()
　　Text1.Text = ""
　　Text2.Text = ""

　　Set clsKana = New clsKana
　　clsKana.Target = Text1.hwnd
　　clsKana.IMEOpen = True
　　clsKana.IMEMode = 1
End Sub

Private Sub Form_Unload(Cancel As Integer)
　　Set clsKana = Nothing
End Sub

Private Sub Text1_Change()
　　If Not clsKana Is Nothing Then
　　　　Me.Text2.Text = clsKana.ResultRead
　　End If
End Sub


－－－ Class1 －－－
Option Explicit

Private Declare Function ImmGetOpenStatus Lib "Imm32.dll" (ByVal hIMC As Long) As Long
Private Declare Function ImmSetOpenStatus Lib "Imm32.dll" (ByVal hIMC As Long, ByVal b As Long) As Long
Private Declare Function ImmGetConversionStatus Lib "Imm32.dll" (ByVal hIMC As Long, lpdw As Long, lpdw2 As Long) As Long
Private Declare Function ImmSetConversionStatus Lib "Imm32.dll" (ByVal hIMC As Long, ByVal dw1 As Long, ByVal dw2 As Long) As Long
Private Declare Function ImmGetCompositionString Lib "Imm32.dll" Alias "ImmGetCompositionStringA" (ByVal hIMC As Long, ByVal dw As Long, lpv As Any, ByVal dw2 As Long) As Long
Private Declare Function ImmReleaseContext Lib "Imm32.dll" (ByVal hwnd As Long, ByVal hIMC As Long) As Long
Private Declare Function ImmGetContext Lib "Imm32.dll" (ByVal hwnd As Long) As Long

Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetKeyboardLayout Lib "user32" (ByVal dwLayout As Long) As Long


Private lngAPIReVal As Long　　 'APIの戻り値を格納
Private lngIMEHandle As Long　　'IMEのコンテキストを格納
Private lngTargetWindow As Long '操作対象ウィンドウのハンドル
Private lngLayoutHandle As Long 'キーボードレイアウトのハンドル

Private Const GCS_RESULTREADSTR = &H200　　　'結果文字列の読み
'入力モードの定数
Private Const IME_CMODE_NATIVE = &H1　　'直接入力
Private Const IME_CMODE_KATAKANA = &H2　'カタカナ
Private Const IME_CMODE_LANGUAGE = &H3　'日本語
Private Const IME_CMODE_FULLSHAPE = &H8 '全角
Private Const IME_CMODE_ROMAN = &H10　　'ローマ字
Private Const IME_CMODE_CHARCODE = &H20 'コード入力

'初期変換方式の定数
Private Const IME_SMODE_NONE = &H0　　　　　'無変換
Private Const IME_SMODE_PLAURALCLAUSE = &H1 '複合語優先
Private Const IME_SMODE_SINGLECONVERT = &H2 '不明
Private Const IME_SMODE_AUTOMATIC = &H4　　 '自動
Private Const IME_SMODE_PHRASEPREDICT = &H8 '連文節

Private Sub Class_Initialize()
　　lngLayoutHandle = GetKeyboardLayout(0)
End Sub
Private Sub Class_Terminate()
　　lngAPIReVal = ImmReleaseContext(lngTargetWindow, lngIMEHandle)
End Sub

Public Property Get Target() As Long
　　Target = lngIMEHandle
End Property

Public Property Let Target(lngNewTarget As Long)
　　lngAPIReVal = ImmReleaseContext(lngTargetWindow, lngIMEHandle)
　　If IsWindow(lngNewTarget) = 0 Then
　　　　Exit Property
　　End If
　　lngTargetWindow = lngNewTarget
　　lngIMEHandle = ImmGetContext(lngNewTarget)
End Property


Public Property Get ResultRead() As String
　　Dim strBuff As String * 256
　　Dim lngNullCharPos As Long
　　Dim lngSpaceCharPos As Long

　　'変換結果の「読み」を取得
　　lngAPIReVal = ImmGetCompositionString(lngIMEHandle, _
　　　　　　GCS_RESULTREADSTR, ByVal strBuff, Len(strBuff))

　　lngNullCharPos = InStr(strBuff, vbNullChar)
　　lngSpaceCharPos = InStr(strBuff, " ")

　　If lngNullCharPos > 0 Then
　　　　ResultRead = Left$(strBuff, InStr(strBuff, vbNullChar) - 1)
　　ElseIf lngSpaceCharPos > 0 Then
　　　　ResultRead = Left$(strBuff, InStr(strBuff, " ") - 1)
　　End If

End Property



Public Property Get IMEOpen() As Boolean
　　If ImmGetOpenStatus(lngIMEHandle) = 1 Then
　　　　IMEOpen = True
　　Else
　　　　IMEOpen = False
　　End If
End Property

Public Property Let IMEOpen(tofNewValue As Boolean)
　　If tofNewValue = True Then
　　　　lngAPIReVal = ImmSetOpenStatus(lngIMEHandle, 1)
　　Else
　　　　lngAPIReVal = ImmSetOpenStatus(lngIMEHandle, 0)
　　End If
End Property


Public Property Get IMEMode() As Long
　　Dim lngInputMode As Long
　　Dim lngConvertMode As Long
　　
　　lngAPIReVal = ImmGetConversionStatus(lngIMEHandle, _
　　　　　　lngInputMode, lngConvertMode)

　　'日本語の場合
　　If lngInputMode And IME_CMODE_LANGUAGE Then
　　　　'全角ひらがなである
　　　　IMEMode = 1
　　　　'カタカナの場合
　　　　If lngInputMode And IME_CMODE_KATAKANA Then
　　　　　　'全角の場合
　　　　　　If lngInputMode And IME_CMODE_FULLSHAPE Then
　　　　　　　　'全角カタカナである
　　　　　　　　IMEMode = 2
　　　　　　Else
　　　　　　　　'半角カタカナである
　　　　　　　　IMEMode = 4
　　　　　　End If
　　　　End If
　　Else
　　　　'全角の場合
　　　　If lngInputMode And IME_CMODE_FULLSHAPE Then
　　　　　　'全角英数である
　　　　　　IMEMode = 3
　　　　Else
　　　　　　'半角英数である
　　　　　　IMEMode = 5
　　　　End If
　　End If

End Property

Public Property Let IMEMode(lngNewMode As Long)

　　Dim lngInputMode As Long
　　Dim lngConvertMode As Long

　　'IMEの初期変換方式と入力モードを取得
　　lngAPIReVal = ImmGetConversionStatus(lngIMEHandle, lngInputMode, lngConvertMode)

　　'入力モードの設定
　　Select Case lngNewMode
　　Case 1
　　　　'全角ひらがなの場合
　　　　lngInputMode = lngInputMode And Not IME_CMODE_KATAKANA
　　　　lngInputMode = lngInputMode Or IME_CMODE_FULLSHAPE Or IME_CMODE_NATIVE
　　Case 2
　　　　'全角カタカナの場合
　　　　lngInputMode = lngInputMode Or IME_CMODE_LANGUAGE Or IME_CMODE_FULLSHAPE Or IME_CMODE_KATAKANA
　　Case 3
　　　　'全角英数の場合
　　　　lngInputMode = lngInputMode And Not IME_CMODE_LANGUAGE
　　　　lngInputMode = lngInputMode Or IME_CMODE_FULLSHAPE
　　Case 4
　　　　'半角カタカナの場合
　　　　lngInputMode = lngInputMode And Not IME_CMODE_FULLSHAPE
　　　　lngInputMode = lngInputMode Or IME_CMODE_LANGUAGE Or IME_CMODE_KATAKANA
　　Case 5
　　　　'半角英数の場合
　　　　lngInputMode = lngInputMode And Not IME_CMODE_FULLSHAPE
　　　　lngInputMode = lngInputMode And Not IME_CMODE_LANGUAGE
　　End Select
　　lngAPIReVal = ImmSetConversionStatus(lngIMEHandle, lngInputMode, lngConvertMode)
End Property

No.1 回答者： sienna 回答日時： 2002/11/01 08:52

VB5の情報ですが基本的にできないみたいですよ。

http://www.microsoft.com/japan/msdn/vs_previous/ …

下記のような方法もあるみたいですが、BackSpace等を使用すると
意図しない動きをしてしまった記憶があります。
他にもあるかもしれませんが、、参考まで。

http://www.remus.dti.ne.jp/~y-mac/teclib/getcomp …