Hi everyone!
I have this code that was written in vb.net and i've nearly converted it all to vba. There are few minor codes that i don't know how to change in to vba. They are shown in red. This will be greatly appreciated if someone could have a look and help me finish it off.
*Its long piece of code*
Many Thanks
I have this code that was written in vb.net and i've nearly converted it all to vba. There are few minor codes that i don't know how to change in to vba. They are shown in red. This will be greatly appreciated if someone could have a look and help me finish it off.
*Its long piece of code*
Code:
Option Compare Database
' Playback Sample
' Dragon NaturallySpeaking SDK
'
' Copyright (c) 1997-2003 ScanSoft, Inc.
' All Rights Reserved.
'
' This sample demonstrates how to use the Playback method
' and the SessionSave/SessionLoad methods of
' the DictationEdit control. Similar methods can be employed
' when working with the CustomDictation control.
'
' Holds current start position of next word
Public nStartPos As Integer
' Flag to determine if playback is one word at a time
Public bPlaySingle As Boolean
' Information on last played utterance, used to set selection
Public LastPlayInfo As DNSTools.NowPlayingInfo
'Playback start time
Public nPlaybackStartTime As Integer
' Selection positions
Public nSelStart As Integer
Public nSelLength As Integer
' Information about utterances currently played.
Dim NowPlaying As New Collection
'Used in PlaybackNoSpeech callback
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Integer)
Private Declare Function GetTickCount Lib "kernel32" () As Integer
'NOTIFYALLTIMING means NowPlaying notification gets all timing
' info, word by word. Default is to treat utt as single NOWPLAYINGINFO.
' So, if you need to get all timing info, you should use this constant
' in PlayBackEx().
[COLOR=#ff0000] Private Const NOTIFYALLTIMING As Short = &H2000s [/color]
Private Sub SetSelection(ByRef Start As Integer, ByRef NumChars As Integer)
Dim x As Object
' Selects the active word in the text box, strips off spaces
Dim lenGiven, actualLen As Integer
Dim theText As String
theText = Mid(Text1.Text, Start + 1, NumChars)
lenGiven = Len(theText)
actualLen = Len(Trim(theText))
If actualLen < lenGiven Then
For x = 1 To (lenGiven - actualLen)
' there is an extra space selected, so reduce NumChars
NumChars = NumChars - 1
' if the space is on the left, change the start position
' if it's on the right, it will be reflected in NumChars
If (VB.Left(theText, 1) = " ") Then
Start = Start + 1
End If
Next x
End If
Text1.SelectionStart = Start
Text1.SelectionLength = NumChars
Me.Text1.SetFocus
' Print some debugging information
System.Diagnostics.Debug.WriteLine ("last play start: " & Start & " last play num chars: " & NumChars)
System.Diagnostics.Debug.WriteLine (Mid(Text1.Text, Start + 1, NumChars))
End Sub
Private Function nextNonSpeechBoundary(ByRef nStart As Integer, ByRef szText As String) As Integer
' Given a string and a start position within it, finds the next
' non-Speech boundary character in the string and returns it's position
' a non-speech boundary is a word delimiter that has no speech data to
' be played back
Dim nPos As Integer
nPos = nStart
Do Until isNonSpeechBoundary(Mid(szText, nPos, 1))
nPos = nPos + 1
Loop
nextNonSpeechBoundary = nPos
End Function
Private Function isNonSpeechBoundary(ByRef szChar As String) As Boolean
' Tests to see if a character is a non-speech boundary
' A non-speech boundary is a word delimiter that has no speech data
' to be played back, these include things like spaces, carriage-returns
' and null characters (could be an end of string...)
Select Case szChar
Case " ", "", vbCr, vbLf ' Add new boundaries here
isNonSpeechBoundary = True
Case Else
isNonSpeechBoundary = False
End Select
End Function
Private Function nextSpeechBoundary(ByRef nStart As Integer, ByRef szText As String) As Integer
' Given a string and a start position within it, finds the next
' Speech boundary character in the string and returns it's position
' a speech boundary is a word delimiter that has speech data to
' be played back
Dim nPos As Integer
nPos = nStart
Do Until isSpeechBoundary(Mid(szText, nPos, 1))
nPos = nPos + 1
Loop
nextSpeechBoundary = nPos
End Function
Private Function isSpeechBoundary(ByRef szChar As String) As Boolean
' Tests to see if a character is a speech boundary
' A speech boundary is a word delimiter that has speech data
' to be played back, these include things like periods, commas,
' colons, etc...
' These are essentially one character words that appear next to
' other words with no intervening spaces
Select Case szChar
Case ".", ",", ";", ":", "/", "" ' Add new boundaries here
isSpeechBoundary = True
Case Else
isSpeechBoundary = False
End Select
End Function
Private Function FindWordLengthFromStart() As Integer
Dim Length As Object
' Using the global nStartPos, determines the length of the next word
' to be played back. Finds both non-Speech and Speech boundaries and
' then compares to see which one should be used. If the word is padded
' by a preceeding non-speech boundary, it will move the start position
' to ignore that segment of the text
Dim nNonSpeech, endPos, nAdjustedStart, nSpeech As Integer
nAdjustedStart = nStartPos
' Find boundary positions, adjusting the start pos as long as it
' coincides with any non-speech boundary. When the speech and
'non-speech boundries are the same, we're at the end.
Do
nAdjustedStart = nAdjustedStart + 1
nNonSpeech = nextNonSpeechBoundary(nAdjustedStart, (Text1.Text))
nSpeech = nextSpeechBoundary(nAdjustedStart, (Text1.Text))
Loop While (nNonSpeech = nAdjustedStart) And (nNonSpeech <> nSpeech)
' Determine the endPos of the word
endPos = nNonSpeech
If nNonSpeech = 0 Then endPos = nSpeech
If endPos = 0 Then endPos = Len(Text1.Text)
' if the speech boundary comes before the non-speech boundary,
' use the speech boundary instead
If nSpeech <> 0 And nNonSpeech <> 0 Then
If nSpeech < nNonSpeech Then
endPos = nSpeech
End If
End If
' Determine the length of the word, must be non-zero
Length = endPos - (nStartPos + 1)
If Length <= 0 Then Length = 1
' Set return value
FindWordLengthFromStart = Length
End Function
Private Sub cmdLoad_Click()
' This allows us to load speech data from a previously
' saved session. By using the loadFlags below, we will
' overwrite any text in the text box with the text from our
' previous session. Once the text and speech data are loaded,
' playback can be used as if the text had just been dictated.
Dim loadFlags As DNSTools.DgnDictationSessionLoadConstants
' ...MatchText is always on, it specifies that the data
' being loaded, must match the text in the current dictation
' buffer (mirrorred by the text box)
loadFlags = DNSTools.DgnDictationSessionLoadConstants.dgnsessionloadMatchText
' ...Notify will cause a text_changed event to be sent to the
' text box for each utterance that is loaded from the data
loadFlags = loadFlags + DNSTools.DgnDictationSessionLoadConstants.dgnsessionloadNotify
' ...ClearDocument will clear the dictation buffer before
' loading any data, must use with ...AllowNewText
loadFlags = loadFlags + DNSTools.DgnDictationSessionLoadConstants.dgnsessionloadClearDocument
' ...AllowNewText will allow any utterance not already in
' the buffer to be loaded without having to match. Any
' data already in the buffer MUST match the data being loaded
loadFlags = loadFlags + DNSTools.DgnDictationSessionLoadConstants.dgnsessionloadAllowNewText
' Use CommonDilaog control to load data
On Error GoTo ErrorHandler
dlgFile.Filter = "Speech Data Files (*.dra)|*.dra"
dlgFile.CancelError = True
dlgFile.Flags = MSComDlg.FileOpenConstants.cdlOFNFileMustExist
[COLOR=#ff0000]dlgFile.ShowOpen()
DgnDictEdit1.SessionLoad(dlgFile.FileName, loadFlags)[/color]
ErrorHandler:
' This is here to catch if the user cancels from
' the Open dialog
End Sub
Private Sub cmdPlayAll_Click()
' Start at beginning and play all the words
' words will be played one at a time in sequence
bPlaySingle = False
[COLOR=#ff0000]DgnDictEdit1.PlaybackEx(0, Len(Text1.Text), NOTIFYALLTIMING)[/color]
End Sub
Private Sub cmdPlaySingle_Click()
' Play a single word starting from nStartPos
bPlaySingle = True
' If nStartPos is at the end of the text, start over
If nStartPos >= Len(Text1.Text) Then
nStartPos = 0
End If
[COLOR=#ff0000]DgnDictEdit1.Playback(nStartPos, FindWordLengthFromStart)[/color]
End Sub
Private Sub cmdSave_Click()
' Save the speech data from the current session so that
' we can access it at a later time.
' Use the Common Dialog Control to open the Windows file
' dialog
On Error GoTo ErrorHandler
dlgFile.Filter = "Speech Data Files (*.dra)|*.dra"
dlgFile.CancelError = True
[COLOR=#ff0000]dlgFile.ShowSave()[/color]
If dlgFile.FileName <> "" Then
DgnDictEdit1.SessionSave (dlgFile.FileName)
End If
ErrorHandler:
' This is here to catch if the user cancels from
' the Save As dialog
End Sub
Private Sub DgnDictEdit1_PlaybackBeginning()
If (bPlaySingle = False) Then
' Enabling the timer to move the selection range, if the "playback entire phrase"
' is selected
Timer1.Enabled = True
nStartPos = -1
End If
End Sub
Private Sub DgnDictEdit1_PlaybackNoSpeech()
' There is no speech data associated with this word, update the
' start position and move on
System.Diagnostics.Debug.WriteLine ("Playback no speech")
nStartPos = eventArgs.Start + eventArgs.NumChars
[COLOR=#ff0000]SetSelection(eventArgs.Start, eventArgs.NumChars)[/color]
'Pause briefly, so the user sees it selected
Sleep (100)
End Sub
Private Sub DgnDictEdit1_PlaybackNowPlaying()
' Updates the visibile text selection based on information about
' the word size received in the PlayInfos collection
Dim curInfo As Object
If (bPlaySingle = True) Then
' Get the last PlayInfo
LastPlayInfo = eventArgs.PlayInfos(eventArgs.PlayInfos.Count)
' Update the start position for the next word
nStartPos = LastPlayInfo.Start + LastPlayInfo.NumChars
' Set the selection
[COLOR=#ff0000]SetSelection((LastPlayInfo.Start), (LastPlayInfo.NumChars))[/color]
Else
' Remembering start time, selection position...
nPlaybackStartTime = GetTickCount
nSelStart = Text1.SelectionStart
nSelLength = Text1.SelectionLength
' ...and clearing NowPlaying collection
While (NowPlaying.Count() <> 0)
NowPlaying.Remove ((1))
[COLOR=#ff0000] End While [/color]
' Store PlayInfos collection into NowPlaying to set selection
For Each curInfo In eventArgs.PlayInfos
NowPlaying.Add (curInfo)
Next curInfo
End If
End Sub
Private Sub DgnDictEdit1_PlaybackStopped()
' Playback is done, if we are playing one word at a time,
' then do nothing. Otherwise, stop the timer and restore
' the selection.
If (bPlaySingle = False) Then
Timer1.Enabled = False
Text1.SelectionStart = nSelStart
Text1.SelectionLength = nSelLength
Text1.SetFocus
End If
End Sub
Private Sub Form_Load()
' Check for a valid speaker
[COLOR=#ff0000] TryUsers() [/color]
' Initialize nStartPos and register the Dgn Objects
nStartPos = 0
DgnDictEdit1.Register (Text1.Handle.ToInt32)
[COLOR=#ff0000] DgnMicBtn1.Register() [/color]
End Sub
Private Sub Text1_TextChanged()
' Reset starting position
nStartPos = 0
End Sub
Private Sub Text1_DoubleClick()
' Set starting position to new cursor position
nStartPos = Text1.SelectionStart
End Sub
Private Sub TryUsers()
' Check to see if an engine is running by looking
' at whether the engine control has a valid speaker
' If not, this sample will not work right
If DgnEngineControl1.Speaker = "" Then
MsgBox "This sample requires NaturallySpeaking to be loaded " & "and trained before it will run. The application will " & "be shut down.", MsgBoxStyle.Exclamation + MsgBoxStyle.OKOnly, "Engine Not Available"
End
End If
End Sub
Private Sub Timer1_Tick()
Dim nTimeSinceStart, nTimeSoFar As Integer
Dim I As Short
Dim curInfo As Object
nTimeSinceStart = GetTickCount - nPlaybackStartTime
nTimeSoFar = 0
For Each curInfo In NowPlaying
nTimeSoFar = nTimeSoFar + curInfo.Duration
If (nTimeSoFar >= nTimeSinceStart) Then
'Select next word, if it is not done yet.
If (nStartPos <> curInfo.Start) Then
' move the selection
Text1.SelectionStart = curInfo.Start
Text1.SelectionLength = curInfo.NumChars
Text1.SetFocus
nStartPos = curInfo.Start
End If
Exit For
End If
Next curInfo
End SubMany Thanks