celisej567/HL2Overcharged
1
0
Fork 0
mirror of https://github.com/Gigaslav/HL2Overcharged.git synced 2026-01-04 02:10:18 +03:00
Code Issues Packages Projects Releases Wiki Activity

Init comit

Browse Source
This commit is contained in:
Gigaslav
2025-05-21 21:20:08 +03:00
parent c59edfa1ce
commit 9a283535e7
5961 changed files with 2343666 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
utils/sapi51/Samples/VB/AudioApp/AudioApp.bas Normal file
View File

@@ -0,0 +1,4 @@
Attribute VB_Name = "AudioApp"
Public Declare Function Sleep Lib "kernel32" _
(ByVal dwMilliseconds As Long) As Long

238
utils/sapi51/Samples/VB/AudioApp/AudioAppFrm.frm Normal file
View File

@@ -0,0 +1,238 @@
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form AudioAppFrm
BorderStyle = 3 'Fixed Dialog
Caption = "AudioApp"
ClientHeight = 5310
ClientLeft = 45
ClientTop = 330
ClientWidth = 3705
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 5310
ScaleWidth = 3705
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin MSComctlLib.StatusBar AudioStatusBar
Align = 2 'Align Bottom
Height = 255
Left = 0
TabIndex = 4
Top = 5055
Width = 3705
_ExtentX = 6535
_ExtentY = 450
Style = 1
_Version = 393216
BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
NumPanels = 1
BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
EndProperty
EndProperty
End
Begin VB.TextBox SpeakTxt
Height = 1095
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "AudioAppFrm.frx":0000
Top = 720
Width = 3015
End
Begin VB.CommandButton SpeakBtn
Caption = "Reco From TTS"
Default = -1 'True
Height = 375
Left = 240
TabIndex = 2
Top = 4080
Width = 1335
End
Begin VB.CommandButton ExitBtn
Caption = "Exit"
Height = 375
Left = 2040
TabIndex = 1
Top = 4080
Width = 1215
End
Begin VB.TextBox Recotxt
Height = 1095
Left = 240
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2640
Width = 3015
End
Begin VB.Label Label2
Caption = "Recognition Results:"
Height = 255
Left = 240
TabIndex = 6
Top = 2280
Width = 1935
End
Begin VB.Label Label1
Caption = "Enter text to recognize:"
Height = 255
Left = 240
TabIndex = 5
Top = 360
Width = 1815
End
End
Attribute VB_Name = "AudioAppFrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================================================================
'
' AudioAppFrm
'
' Copyright @ 2001 Microsoft Corporation All Rights Reserved.
'=============================================================================
Option Explicit
Const AUDIOFORMAT = SAFT8kHz16BitMono
'tts variables
Dim WithEvents Voice As SpVoice
Attribute Voice.VB_VarHelpID = -1
Dim EndofStream As Boolean
Dim AudioPlugOut As SpAudioPlug
'sr variables
Dim WithEvents RecoContext As SpInProcRecoContext
Attribute RecoContext.VB_VarHelpID = -1
Dim Grammar As ISpeechRecoGrammar
Dim Recognizer As SpInprocRecognizer
Dim AudioPlugIn As SpAudioPlug
Private Sub ExitBtn_Click()
Grammar.DictationSetState SGDSInactive
Unload AudioAppFrm
End Sub
Private Sub Form_Load()
Set Voice = New SpVoice
EndofStream = False
'Set up the output audio object
Set AudioPlugOut = New SpAudioPlug
AudioPlugOut.Init True, AUDIOFORMAT
Set Voice.AudioOutputStream = AudioPlugOut
Debug.Print "Initializing SAPI reco context object..."
Set Recognizer = New SpInprocRecognizer
'Set up the input audio object
Set AudioPlugIn = New SpAudioPlug
AudioPlugIn.Init False, AUDIOFORMAT
Set Recognizer.AudioInputStream = AudioPlugIn
Set RecoContext = Recognizer.CreateRecoContext
Set Grammar = RecoContext.CreateGrammar(1)
Grammar.DictationLoad
End Sub
Public Sub PlayPlug()
On Error GoTo Cancel
Dim output As Variant
Recotxt.Text = ""
Voice.Speak SpeakTxt.Text, SVSFlagsAsync
EndofStream = False
'Update the status bar, before we start the feed the audio
AudioStatusBar.SimpleText = "Feeding TTS audio to SR..."
AudioStatusBar.Refresh
Grammar.DictationSetState SGDSActive
Do While (EndofStream = False)
'We need to process the message in the message queue
DoEvents
'Get the audio data from the audio object
output = AudioPlugOut.GetData
'Output the audio data to the input audio object
If (Len(output) * 2 <> 0) Then
AudioPlugIn.SetData (output)
End If
Sleep (500)
Loop
'Update the status bar after the we have feed all the audio data
AudioStatusBar.SimpleText = "SR Engine is doing dictation recognition..."
AudioStatusBar.Refresh
Cancel:
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set AudioPlugIn = Nothing
End Sub
Private Sub RecoContext_EndStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal StreamReleased As Boolean)
'Update the status bar
AudioStatusBar.SimpleText = "Recognition done"
AudioStatusBar.Refresh
'User can start another recognition
SpeakBtn.Enabled = True
SpeakTxt.SetFocus
Grammar.DictationSetState SGDSInactive
End Sub
Private Sub RecoContext_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
Recotxt.Text = Result.PhraseInfo.GetText & Recotxt.Text
End Sub
Private Sub SpeakBtn_Click()
PlayPlug
End Sub
Private Sub Voice_EndStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
EndofStream = True
End Sub
Private Sub Voice_StartStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
SpeakBtn.Enabled = False
End Sub

1
utils/sapi51/Samples/VB/AudioApp/AudioAppFrm.frx Normal file
View File

@@ -0,0 +1 @@
Please enter the text here.

37
utils/sapi51/Samples/VB/AudioApp/audioapp.vbp Normal file
View File

@@ -0,0 +1,37 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#..\..\..\..\..\sdn_60\sapi\sapi\objd\i386\sapi.dll#Microsoft Speech Object Library
Reference=*\G{17709AA0-2512-4FFE-BB24-1F6C535DEBCA}#1.0#0#..\..\cpp\simpleaudio\objd\i386\simpleaudio.dll#simpleaudio 1.0 Type Library
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
Form=AudioAppFrm.frm
Module=AudioApp; AudioApp.bas
Startup="AudioAppFrm"
ExeName32="audioapp.exe"
Command32=""
Name="Project1"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="MS"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

BIN
utils/sapi51/Samples/VB/ListboxVB/ListBoxSampleApp.frx Normal file
View File

Binary file not shown.

3
utils/sapi51/Samples/VB/ListboxVB/ListboxSample.vbg Normal file
View File

@@ -0,0 +1,3 @@
VBGROUP 5.0
Project=SAPI51ListBox.vbp
StartupProject=SAPI51SampleApp.vbp

131
utils/sapi51/Samples/VB/ListboxVB/ListboxSampleApp.frm Normal file
View File

@@ -0,0 +1,131 @@
VERSION 5.00
Object = "*\ASAPI51ListBox.vbp"
Begin VB.Form MainForm
BorderStyle = 1 'Fixed Single
Caption = "Speech Enabled ListBox"
ClientHeight = 4215
ClientLeft = 45
ClientTop = 330
ClientWidth = 4935
Icon = "ListBoxSampleApp.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4215
ScaleWidth = 4935
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdRemove
Caption = "&Remove"
Height = 355
Left = 3700
TabIndex = 3
Top = 3200
Width = 1100
End
Begin VB.CheckBox chkSpeechEnabled
Caption = "Speech &enabled"
Height = 255
Left = 120
TabIndex = 2
Top = 3250
Width = 1695
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Height = 355
Left = 3700
TabIndex = 6
Top = 3720
Width = 1100
End
Begin VB.TextBox txtNewItem
Height = 315
Left = 1320
TabIndex = 5
Text = "Seattle"
Top = 3740
Width = 2175
End
Begin SAPI51ListBox.Sample SpeechListBox
Height = 2205
Left = 120
TabIndex = 1
Top = 840
Width = 4680
_ExtentX = 8255
_ExtentY = 3889
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.Label Label2
Caption = $"ListBoxSampleApp.frx":014A
Height = 615
Left = 120
TabIndex = 0
Top = 120
Width = 4680
End
Begin VB.Label Label1
Caption = "&Phrase to add:"
Height = 255
Left = 120
TabIndex = 4
Top = 3770
Width = 1040
End
End
Attribute VB_Name = "MainForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================================================================
'
' This form is simple test application for the user control defined in sample.vbp.
'
' Copyright @ 2001 Microsoft Corporation All Rights Reserved.
'=============================================================================
Private Sub Form_Load()
If SpeechListBox.SpeechEnabled Then
chkSpeechEnabled = 1
Else
chkSpeechEnabled = 0
End If
End Sub
Private Sub chkSpeechEnabled_Click()
SpeechListBox.SpeechEnabled = (chkSpeechEnabled = 1)
End Sub
Private Sub cmdAdd_Click()
' Add the new item. Internally to SpeechListBox, this will cause a rebuild
' of the dynamic grammar used by speech recognition engine.
SpeechListBox.AddItem (txtNewItem)
txtNewItem = ""
End Sub
Private Sub cmdRemove_Click()
' Just remove the current selected item. Same as AddItem, removing an item
' causes a grammar rebuild as well.
If SpeechListBox.ListIndex <> -1 Then
SpeechListBox.RemoveItem SpeechListBox.ListIndex
End If
End Sub
Private Sub txtNewItem_Change()
' Disallow empty item.
cmdAdd.Enabled = txtNewItem <> ""
End Sub
Private Sub txtNewItem_GotFocus()
' When user focuses on the new item box, make the Add button default
' so that return key is same as clicking on Add button.
cmdAdd.Default = True
End Sub

