Speak Text from the Clipboard!! (Windows Only)

[KristopherWindsor]

This works on Windows Vista, and it might work on XP, too.

This uses Zippy's code from:
-> Need help with disphelper

Code: Select all

' Speak the Clipboard! v1.0
' (C) 2008 Innova and Kristopher Windsor

#define UNICODE
#include once "disphelper/disphelper.bi"
#include once "windows.bi"

Function clipboard () As String
  Dim As Zstring Ptr s_ptr
  Dim As HANDLE hglb
  Dim As String s = ""
 
  If (IsClipboardFormatAvailable(CF_TEXT) = 0) Then Return ""
 
  If OpenClipboard( NULL ) <> 0 Then
    hglb = GetClipboardData(cf_text)
    s_ptr = GlobalLock(hglb)
    If (s_ptr <> NULL) Then
      s = *s_ptr
      GlobalUnlock(hglb)
    End If
    CloseClipboard()
  End If
 
  Return s
End Function

Sub speak (Byref text As String)
  Dim myt As Wstring * 512
  Dim As Integer isSpeaking
  Dim As HRESULT hr
 
  DISPATCH_OBJ(tts)
 
  dhInitialize(TRUE)
  dhToggleExceptions(FALSE) 'set this TRUE to get error codes
 
  myt = "Sapi.SpVoice"
  hr = dhCreateObject(@myt, NULL, @tts)
  If hr <> 0 Then Exit Sub
 
  myt = text
  dhCallMethod(tts, ".Speak(%S)", @myt)
 
  SAFE_RELEASE(tts)
End Sub

Dim As String c, pc

Screenres 320, 240, 32

Do
  pc = c
  c = clipboard()
  If Len(c) And c <> pc Then
    speak(c)
  End If
  Sleep 1000
Loop Until Inkey = Chr(27)


:-)

Tags: kristopherwindsor_program_trick

[phycowelder]

that's cool! it just spoke/told me the code for this program! LOL

[nkk_kan]

hehe, i'm fed up of that voice..
when my monitor broke...it babbled endlessly to help me use my computer :P
Anyways, good trick!

[vdecampo]

I modified your code to provide a text buffer and threading so the speech won't slow down your program and it will queue multiple lines of text. This would be good to add speech to a game.

Code: Select all

/'*****************************************
'   Non-Blocking Text-To-Speech Routines  *
'   v 1.0 by Vincent DeCampo              *
'                                         *
'  Derived from:                          *
'  Speak the Clipboard! v1.0              *
'  (C) 2008 Innova and Kristopher Windsor *
******************************************'/

#define UNICODE
#include once "disphelper/disphelper.bi"

Declare Sub SpeakEngine (param As Any Ptr)

#Define MAX_BUFFERS    20

Type _RingBuffer
   rIdx   As Integer = 0
   wIdx   As Integer = 0
End Type

Dim Shared Mutex                 As Any Ptr       
Dim Shared IsSpeaking            As Integer = 0
Dim Shared Ring                  As _RingBuffer
Dim Shared RingText(MAX_BUFFERS) As wString * 255

Sub Speak (Text As String)
Dim StartThread As Integer

   MutexLock(Mutex)

   With Ring
      RingText(.wIdx) = Text
      .wIdx += 1
      If .wIdx > MAX_BUFFERS Then
         .wIdx = 0
      EndIf
         
   End With
   
   If IsSpeaking = 0 Then
      IsSpeaking  = 1
      StartThread = 1
   End If

   MutexUnLock(Mutex)
     
   If StartThread then
      ThreadCreate (@SpeakEngine, @IsSpeaking)
   EndIf
     
End Sub

Sub SpeakEngine (param As Any Ptr)
Dim SpeakFlag As Integer Ptr = param
Dim Text As wString * 512
Dim myt  As wString * 512
Dim As HRESULT hr

   MutexLock(Mutex)

   With Ring
     
      DO
 
         Text = RingText(.rIdx)
         Print ">" + Text
                     
         RingText(.rIdx)=""
         .rIdx += 1
         
         If (.rIdx > MAX_BUFFERS) Then
            .rIdx = 0
         EndIf
                 
         DISPATCH_OBJ(tts)
         
         dhInitialize(TRUE)
         dhToggleExceptions(FALSE) 'set this TRUE to get error codes
         
         myt = "Sapi.SpVoice"
         hr = dhCreateObject(@myt, NULL, @tts)
         If hr <> 0 Then Exit Sub

         MutexUnLock (Mutex)         
            dhCallMethod(tts, ".Speak(%S)", @Text)
         MutexLock (Mutex)
         
         SAFE_RELEASE(tts)

      Loop Until (.wIdx - .rIdx) = 0
   
   End With
   
   SpeakFlag[0]=0
   
   Print "Thread Exit..."
   
   MutexUnLock(Mutex)
     
