www.pudn.com > vbvoice.rar > 19.frm
VERSION 5.00
Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX"
Begin VB.Form vc
Caption = "语音识别功能的研究与设计"
ClientHeight = 5565
ClientLeft = 60
ClientTop = 390
ClientWidth = 9000
FillColor = &H00FFFFFF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
LinkTopic = "Form1"
ScaleHeight = 5565
ScaleWidth = 9000
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture6
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 735
Left = 7800
ScaleHeight = 735
ScaleWidth = 750
TabIndex = 12
Top = 3840
Width = 750
End
Begin VB.PictureBox Picture5
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 735
Left = 7800
ScaleHeight = 735
ScaleWidth = 750
TabIndex = 11
Top = 2400
Width = 750
End
Begin VB.PictureBox Picture4
BorderStyle = 0 'None
FillStyle = 0 'Solid
Height = 735
Left = 7800
ScaleHeight = 735
ScaleWidth = 750
TabIndex = 10
Top = 960
Width = 750
End
Begin VB.PictureBox Picture3
Height = 1335
Left = 4920
ScaleHeight = 1275
ScaleWidth = 1845
TabIndex = 9
Top = 3480
Width = 1900
End
Begin VB.PictureBox Picture2
Height = 1335
Left = 4920
ScaleHeight = 1275
ScaleWidth = 1845
TabIndex = 8
Top = 2040
Width = 1900
End
Begin VB.PictureBox Picture1
Height = 1335
Left = 4920
ScaleHeight = 1275
ScaleWidth = 1845
TabIndex = 7
Top = 600
Width = 1900
End
Begin MSCommLib.MSComm MSComm1
Left = 240
Top = 120
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
DTREnable = -1 'True
End
Begin VB.CommandButton Command1
Height = 255
Left = 3480
TabIndex = 3
Top = 600
Width = 615
End
Begin VB.Label Label6
Caption = "对话交流"
Height = 375
Left = 1680
TabIndex = 6
Top = 1080
Width = 1215
End
Begin VB.Label ans
Height = 495
Left = 1680
TabIndex = 5
Top = 2520
Width = 2535
End
Begin VB.Label askword
Height = 495
Left = 1680
TabIndex = 4
Top = 1680
Width = 2295
End
Begin VB.Label Label3
Caption = "回答"
Height = 375
Left = 120
TabIndex = 2
Top = 2520
Width = 975
End
Begin VB.Label Label2
Caption = "问题"
Height = 375
Left = 120
TabIndex = 1
Top = 1680
Width = 855
End
Begin VB.Label Label1
Caption = "简易语音控制"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 960
TabIndex = 0
Top = 480
Width = 2295
End
End
Attribute VB_Name = "vc"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim iLevelInResize As Integer
Dim Voice As SpVoice
Const m_GrammarId = 10
Dim bSpeechInitialized As Boolean
Dim WithEvents RecoContext As SpSharedRecoContext
Attribute RecoContext.VB_VarHelpID = -1
Dim Grammar As ISpeechRecoGrammar
Dim TopRule As ISpeechGrammarRule
Dim ty As Boolean
Dim i As Integer
Private Const NORMAL_PRIORITY_CLASS = &H20&
Public kk As Long
Dim NameOfProc As PROCESS_INFORMATION
Dim NameStart As STARTUPINFO
Private Sub InitializeSpeech()
On Error GoTo ErrorHandler
If Not bSpeechInitialized Then
Debug.Print "okInitializing speech"
Set RecoContext = New SpSharedRecoContext
Set Grammar = RecoContext.CreateGrammar(m_GrammarId)
Set TopRule = Grammar.Rules.Add("toprule", SRATopLevel Or SRADynamic, 1)
RebuildGrammar
Grammar.CmdSetRuleState "TopRule", SGDSActive
bSpeechInitialized = True
End If
Exit Sub
ErrorHandler:
MsgBox "SAPI failed to initialize. This application may not run correctly."
End Sub
Private Sub RebuildGrammar()
On Error GoTo ErrorHandler
TopRule.Clear
Dim i As Integer
Dim j As Integer
Dim ask As String
Dim answer As String
Open App.Path + "\text.txt" For Input As #1
i = 0
Do Until EOF(1)
Input #1, ask, answer, j
TopRule.InitialState.AddWordTransition Nothing, ask, " ", , answer, j, i
i = i + 1
Loop
Close #1
Grammar.Rules.Commit
Exit Sub
ErrorHandler:
MsgBox "Error when rebuiling dynamic list box grammar: " & Err.Number
End Sub
Private Sub RecoContext_Hypothesis(ByVal StreamNumber As Long, _
ByVal StreamPosition As Variant, _
ByVal Result As ISpeechRecoResult _
)
Debug.Print "Hypothesis: " & Result.PhraseInfo.GetText & ", " & _
StreamNumber & ", " & StreamPosition
End Sub
Private Sub RecoContext_Recognition(ByVal StreamNumber As Long, _
ByVal StreamPosition As Variant, _
ByVal RecognitionType As SpeechRecognitionType, _
ByVal Result As ISpeechRecoResult _
)
Debug.Print "Recognition: " & Result.PhraseInfo.GetText & ", " & _
Result.PhraseInfo.Properties(0).Id & ", " & StreamPosition
Set Voice = New SpVoice
Voice.Rate = 3
Dim index As Integer
Dim spword As String
index = Result.PhraseInfo.Properties(0).Id
If index = 0 Then
If Result.PhraseInfo.GrammarId = m_GrammarId Then
askword = Result.PhraseInfo.GetText
ans = Result.PhraseInfo.Properties(0).Name
Me.Refresh
Voice.Speak Result.PhraseInfo.Properties(0).Name, SVSFDefault
End If
Else
askword = Result.PhraseInfo.GetText
Select Case Result.PhraseInfo.Properties(0).Name
Case "now"
ty = True
spword = "现在是北京时间" & Hour(Time()) & "点" & Minute(Time()) & "分"
Case "today"
ty = True
spword = "今天是" & Year(Date) & "年" & Month(Date) & "月" & Day(Date) & "日"
Case "week"
ty = True
spword = "今天是" & WeekdayName(Weekday(Date), , 0)
Case "uup"
ty = False
Command1.Top = Command1.Top - 25
Case "dow"
ty = False
Command1.Top = Command1.Top + 25
Case "left"
ty = False
Command1.Left = Command1.Left - 25
Case "right"
ty = False
Command1.Left = Command1.Left + 25
Case "ybyz"
ty = False
MSComm1.Output = Chr(0)
MSComm1.Output = Chr(8)
Case "ybzz"
ty = False
MSComm1.Output = Chr(0)
MSComm1.Output = Chr(12)
Case "dbst"
ty = False
MSComm1.Output = Chr(16)
MSComm1.Output = Chr(28)
Case "dbxj"
ty = False
MSComm1.Output = Chr(20)
MSComm1.Output = Chr(24)
Case "xbst"
ty = False
MSComm1.Output = Chr(32)
MSComm1.Output = Chr(44)
Case "xbxj"
ty = False
MSComm1.Output = Chr(36)
MSComm1.Output = Chr(40)
Case "wzzz"
ty = False
MSComm1.Output = Chr(48)
MSComm1.Output = Chr(56)
Case "wzyz"
ty = False
MSComm1.Output = Chr(52)
MSComm1.Output = Chr(60)
Case "szz"
ty = False
MSComm1.Output = Chr(68)
MSComm1.Output = Chr(72)
Case "sfk"
ty = False
MSComm1.Output = Chr(64)
MSComm1.Output = Chr(76)
Case "ting"
ty = False
MSComm1.Output = Chr(0)
MSComm1.Output = Chr(4)
MSComm1.Output = Chr(20)
MSComm1.Output = Chr(16)
MSComm1.Output = Chr(36)
MSComm1.Output = Chr(32)
MSComm1.Output = Chr(48)
MSComm1.Output = Chr(52)
MSComm1.Output = Chr(64)
MSComm1.Output = Chr(68)
Case "gbck"
MSComm1.PortOpen = False
Case "dkck"
MsgBox ("您确定打开串口吗?")
MSComm1.PortOpen = True
Case "circle"
ty = False
Circle (2500, 3800), 800, RGB(0, 0, 255)
Case "vanish"
ty = False
Cls
Case "square"
ty = False
Line (1900, 3200)-Step(1200, 1200), RGB(0, 0, 255), B
Case "triangle"
ty = False
Line (1900, 3600)-(3000, 3600), RGB(0, 0, 255)
Line (3000, 3600)-(2450, 2500), RGB(0, 0, 255)
Line (2450, 2500)-(1900, 3600), RGB(0, 0, 255)
Case "hongyi"
ty = False
Picture4.Left = 5520
Picture4.Top = 960
Case "honger"
ty = False
Picture4.Left = 5520
Picture4.Top = 2400
Case "hongsan"
ty = False
Picture4.Left = 5520
Picture4.Top = 3840
Case "qingyi"
ty = False
Picture5.Left = 5520
Picture5.Top = 960
Case "qinger"
ty = False
Picture5.Left = 5520
Picture5.Top = 2400
Case "qingsan"
ty = False
Picture5.Left = 5520
Picture5.Top = 3840
Case "huangyi"
ty = False
Picture6.Left = 5520
Picture6.Top = 960
Case "huanger"
ty = False
Picture6.Left = 5520
Picture6.Top = 2400
Case "huangsan"
ty = False
Picture6.Left = 5520
Picture6.Top = 3840
Case "dakaichengxu"
NameStart.cb = Len(NameStart)
CreateProcessA 0&, "c:\winnt\system32\notepad.exe", 0&, 0&, 1&, _
NORMAL_PRIORITY_CLASS, 0&, 0&, NameStart, NameOfProc
kk = NameOfProc.hProcess
'Shell ("C:\WINNT\system32\notepad.exe")
Case "guanbichengxu"
TerminateProcess kk, 0
End Select
ans = spword
'Me.Refresh
If ty = True Then
Voice.Speak spword, SVSFDefault
End If
End If
End Sub
Private Sub form_load()
If MSComm1.PortOpen = False Then MSComm1.PortOpen = True
bSpeechInitialized = False
InitializeSpeech '自定义过程
Picture1.Picture = LoadPicture(App.Path & "\图片\1盘.jpg")
Picture2.Picture = LoadPicture(App.Path & "\图片\2盘.jpg")
Picture3.Picture = LoadPicture(App.Path & "\图片\3盘.jpg")
Picture4.Picture = LoadPicture(App.Path & "\图片\123.jpg")
Picture5.Picture = LoadPicture(App.Path & "\图片\124.jpg")
Picture6.Picture = LoadPicture(App.Path & "\图片\125.jpg")
End Sub
Private Sub quit_Click()
Unload Me
End Sub