44
utils/sapi51/Samples/VB/ListboxVB/SAPI51Listbox.vbp Normal file
View File

@@ -0,0 +1,44 @@
Type=Control
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{7C0FFAB0-CD84-11D0-949A-00A0C91110ED}#1.0#0#C:\winnt\System32\msdatsrc.tlb#Microsoft Data Source Interfaces
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#C:\Program Files\Common Files\Microsoft Shared\Speech\sapi.dll#Microsoft Speech Object Library
UserControl=Sample.ctl
Startup="(None)"
HelpFile=""
Title="SAPI51ListBox"
ExeName32="SAPI51ListBox.ocx"
Command32=""
Name="SAPI51ListBox"
HelpContextID="0"
Description="Speech enabled ListBox ActiveX control"
CompatibleMode="1"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
VersionFileDescription="SAPI51 VB ListBox sample control"
VersionLegalCopyright="Copyright (C) Microsoft Corporation. 1981-2001"
VersionProductName="Microsoft<66> Windows(TM) Operating System"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=1
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
ThreadingModel=1
DebugStartupOption=1
DebugStartupComponent=Sample
[MS Transaction Server]
AutoRefresh=1

42
utils/sapi51/Samples/VB/ListboxVB/SAPI51SampleApp.vbp Normal file
View File

@@ -0,0 +1,42 @@
Type=Exe
Form=ListBoxSampleApp.frm
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Object=*\ASAPI51ListBox.vbp
IconForm="MainForm"
Startup="MainForm"
HelpFile=""
Title="SAPI51SampleApp"
ExeName32="SAPI51SampleApp.exe"
Command32=""
Name="SAPI51SampleApp"
HelpContextID="0"
Description="SAPI51 sample application for the speech enabled VB ListBox sample control"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
VersionFileDescription="SAPI51 VB ListBox sample application"
VersionLegalCopyright="Copyright (C) Microsoft Corporation. 1981-2001"
VersionProductName="Microsoft<66> Windows(TM) Operating System"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1

867
utils/sapi51/Samples/VB/ListboxVB/Sample.ctl Normal file
View File