End Sub

/'***********************************
*           MAIN PROGRAM            *
***********************************'/

Screenres 320,240

   Mutex = MutexCreate
   
   Speak ("Press Escape to Exit")
   Speak ("Note how the speech")
   Speak ("Plays in a separate thread")
   Speak ("and the app keeps on running...")
   
   Do
      Print ".";
      Sleep 100
   Loop Until InKey=Chr(27)
   


-Vince

[Edit:] BAH! Still a little buggy. Sometimes it plays the lines out of order. Stupid Threads!!! :-)

[Edit2:] Fixed the problem, I had 2 variable with the same name, one in global scope, the other local. DOH!

[cha0s]

You have to do 'mutex = mutexcreate( )', and make sure to destroy it later, too.

[vdecampo]

You have to do 'mutex = mutexcreate( )', and make sure to destroy it later, too.

I did create the mutex, but I forgot to destroy it.

Code: Select all

Sub Speak (Text As String)

   If Mutex = 0 Then
      Mutex = MutexCreate
   Endif


-Vince

[Zippy]

I should have stated in the original thread that SAPI5 defaults to synchronous mode whereas SAPI4 defaults to asynchronous. Sorry Vince..

Please see NOTES at end.

This code demos setting:

asynchronous mode
synchronous mode (default)
Volume
Rate (how fast it speaks..)
Pausing and Resuming asynchronous speech
and how to speak the contents of a file (please spec a REAL FILE!)

Code: Select all

#define UNICODE
'
#define SPF_DEFAULT          0 'not asynchronous
#define SPF_ASYNC            1 'mmmm... asynchronous
#define SPF_PURGEBEFORESPEAK 2 'Purges all pending speak requests prior to this speak call.
#define SPF_IS_FILENAME      4 'The string passed is a file name, and the file text should be spoken.
#define SPF_IS_XML           8 'The input text will be parsed for XML markup.
#define SPF_IS_NOT_XML      16
'
#include once "disphelper/disphelper.bi"
#include once "windows.bi"
'
dim as HRESULT hr
dim myt as wstring * 512
dim as string tempstr
dim shared as IDispatch ptr tts=NULL 'DISPATCH_OBJ(tts)
declare sub imouttahere() destructor
'
dhInitialize(TRUE)
dhToggleExceptions(TRUE)'FALSE) 'set this TRUE to get error codes
hr=dhCreateObject("Sapi.SpVoice",NULL,@tts)
'
'test speaking
myt="Now is the time for all good men to come to the aid of the party"
dhPutValue(tts, ".Volume = %d", 80) 'Volume range is 0 to 100
dhCallMethod(tts,".Speak(%S,%d)", @myt,0)'synchronous
'
sleep 1000
'
'test speaking a text file, have it long enough for
'   the pause and resume tests that follow..
myt="c:\whatever\long\file.txt" 'PLEASE change to something real..
tempstr=myt
if dir(myt)="" then
    beep
    print "Abandoning further tests, ";myt;" file doesn't exist"
    print
    print "Exit in 5 seconds.."
    sleep 5000
    end
end if

dhPutValue(tts,".Volume = %d",100)
dhCallMethod(tts,".Speak(%S,%d)",_
             @myt,_
             SPF_IS_NOT_XML or SPF_IS_FILENAME or SPF_ASYNC)'async from file
'
'pause..
sleep 4000
print "pausing.."
dhCallMethod(tts,".Pause")
'
'resume
sleep 4000
print "resuming.."
dhPutValue(tts,".Rate = %d",2) 'Rate range is -10 to 10
dhCallMethod(tts,".Resume")
'
print
print "Sleeping to exit.."
sleep
end
'
sub imouttahere() destructor
  SAFE_RELEASE(tts)
end sub


NOTES:

This code is specific to SAPI5 which in theory will run on Win98. The core elements (see other thread) were/are a part of WinXP. The speech engine et al are not installed with XP, however installing any Office prod that has speech capabilities does. Without Office installed (I'm not sure what flavors) you must install the speech engine etc (again see other thread) separately.

Kristopher reports that all works on Vista without additional installations.

There is a method to wait for the asynchronous speech to complete, say before exiting your program, - if I have time I'll finger that out later.

ETA "destructor" on sub.. won't work without it..

[Conexion]

Works great on XP... very fun example... While I know this uses the standard windows voices, I'd love to write a text to speech program some day... Hmmmmmmm

[KristopherWindsor]

Oh, I didn't know Office had anything to do with the speech; it never spoke to me. :-P
FWIW, I have Office 2000 on this computer, with Vista. ;-)

[Loe]

Here use SAPI with AxSupport ^_^
http://www.fbedit.freebasic.net/viewtopic.php?f=10&t=273

**Edit
sapi.bi, generated by AxSupport TLB

Code: Select all

'----------------------------------------------------------------------------------------------------
'   VTable Call - Microsoft Speech Object Library
'   TypeLib CLSID="{C866CA3A-32F7-11D2-9602-00C04F8EE628}"
'----------------------------------------------------------------------------------------------------

' --------------------------------------------------------------------------------------------
' ProgIds
' --------------------------------------------------------------------------------------------
Const PROGID_SAPISpVoice1 = "SAPI.SpVoice.1"

Enum SpeechVoiceSpeakFlags
   SVSFDefault = 0  ' &H0
   SVSFlagsAsync = 1  ' &H1
   SVSFPurgeBeforeSpeak = 2  ' &H2
   SVSFIsFilename = 4  ' &H4
   SVSFIsXML = 8  ' &H8
   SVSFIsNotXML = 16  ' &H10
   SVSFPersistXML = 32  ' &H20
   SVSFNLPSpeakPunc = 64  ' &H40
   SVSFNLPMask = 64  ' &H40
   SVSFVoiceMask = 127  ' &H7F
   SVSFUnusedFlags = -128  ' &HFFFFFFFFFFFFFF80
End Enum