@@ -0,0 +1,867 @@
VERSION 5.00
Begin VB.UserControl Sample
ClientHeight = 690
ClientLeft = 0
ClientTop = 0
ClientWidth = 1815
ScaleHeight = 690
ScaleWidth = 1815
Begin VB.ListBox InnerList
Height = 450
Left = 0
TabIndex = 0
Top = 0
Width = 1575
End
End
Attribute VB_Name = "Sample"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit
' See UserControl_Resize() for how iLevelInResize is used.
' It's needed to make sure our control resizes correctly.
Dim iLevelInResize As Integer
' declare all speech related variables
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 ListItemsRule As ISpeechGrammarRule
'Event Declarations:
Event ItemCheck(Item As Integer) 'MappingInfo=InnerList,InnerList,-1,ItemCheck
Attribute ItemCheck.VB_Description = "Occurs when a ListBox control's Style property is set to 1 (checkboxes) and an item's checkbox in the ListBox control is selected or cleared."
Event OLEStartDrag(Data As DataObject, AllowedEffects As Long) 'MappingInfo=InnerList,InnerList,-1,OLEStartDrag
Attribute OLEStartDrag.VB_Description = "Occurs when an OLE drag/drop operation is initiated either manually or automatically."
Event OLESetData(Data As DataObject, DataFormat As Integer) 'MappingInfo=InnerList,InnerList,-1,OLESetData
Attribute OLESetData.VB_Description = "Occurs at the OLE drag/drop source control when the drop target requests data that was not provided to the DataObject during the OLEDragStart event."
Event OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean) 'MappingInfo=InnerList,InnerList,-1,OLEGiveFeedback
Attribute OLEGiveFeedback.VB_Description = "Occurs at the source control of an OLE drag/drop operation when the mouse cursor needs to be changed."
Event OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer) 'MappingInfo=InnerList,InnerList,-1,OLEDragOver
Attribute OLEDragOver.VB_Description = "Occurs when the mouse is moved over the control during an OLE drag/drop operation, if its OLEDropMode property is set to manual."
Event OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=InnerList,InnerList,-1,OLEDragDrop
Attribute OLEDragDrop.VB_Description = "Occurs when data is dropped onto the control via an OLE drag/drop operation, and OLEDropMode is set to manual."
Event OLECompleteDrag(Effect As Long) 'MappingInfo=InnerList,InnerList,-1,OLECompleteDrag
Attribute OLECompleteDrag.VB_Description = "Occurs at the OLE drag/drop source control after a manual or automatic drag/drop has been completed or canceled."
Event Scroll() 'MappingInfo=InnerList,InnerList,-1,Scroll
Attribute Scroll.VB_Description = "Occurs when you reposition the scroll box on a control."
Event Validate(Cancel As Boolean) 'MappingInfo=InnerList,InnerList,-1,Validate
Attribute Validate.VB_Description = "Occurs when a control loses focus to a control that causes validation."
'Default Property Values:
Const m_def_PreCommandString = "Select"
Const m_def_SpeechEnabled = True
'Property Variables:
Dim m_PreCommandString As String
Dim m_SpeechEnabled As Boolean
Private Sub InitializeSpeech()
' This function will create the main SpSharedRecoContext object and other
' required objects like Grammar and rules. In this sample, we are building
' grammar dynamically since listbox content can change from time to time.
' If your grammar is static, you can write your grammar file and ask SAPI
' to load it during run time. This can reduce the complexity of your code.
On Error GoTo ErrorHandler
If Not bSpeechInitialized Then
Debug.Print "Initializing speech"
Dim AfterCmdState As ISpeechGrammarRuleState
Set RecoContext = New SpSharedRecoContext
Set Grammar = RecoContext.CreateGrammar(m_GrammarId)
' Add two rules. The top level rule will reference the items rule.
Set TopRule = Grammar.Rules.Add("TopLevelRule", SRATopLevel Or SRADynamic, 1)
Set ListItemsRule = Grammar.Rules.Add("ListItemsRule", SRADynamic, 2)
Set AfterCmdState = TopRule.AddState
' The top level rule consists of two parts: "select <items>". So we first
' add a word transition for the "select" part, then a rule transition
' for the "<items>" part, which is dynamically built as items are added
' or removed from the listbox.
TopRule.InitialState.AddWordTransition AfterCmdState, _
m_PreCommandString, " ", , "", 0, 0
AfterCmdState.AddRuleTransition Nothing, ListItemsRule, "", 1, 1
' Now add existing list items to the ListItemsRule
RebuildGrammar
' Now we can activate the top level rule. In this sample, only the top
' level rule needs to activated. The ListItemsRule is referenced by
' the top level rule.
Grammar.CmdSetRuleState "TopLevelRule", SGDSActive
bSpeechInitialized = True
End If
Exit Sub
ErrorHandler:
MsgBox "SAPI failed to initialize. This application may not run correctly."
End Sub
Friend Sub EnableSpeech()
Debug.Print "Enabling speech"
If Not bSpeechInitialized Then Call InitializeSpeech
' once all objects are initialized, we need to update grammar
RebuildGrammar
RecoContext.State = SRCS_Enabled
End Sub
Friend Sub DisableSpeech()
Debug.Print "Disabling speech"
' Putting the recognition context to disabled state will stop speech
' recognition. Changing the state to enabled will start recognition again.
If bSpeechInitialized Then RecoContext.State = SRCS_Disabled
End Sub
Private Sub RebuildGrammar()
' In this funtion, we are only rebuilding the ListItemRule, as this is the
' only part that's really changing dynamically in this sample. However,
' you still have to call Grammar.Rules.Commit to commit the grammar.
On Error GoTo ErrorHandler
' First, clear the rule
ListItemsRule.Clear
' Now, add all items to the rule
Dim i As Integer
For i = 0 To InnerList.ListCount - 1
Dim text As String
text = InnerList.List(i)
' Note: if the same word is added more than once to the same rule state,
' SAPI will return error. In this sample, we don't allow identical items
' in the list box so no need for the checking, otherwise special checking
' for identical words would have to be done here.
ListItemsRule.InitialState.AddWordTransition Nothing, text, " ", , text, i, i
Next
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 _
)
' This event is fired when the recognizer thinks there's possible
' recognitions.
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 _
)
' This event is fired when something in the grammar is recognized.
Debug.Print "Recognition: " & Result.PhraseInfo.GetText & ", " & _
StreamNumber & ", " & StreamPosition
Dim index As Integer
Dim oItem As ISpeechPhraseProperty
' oItem will be the property of the second part in the recognized phase.
' For example, if the top level rule matchs "select Seattle". Then the
' ListItemsRule matches "Seattle" part. The following code will get the
' property of the "Seattle" phrase, which is set when the word "Seattle"
' is added to the ListItemsRule in RebuildGrammar.
Set oItem = Result.PhraseInfo.Properties(1).Children(0)
index = oItem.Id
If Result.PhraseInfo.GrammarId = m_GrammarId Then
' Check to see if the item at the same position in the list still has the
' same text.
' This is to prevent the rare case that the user keeps talking while
' the list is being added or removed. By the time this event is fired
' and handled, the list box may have already changed.
If oItem.Name = InnerList.List(index) Then
InnerList.ListIndex = index
End If
End If
End Sub
Private Sub UserControl_Initialize()
iLevelInResize = 0
bSpeechInitialized = False
End Sub
Private Sub UserControl_Resize()
' When the user control is resized, the inner listbox has to be resized
' so that it takes up all the area.
' Since height of inner ListBox changes by the height of a line of text,
' we have to adjust the user control's size, which may cause reentrance to
' this Resize() function. iLevelInResize is used to prevent infinite loop.
iLevelInResize = iLevelInResize + 1
If iLevelInResize = 1 Then
InnerList.Move 0, 0, Width, Height
' The following lines will cause Resize events and thus re-entrance
' to this function. Since iLevelInResize will not be 1 during
' re-entrance, we prevented infinite loop.
Height = InnerList.Height
Width = InnerList.Width
End If
iLevelInResize = iLevelInResize - 1
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,AddItem
Public Sub AddItem(ByVal Item As String, Optional ByVal index As Variant)
Attribute AddItem.VB_Description = "Adds an item to a ListBox or ComboBox control or a row to a Grid control."
' Since we can't add the same word to the same transition in the grammar,
' we don't allow same string to be added multiple times.
' So do nothing if Item is already in the list. Some level of error
' message may be helpful. The sample chooses to silently ignore to keep
' code simple.
' The leading and trailing spaces are not needed, trim it before inserting.
' SAPI will return error in AddWordTransition if two phrases differ only
' in spaces. A program needs to handle this error if random phrase is
' added to a rule.
' Note: In this sample, we only trim leading and trailing spaces. Internal
' spaces will need to be handled as well.
Item = Trim(Item)
If Item = "" Then
Exit Sub
End If
If InnerList.ListCount > 0 Then
Dim i As Integer
For i = 0 To InnerList.ListCount - 1
If StrComp(Item, InnerList.List(i), vbTextCompare) = 0 Then
Exit Sub
End If
Next
End If
' if it doesn't exist yet, add it to the list
InnerList.AddItem Item, index
' if speech is enabled, we need to update the grammar with new changes
If m_SpeechEnabled Then RebuildGrammar
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Appearance
Public Property Get Appearance() As Integer
Attribute Appearance.VB_Description = "Returns/sets whether or not an object is painted at run time with 3-D effects."
Attribute Appearance.VB_ProcData.VB_Invoke_Property = ";Appearance"
Attribute Appearance.VB_UserMemId = -520
Appearance = InnerList.Appearance
End Property
Public Property Let Appearance(ByVal New_Appearance As Integer)
InnerList.Appearance() = New_Appearance
PropertyChanged "Appearance"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
Attribute BackColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
BackColor = InnerList.BackColor
End Property
Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
InnerList.BackColor() = New_BackColor
PropertyChanged "BackColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,CausesValidation
Public Property Get CausesValidation() As Boolean
Attribute CausesValidation.VB_Description = "Returns/sets whether validation occurs on the control which lost focus."
Attribute CausesValidation.VB_ProcData.VB_Invoke_Property = ";Behavior"
CausesValidation = InnerList.CausesValidation
End Property
Public Property Let CausesValidation(ByVal New_CausesValidation As Boolean)
InnerList.CausesValidation() = New_CausesValidation
PropertyChanged "CausesValidation"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Clear
Public Sub Clear()
Attribute Clear.VB_Description = "Clears the contents of a control or the system Clipboard."
InnerList.Clear
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Columns
Public Property Get Columns() As Integer
Attribute Columns.VB_Description = "Returns/sets a value that determines whether a ListBox scrolls vertically in a single column (value of 0) or horizontally in snaking columns (values greater than 0)."
Columns = InnerList.Columns
End Property
Public Property Let Columns(ByVal New_Columns As Integer)
InnerList.Columns() = New_Columns
PropertyChanged "Columns"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,DataMember
Public Property Get DataMember() As String
Attribute DataMember.VB_Description = "Returns/sets a value that describes the DataMember for a data connection."
Attribute DataMember.VB_ProcData.VB_Invoke_Property = ";Data"
DataMember = InnerList.DataMember
End Property
Public Property Let DataMember(ByVal New_DataMember As String)
InnerList.DataMember() = New_DataMember
PropertyChanged "DataMember"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,DataSource
Public Property Get DataSource() As DataSource
Attribute DataSource.VB_Description = "Sets a value that specifies the Data control through which the current control is bound to a database. "
Attribute DataSource.VB_ProcData.VB_Invoke_Property = ";Data"
Set DataSource = InnerList.DataSource
End Property
Public Property Set DataSource(ByVal New_DataSource As DataSource)
Set InnerList.DataSource = New_DataSource
PropertyChanged "DataSource"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Enabled
Public Property Get Enabled() As Boolean
Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
Attribute Enabled.VB_ProcData.VB_Invoke_Property = ";Behavior"
Enabled = InnerList.Enabled
End Property
Public Property Let Enabled(ByVal New_Enabled As Boolean)
InnerList.Enabled() = New_Enabled
PropertyChanged "Enabled"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontUnderline
Public Property Get FontUnderline() As Boolean
Attribute FontUnderline.VB_Description = "Returns/sets underline font styles."
Attribute FontUnderline.VB_MemberFlags = "400"
FontUnderline = InnerList.FontUnderline
End Property
Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
InnerList.FontUnderline() = New_FontUnderline
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontStrikethru
Public Property Get FontStrikethru() As Boolean
Attribute FontStrikethru.VB_Description = "Returns/sets strikethrough font styles."
Attribute FontStrikethru.VB_MemberFlags = "400"
FontStrikethru = InnerList.FontStrikethru
End Property
Public Property Let FontStrikethru(ByVal New_FontStrikethru As Boolean)
InnerList.FontStrikethru() = New_FontStrikethru
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontSize
Public Property Get FontSize() As Single
Attribute FontSize.VB_Description = "Specifies the size (in points) of the font that appears in each row for the given level."
Attribute FontSize.VB_MemberFlags = "400"
FontSize = InnerList.FontSize
End Property
Public Property Let FontSize(ByVal New_FontSize As Single)
InnerList.FontSize() = New_FontSize
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontName
Public Property Get FontName() As String
Attribute FontName.VB_Description = "Specifies the name of the font that appears in each row for the given level."
Attribute FontName.VB_MemberFlags = "400"
FontName = InnerList.FontName
End Property
Public Property Let FontName(ByVal New_FontName As String)
InnerList.FontName() = New_FontName
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontItalic
Public Property Get FontItalic() As Boolean
Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
Attribute FontItalic.VB_MemberFlags = "400"
FontItalic = InnerList.FontItalic
End Property
Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
InnerList.FontItalic() = New_FontItalic
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,FontBold
Public Property Get FontBold() As Boolean
Attribute FontBold.VB_Description = "Returns/sets bold font styles."
Attribute FontBold.VB_MemberFlags = "400"
FontBold = InnerList.FontBold
End Property
Public Property Let FontBold(ByVal New_FontBold As Boolean)
InnerList.FontBold() = New_FontBold
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_ProcData.VB_Invoke_Property = ";Font"
Attribute Font.VB_UserMemId = -512
Set Font = InnerList.Font
End Property
Public Property Set Font(ByVal New_Font As Font)
Set InnerList.Font = New_Font
PropertyChanged "Font"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
Attribute ForeColor.VB_ProcData.VB_Invoke_Property = ";Appearance"
ForeColor = InnerList.ForeColor
End Property
Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
InnerList.ForeColor() = New_ForeColor
PropertyChanged "ForeColor"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,hWnd
Public Property Get hWnd() As Long
Attribute hWnd.VB_Description = "Returns a handle (from Microsoft Windows) to an object's window."
hWnd = InnerList.hWnd
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,IntegralHeight
Public Property Get IntegralHeight() As Boolean
Attribute IntegralHeight.VB_Description = "Returns/Sets a value indicating whether the control displays partial items."
Attribute IntegralHeight.VB_ProcData.VB_Invoke_Property = ";List"
IntegralHeight = InnerList.IntegralHeight
End Property
Private Sub InnerList_ItemCheck(Item As Integer)
RaiseEvent ItemCheck(Item)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,ItemData
Public Property Get ItemData(ByVal index As Integer) As Long
Attribute ItemData.VB_Description = "Returns/sets a specific number for each item in a ComboBox or ListBox control."
Attribute ItemData.VB_ProcData.VB_Invoke_Property = ";List"
ItemData = InnerList.ItemData(index)
End Property
Public Property Let ItemData(ByVal index As Integer, ByVal New_ItemData As Long)
InnerList.ItemData(index) = New_ItemData
PropertyChanged "ItemData"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,ListIndex
Public Property Get ListIndex() As Integer
Attribute ListIndex.VB_Description = "Returns/sets the index of the currently selected item in the control."
Attribute ListIndex.VB_MemberFlags = "400"
ListIndex = InnerList.ListIndex
End Property
Public Property Let ListIndex(ByVal New_ListIndex As Integer)
InnerList.ListIndex() = New_ListIndex
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,ListCount
Public Property Get ListCount() As Integer
Attribute ListCount.VB_Description = "Returns the number of items in the list portion of a control."
ListCount = InnerList.ListCount
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,List
Public Property Get List(ByVal index As Integer) As String
Attribute List.VB_Description = "Returns/sets the items contained in a control's list portion."
Attribute List.VB_ProcData.VB_Invoke_Property = ";List"
Attribute List.VB_UserMemId = 0
List = InnerList.List(index)
End Property
Public Property Let List(ByVal index As Integer, ByVal New_List As String)
InnerList.List(index) = New_List
PropertyChanged "List"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,MousePointer
Public Property Get MousePointer() As Integer
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
MousePointer = InnerList.MousePointer
End Property
Public Property Let MousePointer(ByVal New_MousePointer As Integer)
InnerList.MousePointer() = New_MousePointer
PropertyChanged "MousePointer"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,MouseIcon
Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
Set MouseIcon = InnerList.MouseIcon
End Property
Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
Set InnerList.MouseIcon = New_MouseIcon
PropertyChanged "MouseIcon"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,MultiSelect
Public Property Get MultiSelect() As Integer
Attribute MultiSelect.VB_Description = "Returns/sets a value that determines whether a user can make multiple selections in a control."
MultiSelect = InnerList.MultiSelect
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,NewIndex
Public Property Get NewIndex() As Integer
Attribute NewIndex.VB_Description = "Returns the index of the item most recently added to a control."
NewIndex = InnerList.NewIndex
End Property
Private Sub InnerList_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
RaiseEvent OLEStartDrag(Data, AllowedEffects)
End Sub
Private Sub InnerList_OLESetData(Data As DataObject, DataFormat As Integer)
RaiseEvent OLESetData(Data, DataFormat)
End Sub
Private Sub InnerList_OLEGiveFeedback(Effect As Long, DefaultCursors As Boolean)
RaiseEvent OLEGiveFeedback(Effect, DefaultCursors)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,OLEDropMode
Public Property Get OLEDropMode() As Integer
Attribute OLEDropMode.VB_Description = "Returns/Sets whether this object can act as an OLE drop target."
Attribute OLEDropMode.VB_ProcData.VB_Invoke_Property = ";Behavior"
OLEDropMode = InnerList.OLEDropMode
End Property
Public Property Let OLEDropMode(ByVal New_OLEDropMode As Integer)
InnerList.OLEDropMode() = New_OLEDropMode
PropertyChanged "OLEDropMode"
End Property
Private Sub InnerList_OLEDragOver(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single, State As Integer)
RaiseEvent OLEDragOver(Data, Effect, Button, Shift, X, Y, State)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,OLEDragMode
Public Property Get OLEDragMode() As Integer
Attribute OLEDragMode.VB_Description = "Returns/Sets whether this object can act as an OLE drag/drop source, and whether this process is started automatically or under programmatic control."
Attribute OLEDragMode.VB_ProcData.VB_Invoke_Property = ";Behavior"
OLEDragMode = InnerList.OLEDragMode
End Property
Public Property Let OLEDragMode(ByVal New_OLEDragMode As Integer)
InnerList.OLEDragMode() = New_OLEDragMode
PropertyChanged "OLEDragMode"
End Property
Private Sub InnerList_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
RaiseEvent OLEDragDrop(Data, Effect, Button, Shift, X, Y)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,OLEDrag
Public Sub OLEDrag()
Attribute OLEDrag.VB_Description = "Starts an OLE drag/drop event with the given control as the source."
InnerList.OLEDrag
End Sub
Private Sub InnerList_OLECompleteDrag(Effect As Long)
RaiseEvent OLECompleteDrag(Effect)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,RemoveItem
Public Sub RemoveItem(ByVal index As Integer)
Attribute RemoveItem.VB_Description = "Removes an item from a ListBox or ComboBox control or a row from a Grid control."
InnerList.RemoveItem index
If m_SpeechEnabled Then RebuildGrammar
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
InnerList.Refresh
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,RightToLeft
Public Property Get RightToLeft() As Boolean
Attribute RightToLeft.VB_Description = "Determines text display direction and control visual appearance on a bidirectional system."
Attribute RightToLeft.VB_ProcData.VB_Invoke_Property = ";Behavior"
RightToLeft = InnerList.RightToLeft
End Property
Public Property Let RightToLeft(ByVal New_RightToLeft As Boolean)
InnerList.RightToLeft() = New_RightToLeft
PropertyChanged "RightToLeft"
End Property
Private Sub InnerList_Scroll()
RaiseEvent Scroll
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Selected
Public Property Get Selected(ByVal index As Integer) As Boolean
Attribute Selected.VB_Description = "Returns/sets the selection status of an item in a control."
Selected = InnerList.Selected(index)
End Property
Public Property Let Selected(ByVal index As Integer, ByVal New_Selected As Boolean)
InnerList.Selected(index) = New_Selected
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,SelCount
Public Property Get SelCount() As Integer
Attribute SelCount.VB_Description = "Returns the number of selected items in a ListBox control."
SelCount = InnerList.SelCount
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Style
Public Property Get Style() As Integer
Attribute Style.VB_Description = "Returns/sets a value that determines whether checkboxes are displayed inside a ListBox control."
Attribute Style.VB_ProcData.VB_Invoke_Property = ";Appearance"
Style = InnerList.Style
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Sorted
Public Property Get Sorted() As Boolean
Attribute Sorted.VB_Description = "Indicates whether the elements of a control are automatically sorted alphabetically."
Attribute Sorted.VB_ProcData.VB_Invoke_Property = ";Behavior"
Sorted = InnerList.Sorted
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,Text
Public Property Get text() As String
Attribute text.VB_Description = "Returns/sets the text contained in the control."
text = InnerList.text
End Property
Public Property Let text(ByVal New_Text As String)
InnerList.text() = New_Text
PropertyChanged "Text"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,ToolTipText
Public Property Get ToolTipText() As String
Attribute ToolTipText.VB_Description = "Returns/sets the text displayed when the mouse is paused over the control."
ToolTipText = InnerList.ToolTipText
End Property
Public Property Let ToolTipText(ByVal New_ToolTipText As String)
InnerList.ToolTipText() = New_ToolTipText
PropertyChanged "ToolTipText"
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,TopIndex
Public Property Get TopIndex() As Integer
Attribute TopIndex.VB_Description = "Returns/sets which item in a control is displayed in the topmost position."
TopIndex = InnerList.TopIndex
End Property
Public Property Let TopIndex(ByVal New_TopIndex As Integer)
InnerList.TopIndex() = New_TopIndex
PropertyChanged "TopIndex"
End Property
Private Sub InnerList_Validate(Cancel As Boolean)
RaiseEvent Validate(Cancel)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=InnerList,InnerList,-1,WhatsThisHelpID
Public Property Get WhatsThisHelpID() As Long
Attribute WhatsThisHelpID.VB_Description = "Returns/sets an associated context number for an object."
WhatsThisHelpID = InnerList.WhatsThisHelpID
End Property
Public Property Let WhatsThisHelpID(ByVal New_WhatsThisHelpID As Long)
InnerList.WhatsThisHelpID() = New_WhatsThisHelpID
PropertyChanged "WhatsThisHelpID"
End Property
'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
Dim index As Integer
Dim Count As Integer
InnerList.Appearance = PropBag.ReadProperty("Appearance", 1)
InnerList.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
InnerList.CausesValidation = PropBag.ReadProperty("CausesValidation", True)
If PropBag.ReadProperty("Columns", 0) <> 0 Then
InnerList.Columns = PropBag.ReadProperty("Columns", 0)
End If
InnerList.DataMember = PropBag.ReadProperty("DataMember", "")
Set DataSource = PropBag.ReadProperty("DataSource", Nothing)
InnerList.Enabled = PropBag.ReadProperty("Enabled", True)
Set InnerList.Font = PropBag.ReadProperty("Font", Ambient.Font)
InnerList.ForeColor = PropBag.ReadProperty("ForeColor", &H80000008)
Count = PropBag.ReadProperty("ListCount", 0)
For index = 0 To Count - 1
InnerList.ItemData(index) = PropBag.ReadProperty("ItemData" & index, 0)
InnerList.List(index) = PropBag.ReadProperty("List" & index, "")
Next
InnerList.MousePointer = PropBag.ReadProperty("MousePointer", 0)
Set MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
InnerList.OLEDropMode = PropBag.ReadProperty("OLEDropMode", 0)
InnerList.OLEDragMode = PropBag.ReadProperty("OLEDragMode", 0)
InnerList.RightToLeft = PropBag.ReadProperty("RightToLeft", False)
InnerList.text = PropBag.ReadProperty("Text", "")
InnerList.ToolTipText = PropBag.ReadProperty("ToolTipText", "")
InnerList.TopIndex = PropBag.ReadProperty("TopIndex", 0)
InnerList.WhatsThisHelpID = PropBag.ReadProperty("WhatsThisHelpID", 0)
m_PreCommandString = PropBag.ReadProperty("PreCommandString", m_def_PreCommandString)
Me.SpeechEnabled = PropBag.ReadProperty("SpeechEnabled", m_def_SpeechEnabled)
End Sub
'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
Dim index As Integer
Call PropBag.WriteProperty("Appearance", InnerList.Appearance, 1)
Call PropBag.WriteProperty("BackColor", InnerList.BackColor, &H80000005)
Call PropBag.WriteProperty("CausesValidation", InnerList.CausesValidation, True)
Call PropBag.WriteProperty("Columns", InnerList.Columns, 0)
Call PropBag.WriteProperty("DataMember", InnerList.DataMember, "")
Call PropBag.WriteProperty("DataSource", DataSource, Nothing)
Call PropBag.WriteProperty("Enabled", InnerList.Enabled, True)
Call PropBag.WriteProperty("Font", InnerList.Font, Ambient.Font)
Call PropBag.WriteProperty("ForeColor", InnerList.ForeColor, &H80000008)
Call PropBag.WriteProperty("ListCount", InnerList.ListCount, 0)
For index = 0 To InnerList.ListCount - 1
Call PropBag.WriteProperty("ItemData" & index, InnerList.ItemData(index), 0)
Call PropBag.WriteProperty("List" & index, InnerList.List(index), "")
Next
Call PropBag.WriteProperty("MousePointer", InnerList.MousePointer, 0)
Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
Call PropBag.WriteProperty("OLEDropMode", InnerList.OLEDropMode, 0)
Call PropBag.WriteProperty("OLEDragMode", InnerList.OLEDragMode, 0)
Call PropBag.WriteProperty("RightToLeft", InnerList.RightToLeft, False)
Call PropBag.WriteProperty("Text", InnerList.text, "")
Call PropBag.WriteProperty("ToolTipText", InnerList.ToolTipText, "")
Call PropBag.WriteProperty("TopIndex", InnerList.TopIndex, 0)
Call PropBag.WriteProperty("WhatsThisHelpID", InnerList.WhatsThisHelpID, 0)
Call PropBag.WriteProperty("SpeechEnabled", m_SpeechEnabled, m_def_SpeechEnabled)
Call PropBag.WriteProperty("PreCommandString", m_PreCommandString, m_def_PreCommandString)
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=0,0,0,True
Public Property Get SpeechEnabled() As Boolean
Attribute SpeechEnabled.VB_Description = "Whether speech recognition is enabled or not."
SpeechEnabled = m_SpeechEnabled
End Property
Public Property Let SpeechEnabled(ByVal New_SpeechEnabled As Boolean)
If m_SpeechEnabled <> New_SpeechEnabled Then
m_SpeechEnabled = New_SpeechEnabled
If Ambient.UserMode Then
If m_SpeechEnabled = True Then
Call EnableSpeech
Else
Call DisableSpeech
End If
End If
PropertyChanged "SpeechEnabled"
End If
End Property
'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_PreCommandString = m_def_PreCommandString
Me.SpeechEnabled = m_def_SpeechEnabled
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,1,0,Select
Public Property Get PreCommandString() As String
Attribute PreCommandString.VB_Description = "This property is used to determine what word or words a user needs to say to get the listbox to recognized individual list items."
PreCommandString = m_PreCommandString
End Property
Public Property Let PreCommandString(ByVal New_PreCommandString As String)
' This property is not available during run time to simplify sample code.
' To support it in run time, you will need to dynamically rebuild the top
' level rule when this property changes.
' If a run time attempt is made to change this property, error is raised.
If Ambient.UserMode Then Err.Raise 382
m_PreCommandString = New_PreCommandString
PropertyChanged "PreCommandString"
End Property