'----------------------------------------------------------------------------------------------------
'Interface ISpeechVoice
'GUID = {269316D8-57BD-11D2-9EEE-00C04F797396}
'----------------------------------------------------------------------------------------------------
Type ISpeechVoice
   QueryInterface /'(Byref riid As GUID [record],Byref ppvObj As Dword [VT_VOID])'/ As Uint:QueryInterfaceArgs(2) As Uint
   AddRef /'()'/ As Uint:AddRefArgs(0) As Uint
   Release /'()'/ As Uint:ReleaseArgs(0) As Uint
   ' Status
   getStatus /'(Byref Status As ISpeechVoiceStatus [dispinterface])'/ As Uint:getStatusArgs(1) As Uint
   ' Voice
   getVoice /'(Byref Voice As ISpeechObjectToken [dispinterface])'/ As Uint:getVoiceArgs(1) As Uint
   ' Voice
   setVoice /'(Byval Voice As ISpeechObjectToken [dispinterface])'/ As Uint:setVoiceArgs(1) As Uint
   ' Gets the audio output object
   getAudioOutput /'(Byref AudioOutput As ISpeechObjectToken [dispinterface])'/ As Uint:getAudioOutputArgs(1) As Uint
   ' Gets the audio output object
   setAudioOutput /'(Byval AudioOutput As ISpeechObjectToken [dispinterface])'/ As Uint:setAudioOutputArgs(1) As Uint
   ' Gets the audio output stream
   getAudioOutputStream /'(Byref AudioOutputStream As ISpeechBaseStream [dispinterface])'/ As Uint:getAudioOutputStreamArgs(1) As Uint
   ' Gets the audio output stream
   setAudioOutputStream /'(Byval AudioOutputStream As ISpeechBaseStream [dispinterface])'/ As Uint:setAudioOutputStreamArgs(1) As Uint
   ' Rate
   getRate /'(Byref Rate As Long '[VT_I4])'/ As Uint:getRateArgs(1) As Uint
   ' Rate
   putRate /'(Byval Rate As Long '[VT_I4])'/ As Uint:putRateArgs(1) As Uint
   ' Volume
   getVolume /'(Byref Volume As Long '[VT_I4])'/ As Uint:getVolumeArgs(1) As Uint
   ' Volume
   putVolume /'(Byval Volume As Long '[VT_I4])'/ As Uint:putVolumeArgs(1) As Uint
   ' AllowAudioOutputFormatChangesOnNextSet
   putAllowAudioOutputFormatChangesOnNextSet /'(Byval Allow As Long '[VT_BOOL])'/ As Uint:putAllowAudioOutputFormatChangesOnNextSetArgs(1) As Uint
   ' AllowAudioOutputFormatChangesOnNextSet
   getAllowAudioOutputFormatChangesOnNextSet /'(Byref Allow As Long '[VT_BOOL])'/ As Uint:getAllowAudioOutputFormatChangesOnNextSetArgs(1) As Uint
   ' EventInterests
   getEventInterests /'(Byref EventInterestFlags As SpeechVoiceEvents [enum])'/ As Uint:getEventInterestsArgs(1) As Uint
   ' EventInterests
   putEventInterests /'(Byval EventInterestFlags As SpeechVoiceEvents [enum])'/ As Uint:putEventInterestsArgs(1) As Uint
   ' Priority
   putPriority /'(Byval Priority As SpeechVoicePriority [enum])'/ As Uint:putPriorityArgs(1) As Uint
   ' Priority
   getPriority /'(Byref Priority As SpeechVoicePriority [enum])'/ As Uint:getPriorityArgs(1) As Uint
   ' AlertBoundary
   putAlertBoundary /'(Byval Boundary As SpeechVoiceEvents [enum])'/ As Uint:putAlertBoundaryArgs(1) As Uint
   ' AlertBoundary
   getAlertBoundary /'(Byref Boundary As SpeechVoiceEvents [enum])'/ As Uint:getAlertBoundaryArgs(1) As Uint
   ' SyncSpeakTimeout
   putSynchronousSpeakTimeout /'(Byval msTimeout As Long '[VT_I4])'/ As Uint:putSynchronousSpeakTimeoutArgs(1) As Uint
   ' SyncSpeakTimeout
   getSynchronousSpeakTimeout /'(Byref msTimeout As Long '[VT_I4])'/ As Uint:getSynchronousSpeakTimeoutArgs(1) As Uint
   ' Speak
   Speak /'(Byval Text As Bstr '[VT_BSTR],Byval Flags As SpeechVoiceSpeakFlags [enum],Byref StreamNumber As Long '[VT_I4])'/ As Uint:SpeakArgs(3) As Uint
   ' SpeakStream
   SpeakStream /'(Byval Stream As ISpeechBaseStream [dispinterface],Byval Flags As SpeechVoiceSpeakFlags [enum],Byref StreamNumber As Long '[VT_I4])'/ As Uint:SpeakStreamArgs(3) As Uint
   ' Pauses the voices rendering.
   Pause /'()'/ As Uint:PauseArgs(0) As Uint
   ' Resumes the voices rendering.
   Resume /'()'/ As Uint:ResumeArgs(0) As Uint
   ' Skips rendering the specified number of items.
   Skip /'(Byval Type As Bstr '[VT_BSTR],Byval NumItems As Long '[VT_I4],Byref NumSkipped As Long '[VT_I4])'/ As Uint:SkipArgs(3) As Uint
   ' GetVoices
   GetVoices /'(Byval RequiredAttributes As Bstr '[VT_BSTR],Byval OptionalAttributes As Bstr '[VT_BSTR],Byref ObjectTokens As ISpeechObjectTokens [dispinterface])'/ As Uint:GetVoicesArgs(3) As Uint
   ' GetAudioOutputs
   GetAudioOutputs /'(Byval RequiredAttributes As Bstr '[VT_BSTR],Byval OptionalAttributes As Bstr '[VT_BSTR],Byref ObjectTokens As ISpeechObjectTokens [dispinterface])'/ As Uint:GetAudioOutputsArgs(3) As Uint
   ' WaitUntilDone
   WaitUntilDone /'(Byval msTimeout As Long '[VT_I4],Byref Done As Long '[VT_BOOL])'/ As Uint:WaitUntilDoneArgs(2) As Uint
   ' SpeakCompleteEvent
   SpeakCompleteEvent /'(Byref Handle As Long '[VT_I4])'/ As Uint:SpeakCompleteEventArgs(1) As Uint
   ' IsUISupported
   IsUISupported /'(Byval TypeOfUI As Bstr '[VT_BSTR],Byval ExtraData As Variant '[VT_VARIANT],Byref Supported As Long '[VT_BOOL])'/ As Uint:IsUISupportedArgs(3) As Uint
   ' DisplayUI
   DisplayUI /'(Byval hWndParent As Long '[VT_I4],Byval Title As Bstr '[VT_BSTR],Byval TypeOfUI As Bstr '[VT_BSTR],Byval ExtraData As Variant '[VT_VARIANT])'/ As Uint:DisplayUIArgs(4) As Uint
   pMark As Long: pThis As uint
End Type

Dim shared initISpeechVoice As ISpeechVoice=>(_
   &H0,{2,vt_Byref or &H0,vt_Byref or &H18},_ ' QueryInterface
   &H4,{0},_ ' AddRef
   &H8,{0},_ ' Release
   &H1C,{1,vt_Byref or &H0},_ ' getStatus
   &H20,{1,vt_Byref or &H0},_ ' getVoice
   &H24,{1,&H0},_ ' setVoice
   &H28,{1,vt_Byref or &H0},_ ' getAudioOutput
   &H2C,{1,&H0},_ ' setAudioOutput
   &H30,{1,vt_Byref or &H0},_ ' getAudioOutputStream
   &H34,{1,&H0},_ ' setAudioOutputStream
   &H38,{1,vt_Byref or &H3},_ ' getRate
   &H3C,{1,&H3},_ ' putRate
   &H40,{1,vt_Byref or &H3},_ ' getVolume
   &H44,{1,&H3},_ ' putVolume
   &H48,{1,&HB},_ ' putAllowAudioOutputFormatChangesOnNextSet
   &H4C,{1,vt_Byref or &HB},_ ' getAllowAudioOutputFormatChangesOnNextSet
   &H50,{1,vt_Byref or &H0},_ ' getEventInterests
   &H54,{1,&H0},_ ' putEventInterests
   &H58,{1,&H0},_ ' putPriority
   &H5C,{1,vt_Byref or &H0},_ ' getPriority
   &H60,{1,&H0},_ ' putAlertBoundary
   &H64,{1,vt_Byref or &H0},_ ' getAlertBoundary
   &H68,{1,&H3},_ ' putSynchronousSpeakTimeout
   &H6C,{1,vt_Byref or &H3},_ ' getSynchronousSpeakTimeout
   &H70,{3,&H8,&H0,vt_Byref or &H3},_ ' Speak
   &H74,{3,&H0,&H0,vt_Byref or &H3},_ ' SpeakStream
   &H78,{0},_ ' Pause
   &H7C,{0},_ ' Resume
   &H80,{3,&H8,&H3,vt_Byref or &H3},_ ' Skip
   &H84,{3,&H8,&H8,vt_Byref or &H0},_ ' GetVoices
   &H88,{3,&H8,&H8,vt_Byref or &H0},_ ' GetAudioOutputs
   &H8C,{2,&H3,vt_Byref or &HB},_ ' WaitUntilDone
   &H90,{1,vt_Byref or &H3},_ ' SpeakCompleteEvent
   &H94,{3,&H8,&HC,vt_Byref or &HB},_ ' IsUISupported
   &H98,{4,&H3,&H8,&H8,&HC},_ ' DisplayUI
   -1,0)


sayc.bas, console

Code: Select all

#Include Once "axobj.bi"
#Include Once "sapi.bi"

Dim spv As ISpeechVoice
Dim punk As lpunknown
Dim buff As String

spv=initISpeechVoice
axinit
axcreateobject(PROGID_SAPISpVoice1,punk)
setobj(@spv,punk)
vtcall spv.putVolume,80
buff="Now is the time for all good men to come to the aid of the party"
vtcall spv.Speak,wstr(buff),SVSFDefault
vtcall spv.WaitUntilDone,-1
vtcall spv.release
end