BIN
utils/sapi51/Samples/VB/ListboxVB/small.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 318 B

1162
utils/sapi51/Samples/VB/RecoVB/recovb.frm Normal file
View File

File diff suppressed because it is too large Load Diff

42
utils/sapi51/Samples/VB/RecoVB/recovb.vbp Normal file
View File

@@ -0,0 +1,42 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#s:\binaries.x86fre\sapi.dll#Microsoft Speech Object Library
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
Form=RecoVB.frm
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; mscomctl.ocx
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; mscomct2.ocx
Object={38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0; comct332.ocx
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="recovb"
ExeName32="RecoVB.exe"
Command32=""
Name="RecoVb"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1

126
utils/sapi51/Samples/VB/SimpleDict/SimpleDict.frm Normal file
View File

@@ -0,0 +1,126 @@
VERSION 5.00
Begin VB.Form SimpleDict
BorderStyle = 1 'Fixed Single
Caption = "Simple Dictation"
ClientHeight = 3780
ClientLeft = 45
ClientTop = 330
ClientWidth = 4680
Icon = "SimpleDict.frx":0000
LinkTopic = "SimpleDict"
MaxButton = 0 'False
ScaleHeight = 3780
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton btnStart
Caption = "St&art"
Height = 375
Left = 840
TabIndex = 1
Top = 3240
Width = 1215
End
Begin VB.CommandButton btnStop
Caption = "St&op"
Height = 375
Left = 2520
TabIndex = 2
Top = 3240
Width = 1215
End
Begin VB.TextBox txtSpeech
Height = 2895
Left = 120
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Top = 120
Width = 4455
End
End
Attribute VB_Name = "SimpleDict"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================================================================
' This sample demonstrates how to do simple dictation in VB with SAPI 5.1.
'
' It uses shared reco context object, uses the default audio input, loads in
' dictation grammar, sets up event handlers, and shows the recognized text in
' the dialog text box.
'
' Note: since the text box is using system locale, it may not correctly show
' characters in other languages. For example, if you use Chinese Speech
' Recognition engine as the default engine on your English OS, the text box
' may show garbage even though the engine recognizes Chinese.
'
' Copyright @ 2001 Microsoft Corporation All Rights Reserved.
'
'=============================================================================
Option Explicit
Dim WithEvents RecoContext As SpSharedRecoContext
Attribute RecoContext.VB_VarHelpID = -1
Dim Grammar As ISpeechRecoGrammar
Dim m_bRecoRunning As Boolean
Dim m_cChars As Integer
Private Sub Form_Load()
SetState False
m_cChars = 0
End Sub
Private Sub btnStart_Click()
Debug.Assert Not m_bRecoRunning
' Initialize recognition context object and grammar object, then
' start dictation
If (RecoContext Is Nothing) Then
Debug.Print "Initializing SAPI reco context object..."
Set RecoContext = New SpSharedRecoContext
Set Grammar = RecoContext.CreateGrammar(1)
Grammar.DictationLoad
End If
Grammar.DictationSetState SGDSActive
SetState True
End Sub
Private Sub btnStop_Click()
Debug.Assert m_bRecoRunning
Grammar.DictationSetState SGDSInactive
SetState False
End Sub
' This function handles Recognition event from the reco context object.
' Recognition event is fired when the speech recognition engines recognizes
' a sequences of words.
Private Sub RecoContext_Recognition(ByVal StreamNumber As Long, _
ByVal StreamPosition As Variant, _
ByVal RecognitionType As SpeechRecognitionType, _
ByVal Result As ISpeechRecoResult _
)
Dim strText As String
strText = Result.PhraseInfo.GetText
Debug.Print "Recognition: " & strText & ", " & _
StreamNumber & ", " & StreamPosition
' Append the new text to the text box, and add a space at the end of the
' text so that it looks better
txtSpeech.SelStart = m_cChars
txtSpeech.SelText = strText & " "
m_cChars = m_cChars + 1 + Len(strText)
End Sub
' This function handles the state of Start and Stop buttons according to
' whether dictation is running.
Private Sub SetState(ByVal bNewState As Boolean)
m_bRecoRunning = bNewState
btnStart.Enabled = Not m_bRecoRunning
btnStop.Enabled = m_bRecoRunning
End Sub

BIN
utils/sapi51/Samples/VB/SimpleDict/SimpleDict.frx Normal file
View File

Binary file not shown.

42
utils/sapi51/Samples/VB/SimpleDict/SimpleDictVB.vbp Normal file
View File

@@ -0,0 +1,42 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#C:\Program Files\Common Files\Microsoft Shared\Speech\sapi.dll#Microsoft Speech Object Library
Form=SimpleDict.frm
IconForm="SimpleDict"
Startup="SimpleDict"
HelpFile=""
Title="SimpleDictVB"
ExeName32="SimpleDictVB.exe"
Command32=""
Name="SimpleDictVB"
HelpContextID="0"
Description="SAPI SDK VB SimpleDict sample"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
VersionFileDescription="SimpleDictVB sample"
VersionLegalCopyright="Copyright (C) Microsoft Corporation. 1981-2001"
VersionProductName="Microsoft<66> Windows(TM) Operating System"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1

BIN
utils/sapi51/Samples/VB/SimpleDict/small.ico Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 318 B

155
utils/sapi51/Samples/VB/SimpleTTS/SimpleTTS.frm Normal file
View File

@@ -0,0 +1,155 @@
VERSION 5.00
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "Simple TTS"
ClientHeight = 1800
ClientLeft = 45
ClientTop = 330
ClientWidth = 4125
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 120
ScaleMode = 3 'Pixel
ScaleWidth = 275
StartUpPosition = 3 'Windows Default
Begin MSComDlg.CommonDialog ComDlg
Left = 1800
Top = 600
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton SpeakItBtn
Caption = "Speak It"
Default = -1 'True
Height = 375
Left = 1560
TabIndex = 3
Top = 1200
Width = 1095
End
Begin VB.CheckBox SaveToWavCheckBox
Caption = "Save to .wav"
Height = 255
Left = 120
TabIndex = 2
ToolTipText = "The text is a file name"
Top = 1260
Width = 1335
End
Begin VB.CommandButton ExitBtn
Caption = "Exit"
Height = 375
Left = 2880
TabIndex = 1
Top = 1200
Width = 1095
End
Begin VB.TextBox TextField
Height = 765
Left = 0
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "SimpleTTS.frx":0000
Top = 120
Width = 4095
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================================================================
'
' This SimpleTTS sample application demonstrates how to create a SpVoice object
' and how to use it to speak text and save it to a .wav file.
'
' Copyright @ 2001 Microsoft Corporation All Rights Reserved.
'=============================================================================
Option Explicit
'Declare the SpVoice object.
Dim Voice As SpVoice
'Note - Applications that require handling of SAPI events should declair the
'SpVoice as follows:
'Dim WithEvents Voice As SpVoice
Private Sub Form_Load()
' Initialize the voice object
Set Voice = New SpVoice
End Sub
Private Sub ExitBtn_Click()
Unload Form1
End Sub
Private Sub SpeakItBtn_Click()
On Error GoTo Speak_Error
' If the 'Save to wav' checkbox is checked handle this special case by
' calling the SaveToWav() function.
If SaveToWavCheckBox Then
SaveToWav
Else
' Call the Speak method with the text from the text box. We use the
' SVSFlagsAsync flag to speak asynchronously and return immediately
' from this call.
If Not TextField.Text = "" Then
Voice.Speak TextField.Text, SVSFlagsAsync
End If
End If
' Return focus to text box
TextField.SetFocus
Exit Sub
Speak_Error:
MsgBox "Speak Error!", vbOKOnly
End Sub
Private Sub SaveToWav()
' Create a wave stream
Dim cpFileStream As New SpFileStream
' Set audio format
cpFileStream.Format.Type = SAFT22kHz16BitMono
' Call the Common File Dialog control which is inserted into the form to
' select a name for the .wav file.
ComDlg.CancelError = True
On Error GoTo Cancel
ComDlg.Flags = cdlOFNOverwritePrompt + cdlOFNPathMustExist + cdlOFNNoReadOnlyReturn
ComDlg.DialogTitle = "Save to a Wave File"
ComDlg.Filter = "All Files (*.*)|*.*|Wave Files " & "(*.wav)|*.wav"
ComDlg.FilterIndex = 2
ComDlg.ShowSave
' Create a new .wav file for writing. False indicates that we're not
' interested in writing events into the .wav file.
' Note - this line of code will fail if the file exists and is currently open.
cpFileStream.Open ComDlg.FileName, SSFMCreateForWrite, False
' Set the .wav file stream as the output for the Voice object
Set Voice.AudioOutputStream = cpFileStream
' Calling the Speak method now will send the output to the "SimpTTS.wav" file.
' We use the SVSFDefault flag so this call does not return until the file is
' completely written.
Voice.Speak TextField.Text, SVSFDefault
' Close the file
cpFileStream.Close
Set cpFileStream = Nothing
' Reset the Voice object's output to 'Nothing'. This will force it to use
' the default audio output the next time.
Set Voice.AudioOutputStream = Nothing
Cancel:
Exit Sub
End Sub

1
utils/sapi51/Samples/VB/SimpleTTS/SimpleTTS.frx Normal file
View File

@@ -0,0 +1 @@
Speak this text.

38
utils/sapi51/Samples/VB/SimpleTTS/SimpleTTS.vbp Normal file
View File

@@ -0,0 +1,38 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#..\..\..\..\sapi\sapi\objd\i386\sapi.dll#Microsoft Speech Object Library
Form=SimpleTTS.frm
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
IconForm="Form1"
Startup="Form1"
HelpFile=""
Title="SimpleTTS"
ExeName32="SimpleTTS.exe"
Command32=""
Name="SimpleTTS"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="SPG"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

1162
utils/sapi51/Samples/VB/TTSAppVB/TTSAppMain.frm Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
utils/sapi51/Samples/VB/TTSAppVB/TTSAppMain.frx Normal file
View File

Binary file not shown.

8
utils/sapi51/Samples/VB/TTSAppVB/TTSAppMod.bas Normal file
View File

@@ -0,0 +1,8 @@
Attribute VB_Name = "TTSAppMod"
Option Explicit
Declare Function GetSysColor Lib "user32" (ByVal index As Long) As Long
Public Const COLOR_BTNFACE = 15
Public Const COLOR_3DFACE = COLOR_BTNFACE

BIN
utils/sapi51/Samples/VB/TTSAppVB/ttsapp.RES Normal file
View File

Binary file not shown.

47
utils/sapi51/Samples/VB/TTSAppVB/ttsapp.vbp Normal file
View File

@@ -0,0 +1,47 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#C:\Program Files\Common Files\Microsoft Shared\Speech\sapi.dll#Microsoft Speech Object Library
Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; COMDLG32.OCX
Object={86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCT2.OCX
Form=TTSAppMain.frm
Module=TTSAppMod; TTSAppMod.bas
ResFile32="ttsapp.RES"
IconForm="TTSAppMain"
Startup="TTSAppMain"
HelpFile=""
Title="TTSAppVB"
ExeName32="TTSAppVB.exe"
Command32=""
Name="TTSApp"
HelpContextID="0"
Description="SAPI SDK VB TTS App sample"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corporation"
VersionFileDescription="TTSAppVB"
VersionLegalCopyright="Copyright (C) Microsoft Corporation. 1981-2001"
VersionProductName="Microsoft<66> Windows(TM) Operating System"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1

BIN
utils/sapi51/Samples/VB/VBTAPISamples/OutgoingCall/VBOutGoingCall.RES Normal file
View File

Binary file not shown.

37
utils/sapi51/Samples/VB/VBTAPISamples/OutgoingCall/VBOutGoingCall.vbp Normal file
View File

@@ -0,0 +1,37 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{21D6D480-A88B-11D0-83DD-00AA003CCABD}#1.0#0#..\..\..\..\..\..\..\..\WINNT\System32\tapi3.dll#Microsoft TAPI 3.0 Type Library
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#..\..\..\..\..\sapi\sapi\objd\i386\sapi.dll#Microsoft Speech Object Library
Reference=*\G{EDAEECD8-0D75-499E-9B69-187ACACF2C05}#1.0#0#..\..\..\cpp\tapicustomstream\objd\i386\STCustomStream.dll#STCustomStream 1.0 Type Library
Form=VBOutgoingcall.frm
ResFile32="VBOutGoingCall.RES"
Startup="Form1"
ExeName32="VBOutGoingCall.exe"
Command32=""
Name="VBOutGoingCall"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corp."
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
[MS Transaction Server]
AutoRefresh=1

469
utils/sapi51/Samples/VB/VBTAPISamples/OutgoingCall/VBOutgoingcall.frm Normal file
View File

@@ -0,0 +1,469 @@
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "VB Outgoing Call"
ClientHeight = 3555
ClientLeft = 150
ClientTop = 720
ClientWidth = 6105
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3555
ScaleWidth = 6105
StartUpPosition = 3 'Windows Default
Begin VB.TextBox Text1
Height = 1815
Left = 240
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "VBOutgoingcall.frx":0000
Top = 840
Width = 4455
End
Begin VB.ComboBox DestAddressCombo
Height = 315
Left = 1320
TabIndex = 0
Top = 240
Width = 3375
End
Begin VB.CommandButton DisconnectBtn
Caption = "Disconnect"
Height = 450
Left = 4920
TabIndex = 4
Top = 1320
Width = 1000
End
Begin VB.CommandButton CallBtn
Caption = "Dial"
Height = 450
Left = 4920
TabIndex = 2
Top = 240
Width = 1000
End
Begin VB.Label Label1
Caption = "Internet Call"
Height = 255
Left = 240
TabIndex = 6
Top = 240
Width = 975
End
Begin VB.Label TitleLbl
Caption = "Call Status:"
Height = 255
Left = 120
TabIndex = 5
Top = 3000
Width = 855
End
Begin VB.Label StatusLbl
Height = 375
Left = 1080
TabIndex = 3
Top = 3000
Width = 3495
End
Begin VB.Menu menuFile
Caption = "File"
Begin VB.Menu menuFileExit
Caption = "Exit"
End
End
Begin VB.Menu menuHelp
Caption = "Help"
Begin VB.Menu menuAbout
Caption = "About"
End
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'=============================================================================
'
' This VB Speech Telephony App sample demonstrates how to use SAPI TTS
' functionalities to speech enable the TAPI apps. The main objects used
' here are SAPI SpVoice, TAPI object, and custom real time audio object
' STCUSTOMSTREAMLib.TTSStream
'
'=============================================================================
Option Explicit
Dim WithEvents gObjTapiWithEvents As TAPI
Attribute gObjTapiWithEvents.VB_VarHelpID = -1
Dim WithEvents gObjVoice As SpVoice
Attribute gObjVoice.VB_VarHelpID = -1
Dim gObjTapi As TAPI
Dim gobjAddress As ITAddress
Dim objCallControl As ITBasicCallControl
Dim AddressTypeSelected As Long
Dim MemStream As SpMemoryStream
Dim bConnectionStatus As Boolean
Const VFW_E_NOT_COMMITTED = &H80040211 'DirectShow Error :Cannot allocate a sample when the allocator is not active
Const TAPI3_ALL_TAPI_EVENTS = _
TE_ACDGROUP Or _
TE_ADDRESS Or _
TE_AGENT Or _
TE_AGENTHANDLER Or _
TE_AGENTSESSION Or _
TE_CALLHUB Or _
TE_CALLINFOCHANGE Or _
TE_CALLMEDIA Or _
TE_CALLNOTIFICATION Or _
TE_CALLSTATE Or _
TE_DIGITEVENT Or _
TE_GENERATEEVENT Or _
TE_PRIVATE Or _
TE_QOSEVENT Or _
TE_QUEUE Or _
TE_REQUEST Or _
TE_TAPIOBJECT
Private Sub menuAbout_Click()
MsgBox "VB Outgoing Call App" & vbCrLf & vbCrLf & "Copyright (c) 2001 Microsoft Corporation. All rights reserved.", _
vbOKOnly Or vbInformation, "VB Outgoing Call"
End Sub
Private Sub menuFileExit_Click()
Unload Me
End Sub
Private Sub CallBtn_Click()
StatusLbl.Caption = _
"Dial ..."
StatusLbl.Refresh
DisconnectBtn.Enabled = True
Call MakeTheCall
End Sub
Private Sub DisconnectBtn_Click()
Dim strMsg As String
If objCallControl Is Nothing Then
strMsg = "Already disconnected."
StatusLbl.Caption = strMsg
StatusLbl.Refresh
Else
objCallControl.Disconnect (DC_NORMAL)
'Since the call has been disconnected, disable the Disconnect button
DisconnectBtn.Enabled = False
End If
End Sub
Private Sub Form_Load()
Dim strMsg As String
Dim objcollAddress As ITCollection
Dim nAddressIndex As Long
'Initialize Sapi
Set gObjVoice = New SpVoice
'Create a Tapi object
Set gObjTapi = New TAPI
'Initialize TAPI. this must be called before
'any other tapi functions are called.
Call gObjTapi.Initialize
'set the EventFilter to accept all defined tapi events
gObjTapi.EventFilter = TAPI3_ALL_TAPI_EVENTS
Set gObjTapiWithEvents = gObjTapi
Call IpAddressOpt
'Load a good bye wave file and write it to the SpMemoryStream
Dim WaveData As Variant
WaveData = LoadResData("WAVEFILE", "CUSTOM")
Set MemStream = New SpMemoryStream
MemStream.SetData WaveData
'Disable the button right now. It will be enabled after the connection
DisconnectBtn.Enabled = False
'There is no connection right now
bConnectionStatus = False
End Sub
Private Sub Form_Unload(Cancel As Integer)
If bConnectionStatus Then
MsgBox "The application is busy. Cannot exit now. Please try to disconnect first"
'do not exit the app
Cancel = True
Else
'shut down tapi and release global objects
If Not (gObjTapi Is Nothing) Then
gObjTapi.Shutdown
End If
Set objCallControl = Nothing
Set gobjAddress = Nothing
Set gObjTapi = Nothing
Set MemStream = Nothing
End If
End Sub
Private Sub FindAnAddress(AddressTypeSelected As Long)
Dim Address As ITAddress
Dim AddressCaps As ITAddressCapabilities
Dim lType As Long
Dim MediaSupport As ITMediaSupport
For Each Address In gObjTapi.Addresses
'query for ITAddressCapabilities
Set AddressCaps = Address
lType = AddressCaps.AddressCapability(AC_ADDRESSTYPES)
Set AddressCaps = Nothing
'is the type we are looking for?
If lType And AddressTypeSelected Then
If AddressSupportsMediaType(Address, TAPIMEDIATYPE_AUDIO) Then
If Len(Address.AddressName) <> 0 Then
'save to global variable
Set gobjAddress = Address
Exit For
End If
End If
End If
Set Address = Nothing
Next
End Sub
Private Function AddressSupportsMediaType(Address As ITAddress, lType As Long) As Boolean
Dim bType As Boolean
Dim pMediaSupport As ITMediaSupport
bType = False
'Check whether the service provider associated with the current address
'supports the media type, lType
Set pMediaSupport = Address
If pMediaSupport Is Nothing Then
bType = False
Else
bType = pMediaSupport.QueryMediaType(lType)
End If
Set pMediaSupport = Nothing
AddressSupportsMediaType = bType
End Function
Private Sub SelectTerminalsOnCall()
Dim objStreamControl As ITStreamControl
Set objStreamControl = objCallControl
If Not (objStreamControl Is Nothing) Then
Dim objITCollStreams As ITCollection
Dim nIndex As Long, objCrtStream As ITStream
Dim objTerminalSupport As ITTerminalSupport
Set objITCollStreams = objStreamControl.Streams
Set objTerminalSupport = gobjAddress
'Create a media streaming terminal and select the capture stream for the SAPI/TTS
'audio output
Dim objTerminal As ITTerminal
Dim MediaStreamTerminalClsid As String
MediaStreamTerminalClsid = "{E2F7AEF7-4971-11D1-A671-006097C9A2E8}"
For nIndex = 1 To objITCollStreams.Count
Set objCrtStream = objITCollStreams.Item(nIndex)
If (objCrtStream.Direction = TD_CAPTURE) Then
Set objTerminal = objTerminalSupport.CreateTerminal( _
MediaStreamTerminalClsid, objCrtStream.MediaType, objCrtStream.Direction)
Call objCrtStream.SelectTerminal(objTerminal)
End If
Set objCrtStream = Nothing
Next nIndex
''''''''''''''
''USE SAPI TTS
''''''''''''''
Dim CustomStream As New SpCustomStream
Dim SapiTapiTTSStream As STCUSTOMSTREAMLib.TTSStream
'Create the TTSStream object
Set SapiTapiTTSStream = New STCUSTOMSTREAMLib.TTSStream
'Initialize the TTSStream object
SapiTapiTTSStream.InitTTSCaptureStream objTerminal
'Set the TTSStream object as a BaseStream in the SAPI CustomStream object
Set CustomStream.BaseStream = SapiTapiTTSStream
'Use the current format and prevent the SAPI object from changing it
gObjVoice.AllowAudioOutputFormatChangesOnNextSet = False
'Set the audio output to the SAPI CustomStream
Set gObjVoice.AudioOutputStream = CustomStream
'release not needed objects
Set SapiTapiTTSStream = Nothing
Set CustomStream = Nothing
Set objTerminalSupport = Nothing
Set objITCollStreams = Nothing
Set objStreamControl = Nothing
End If
End Sub
Private Sub MakeTheCall()
Dim lMediaType As Long
If (AddressSupportsMediaType(gobjAddress, TAPIMEDIATYPE_AUDIO)) Then
lMediaType = TAPIMEDIATYPE_AUDIO + lMediaType
End If
Set objCallControl = gobjAddress.CreateCall(DestAddressCombo.Text, _
AddressTypeSelected, lMediaType)
Call SelectTerminalsOnCall
'connect
On Error GoTo ErrHandler
objCallControl.Connect False
On Error GoTo 0
ErrHandler:
If Err.Number = -2147221492 Then
MsgBox "Connection failed. Is the domain name or the IP Address correct?"
StatusLbl.Caption = "Connection failed."
DisconnectBtn.Enabled = False
End If
End Sub
Private Sub gobjTapiWithEvents_Event(ByVal TapiEvent As TAPI3Lib.TAPI_EVENT, ByVal pEvent As Object)
Dim strMsg
Select Case TapiEvent
Case TE_CALLNOTIFICATION
Case TE_CALLSTATE
'for this type of event, the object pEvent must be
'queried for its ITCallStateEvent interface
Dim objCallStateEvent As ITCallStateEvent
Set objCallStateEvent = pEvent
Dim State As CALL_STATE
State = objCallStateEvent.State
DisplayCallState (State)
Set objCallStateEvent = Nothing
Case TE_CALLMEDIA
Dim MediaEvent As ITCallMediaEvent
Set MediaEvent = pEvent
Select Case MediaEvent.Event
Case CME_STREAM_ACTIVE
On Error GoTo ErrorHandler
'prompt greetings
If (Text1.Text = "") Then
gObjVoice.Speak "Hello"
gObjVoice.Speak "Welcome to the Speech and Telephony API app. Have a nice day! Bye now", SVSFlagsAsync
Else
gObjVoice.Speak Text1.Text, SVSFlagsAsync
End If
'Wait until the speak completes
Do
DoEvents
Loop Until gObjVoice.WaitUntilDone(1) = True
MemStream.Seek 0, SSSPTRelativeToStart
gObjVoice.SpeakStream MemStream
DisconnectBtn_Click
End Select
End Select
Exit Sub
ErrorHandler:
If Err.Number = VFW_E_NOT_COMMITTED Then
StatusLbl.Caption = "The connection was lost. Disconnecting ..."
StatusLbl.Refresh
DisconnectBtn_Click
Else
MsgBox "Error occurs: " & Err.Description & Err.Number
End If
End Sub
Private Sub DisplayCallState(State As CALL_STATE)
Dim strMsg As String
'Display the current call status
Select Case State
Case CS_CONNECTED
'The app is connected so we set the connection status to true
bConnectionStatus = True
StatusLbl.Caption = "CS_CONNECTED"
Case CS_DISCONNECTED
DisconnectBtn_Click
'The app is disconnected so we set the connection status to false
bConnectionStatus = False
StatusLbl.Caption = "CS_DISCONNECTED"
Case CS_HOLD
StatusLbl.Caption = " CS_HOLD"
Case CS_IDLE
StatusLbl.Caption = "CS_IDLE"
Case CS_INPROGRESS
StatusLbl.Caption = "CS_INPROGRESS"
Case CS_OFFERING
StatusLbl.Caption = "CS_OFFERING"
Case CS_QUEUED
StatusLbl.Caption = "CS_QUEUED"
Case Else
StatusLbl.Caption = "Unknown!!"
End Select
StatusLbl.Refresh
End Sub
Private Sub IpAddressOpt()
AddressTypeSelected = LINEADDRESSTYPE_DOMAINNAME
FindAnAddress AddressTypeSelected
'The app only supports the Internet call. You can add your interest IP
'addresses or machine names here programmatically or simply add them in the
'Properties of the DestAddressCombo ComBobox.
DestAddressCombo.Text = "<Machine Name> or IP address"
If Not (gobjAddress Is Nothing) Then
StatusLbl.Caption = "Using " & gobjAddress.AddressName
End If
StatusLbl.Refresh
End Sub

1
utils/sapi51/Samples/VB/VBTAPISamples/OutgoingCall/VBOutgoingcall.frx Normal file
View File

@@ -0,0 +1 @@
GWelcome to the Speech and Telephony API app. Have a nice day! Bye now

BIN
utils/sapi51/Samples/VB/VBTAPISamples/SAPITAPIWithInternetCall/SapiTapi.RES Normal file
View File

Binary file not shown.

1081
utils/sapi51/Samples/VB/VBTAPISamples/SAPITAPIWithInternetCall/SapiTapi.frm Normal file
View File

File diff suppressed because it is too large Load Diff

BIN
utils/sapi51/Samples/VB/VBTAPISamples/SAPITAPIWithInternetCall/SapiTapi.frx Normal file
View File

Binary file not shown.

40
utils/sapi51/Samples/VB/VBTAPISamples/SAPITAPIWithInternetCall/SapiTapi.vbp Normal file
View File

@@ -0,0 +1,40 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
Reference=*\G{C866CA3A-32F7-11D2-9602-00C04F8EE628}#5.0#0#..\..\..\..\..\sapi\sapi\objd\i386\sapi.dll#Microsoft Speech Object Library
Reference=*\G{21D6D480-A88B-11D0-83DD-00AA003CCABD}#1.0#0#..\..\..\..\..\..\..\..\WINNT\System32\tapi3.dll#Microsoft TAPI 3.0 Type Library
Reference=*\G{EDAEECD8-0D75-499E-9B69-187ACACF2C05}#1.0#0#..\..\..\cpp\tapicustomstream\objd\i386\STCustomStream.dll#STCustomStream 1.0 Type Library
Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
Form=SapiTapi.frm
ResFile32="SapiTapi.RES"
Startup="Form1"
HelpFile=""
ExeName32="SapiTapi.exe"
Command32=""
Name="SapiTapi"
HelpContextID="0"
CompatibleMode="0"
MajorVer=1
MinorVer=0
RevisionVer=0
AutoIncrementVer=0
ServerSupportFiles=0
VersionCompanyName="Microsoft Corp."
CompilationType=0
OptimizationType=2
FavorPentiumPro(tm)=0
CodeViewDebugInfo=-1
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1