[I3I2UI/I0]

Hi,
it is based on 'speech in freebasic' by Jim
http://dbfinteractive.com/index.php?topic=1161.0
voice.bas

Code: Select all

'under construction ....
#define WIN_INCLUDEALL
#Include Once "windows.bi"

#define SPF_DEFAULT 0
#define SPF_ASYNC 1

Type ISpVoiceVtbl_ As ISpVoiceVtbl

Type ISpVoice
  lpVtbl As ISpVoiceVtbl_ Ptr
End Type

Type ISpVoiceVtbl
  ' iunknown
  QueryInterface As Function(ByVal As ISpVoice Ptr, ByVal As IID Ptr, ByVal As Any Ptr) As HRESULT
  AddRef As Function(ByVal As ISpVoice Ptr) As ULong
  Release As Function(ByVal As ISpVoice Ptr) As ULong

  ' stubs
  SetNotifySink As Function() As HRESULT
  SetNotifyWindowMessage As Function() As HRESULT
  SetNotifyCallbackFunction As Function() As HRESULT
  SetNotifyCallbackInterface As Function() As HRESULT
  SetNotifyWin32Event As Function() As HRESULT
  WaitForNotifyEvent As Function() As HRESULT
  GetNotifyEventHandle As Function() As HRESULT
  SetInterest As Function() As HRESULT
  GetEvents As Function() As HRESULT
  GetInfo As Function() As HRESULT
  SetOutput As Function() As HRESULT
  GetOutputObjectToken As Function() As HRESULT
  GetOutputStream As Function() As HRESULT

  ' done
  Pause As Function(ByVal As ISpVoice Ptr) As HRESULT
  Resume As Function(ByVal As ISpVoice Ptr) As HRESULT

  ' stubs
  SetVoice As Function() As HRESULT
  GetVoice As Function() As HRESULT

  ' done
  Speak As Function(ByVal As ISpVoice Ptr, ByVal pwcs As WString Ptr, ByVal dwFlags As Dword, _
                    ByVal pulStreamNumber As ULong Ptr) As HRESULT

  ' stubs
  SpeakStream As Function() As HRESULT
  GetStatus As Function() As HRESULT
  Skip As Function() As HRESULT
  SetPriority As Function() As HRESULT
  GetPriority As Function() As HRESULT
  SetAlertBoundary As Function() As HRESULT
  GetAlertBoundary As Function() As HRESULT

  ' done
  SetRate As Function(ByVal As ISpVoice Ptr, ByVal RateAdjust As Integer) As HRESULT
  GetRate As Function(ByVal As ISpVoice Ptr, ByVal RateAdjust As Integer Ptr) As HRESULT
  SetVolume As Function(ByVal As ISpVoice Ptr, ByVal usVolume As UShort) As HRESULT
  GetVolume As Function(ByVal As ISpVoice Ptr, ByVal pusVolume As UShort Ptr) As HRESULT
  WaitUntilDone As Function(ByVal As ISpVoice Ptr, ByVal msTimeout As ULong) As HRESULT
  SetSyncSpeakTimeout As Function(ByVal As ISpVoice Ptr, ByVal msTimeout As ULong) As HRESULT
  GetSyncSpeakTimeout As Function(ByVal As ISpVoice Ptr, ByVal msTimeout As ULong Ptr) As HRESULT
  SpeakCompleteEvent As Function(ByVal As ISpVoice Ptr) As HANDLE

  ' stubs
  IsUISupported As Function() As HRESULT
  DisplayUI As Function() As HRESULT
End Type
#define ISpVoice_QueryInterface(This,riid,ppvObject) (This)->lpVtbl -> QueryInterface(This,riid,ppvObject)
#define ISpVoice_AddRef(This) (This)->lpVtbl -> AddRef(This)
#define ISpVoice_Release(This) (This)->lpVtbl -> Release(This)
#define ISpVoice_Pause(This) (This)->lpVtbl -> Pause(This)
#define ISpVoice_Resume(This) (This)->lpVtbl -> Resume(This)
'#define ISpVoice_SetVoice(This,pToken) (This)->lpVtbl -> SetVoice(This,pToken)
'#define ISpVoice_GetVoice(This,ppToken) (This)->lpVtbl -> GetVoice(This,ppToken)
#define ISpVoice_Speak(This,pwcs,dwFlags,pulStreamNumber)   (This)->lpVtbl -> Speak(This,pwcs,dwFlags,pulStreamNumber)
#define ISpVoice_SetRate(This,RateAdjust) (This)->lpVtbl -> SetRate(This,RateAdjust)
#define ISpVoice_GetRate(This,pRateAdjust) (This)->lpVtbl -> GetRate(This,pRateAdjust)
#define ISpVoice_SetVolume(This,usVolume) (This)->lpVtbl -> SetVolume(This,usVolume)
#define ISpVoice_GetVolume(This,pusVolume) (This)->lpVtbl -> GetVolume(This,pusVolume)
#define ISpVoice_WaitUntilDone(This,msTimeout) (This)->lpVtbl -> WaitUntilDone(This,msTimeout)
#define ISpVoice_SetSyncSpeakTimeout(This,msTimeout) (This)->lpVtbl -> SetSyncSpeakTimeout(This,msTimeout)
#define ISpVoice_GetSyncSpeakTimeout(This,pmsTimeout) (This)->lpVtbl -> GetSyncSpeakTimeout(This,pmsTimeout)
#define ISpVoice_SpeakCompleteEvent(This) (This)->lpVtbl -> SpeakCompleteEvent(This)

Dim Shared voice As ISpVoice Ptr


Sub voice_ini ()
  Dim IID_ISpVoice As GUID => ( &H6c44df74, &H72b9, &H4992, {&Ha1, &Hec, &Hef, &H99, &H6e, &H04, &H22, &Hd4 })
  Dim CLSID_SpVoice As GUID => ( &H96749377, &H3391, &H11d2, {&H9e, &He3, &H00, &Hc0, &H4f, &H79, &H73, &H96 })
  CoInitialize(NULL)
  CoCreateInstance(@CLSID_SpVoice, NULL, CLSCTX_ALL, @IID_ISpVoice, Cast (Any Ptr, @voice))
End Sub

Sub voice_end ()
  Dim As String spreche
  Spreche = "Have a nice day "
  ISpVoice_Speak(voice, spreche, SPF_DEFAULT, NULL)
  ISpVoice_WaitUntilDone(voice, -1)
  ISpVoice_SetRate(voice,0)
  ISpVoice_Release(voice)
  CoUninitialize()
End Sub

Sub sag_uhrzeit ()
  Dim As String spreche
  If WaitForSingleObject(ISpVoice_SpeakCompleteEvent(voice), 0) Then Exit Sub
  spreche = "<pitch absmiddle="+Chr(34)+Str(-2)+Chr(34)+"/> " _
  "<context ID = "+Chr(34)+"time"+Chr(34)+">"+Time+"</context>"
  ISpVoice_Speak(voice, spreche, SPF_ASYNC, NULL)
End Sub

Sub sag_datum ()
  Dim As String spreche
  If WaitForSingleObject(ISpVoice_SpeakCompleteEvent(voice), 0) Then Exit Sub
  spreche =  "<pitch absmiddle="+Chr(34)+Str(-2)+Chr(34)+"/> " _
  "<context ID = "+Chr(34)+"date_mdy"+Chr(34)+">"+Date+"</context>"
  ISpVoice_Speak(voice, spreche, SPF_ASYNC, NULL)
End Sub


watch.bas

Code: Select all

#Include "voice.bas"
voice_ini
ISpVoice_SetRate(voice,-2)'langsamer sprechen

'--------------------------------------------------------------------------------------------
'Taschenuhr.bas by Volta
'erweitert zur Sprech_uhr.bas by Volta
Const pi = 3.141592654
Dim Shared As Integer breite, hoehe, radius, farbe=&hcfcf00
Dim As Single s, m, st

Sub Ziffernblatt (r As Integer, f As UInteger)
  Circle (breite\2, hoehe\2),r,f,,,1,F
End Sub

Sub Uhrzeiger2 (x As Single, r As Integer, f As UInteger)
  Line (breite\2, hoehe\2)-((breite\2)-(Sin(x)*r), (hoehe\2)-(Cos(x)*r)),f
End Sub

Sub Uhrzeiger (x As Single, r As Integer, z As Single)
  PSet (breite\2, hoehe\2),farbe
  Line -((breite\2)-(Sin(x-z)*r*.8), (hoehe\2)-(Cos(x-z)*r*.8)),farbe
  Line -((breite\2)-(Sin(x)*r), (hoehe\2)-(Cos(x)*r)),farbe
  Line -((breite\2)-(Sin(x+z)*r*.8), (hoehe\2)-(Cos(x+z)*r*.8)),farbe
  Line -(breite\2, hoehe\2),farbe
  Paint ((breite\2)-(Sin(x)*r*.8), (hoehe\2)-(Cos(x)*r*.8)),farbe+&h303000,farbe
  Line (breite\2, hoehe\2)-((breite\2)-(Sin(x)*r), (hoehe\2)-(Cos(x)*r)),farbe
End Sub


Screen 15,32,2,4 'Modus, Farbtiefe, Zahl_der_Seiten, Flags
WindowTitle "Speaking Watch"
ScreenInfo breite, hoehe
Width breite\8,hoehe\16 'Font_16 einstellen
radius = hoehe\2-10
Color ,&h6D2C00
Cls
SetMouse 1,1,0
ScreenSet 0, 1 'aktive_Seite, sichtbare_Seite

'zeichne Ziffernblatt auf Seite 0
Ziffernblatt radius, RGB(100,100,0)
For i As Integer = 1 To 60
  Uhrzeiger2  pi/-30*i, radius, -1
Next
Ziffernblatt radius-5, RGB(130,130,0)
For i As Integer = 1 To 12
  Uhrzeiger2  pi/-6*i, radius, -1
Next
Ziffernblatt radius-10, RGB(150,150,0)
For i As Integer = 1 To 12 'Ziffern
  Draw String   ((breite\2-7)-(Sin(pi/-6*i)*(radius-20)), _
  (hoehe\2-7)-(Cos(pi/-6*i)*(radius-20))), Right("  " & i, 2), 0
  Draw String   ((breite\2-8)-(Sin(pi/-6*i)*(radius-20)), _
  (hoehe\2-8)-(Cos(pi/-6*i)*(radius-20))), Right("  " & i, 2), -1
Next
Draw String (7, hoehe-60),"[t] Time",0
Draw String (5, hoehe-62),"[t] Time",-1
Draw String (7, hoehe-40),"[d] Date",0
Draw String (5, hoehe-42),"[d] Date",-1
Draw String (7, hoehe-20),"ESC = End",0
Draw String (5, hoehe-22),"ESC = End",-1

Dim ik As String
ScreenSet 1, 1 'setze aktive Seite 1
Do
  ScreenLock
  ScreenCopy 0, 1 'kopiere Seite 0 (Ziffernblatt) zu Seite 1

  'Sekundenzeiger zeichnen
  Uhrzeiger pi/-30*Val(Right(Time,2)), radius*.9, .03
  'Minutenzeiger zeichnen
  m = Val(Mid(Time,4,2))+(Val(Right(Time,2))/60)
  m *= (pi/-30)
  Uhrzeiger m, radius*0.75, .05
  'Stundenzeiger zeichnen
  st = Val(Left(Time,2)) + (Val(Mid(Time,4,2))/60)
  If st > 12 Then st -= 12
  st *= (pi/-6)
  Uhrzeiger st, radius*0.6, .08
  'Uhrzeit
  Draw String (breite\2-31, hoehe\2+31),Time,0
  Draw String (breite\2-32, hoehe\2+30),Time,-1

  ScreenUnLock
  ScreenSync
  Sleep 100,1
  ik=InKey
  If ik="d" Then sag_datum
  If ik="t" Then sag_uhrzeit
  If MultiKey (&h01) Or ik = Chr(255,107) Then Exit Do
Loop

voice_end

[KristopherWindsor]

Nice! ;-)
I wonder why I never saw that forum before? -(o.O); :-)

[rockeveryone21]

id like to see an example which has a windows gui that would be awesome
input text ,speak text from clipboard and speak text on click

[duke4e]

Sorry to bring this old thread, but is there a way to change the default voice or to choose from list of all available voice engines.

[vdecampo]

In Windows XP you can go to...

Control Panel->Speech->Tab(Text to Speech)

-Vince