Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Multimedia

Mein PC spricht (Windows SAPI)

Lizenz:Erster Autor:Letzte Bearbeitung:
GPLRedakteurVolta 20.08.2008

Die voice.bi:

'under construction by Volta
'it is based on 'speech in freebasic' by Jim
'http://dbfinteractive.com/index.php?topic=1161.0

#Ifndef WIN_INCLUDEALL
#Define WIN_INCLUDEALL
#EndIf
#Include Once "windows.bi"

#Define SPF_DEFAULT  0
#Define SPF_ASYNC  1
#Define SPF_PURGEBEFORESPEAK  2
#Define SPF_IS_FILENAME  4
#Define SPF_IS_XML  8
#Define SPF_IS_NOT_XML  16
#Define SPF_PERSIST_XML  32
#Define SPF_NLP_SPEAK_PUNC  64
#Define SPF_NLP_MASK  64
#Define SPF_VOICE_MASK  127
#Define SPF_UNUSED_FLAGS  -128

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(ByVal As ISpVoice Ptr, ByVal pItemType As WString Ptr, ByVal lNumItems As Long, ByVal pulNumSkipped As ULong Ptr) 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_Skip(This,pItemType,lNumItems,pulNumSkipped)   (This)->lpVtbl -> Skip(This,pItemType,lNumItems,pulNumSkipped)
#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 ()
  ISpVoice_SetRate(voice,0)
  ISpVoice_Release(voice)
  CoUninitialize()
End Sub


'Wählt eine Stimmenimplementierung aus.<VOICE>[REQUIRED = string][OPTIONAL = string]
'Beispiele:
'<VOICE REQUIRED="NAME=Microsoft Mike">…</VOICE>
'<VOICE REQUIRED="NAME=Microsoft Mary">…</VOICE>
'<VOICE REQUIRED="NAME=Microsoft Sam">…</VOICE>
Function v_speaker(n As Integer) As String
  Select Case n
    Case 1
      Function = "<voice required="+Chr(34)+"Gender=Male"+Chr(34)+"> "
    Case 2
      Function = "<voice required="+Chr(34)+"NAME=Microsoft Mike"+Chr(34)+"> "
    Case 3
      Function = "<voice required="+Chr(34)+"NAME=Microsoft Mary"+Chr(34)+"> "
    Case 4
      Function = "<voice required="+Chr(34)+"NAME=Microsoft Sam"+Chr(34)+"> "
    Case 5
      Function = "<voice required="+Chr(34)+"NAME=LH Stefan"+Chr(34)+"> "
    Case 6
      Function = "<voice required="+Chr(34)+"NAME=LH Anna"+Chr(34)+"> "
    Case Else
      Function = "<voice required="+Chr(34)+"Gender=Female"+Chr(34)+"> "
  End Select
End Function

'Setzt die Sprachgeschwindigkeit <RATE>[SPEED = int][ABSSPEED = int ]
'Beispiele:
'<RATE SPEED="10">quickly spoken text</RATE>
'<RATE SPEED="-10">slowly spoken text</RATE>
Function v_speed(n As Integer) As String
  Function = "<rate absspeed="+Chr(34)+Str(n)+Chr(34)+"> "
End Function

'Setzt die Stimmhöhe.<PITCH>MIDDLE = string [ABSMIDDLE = string]
'Beispiele:
'<PITCH MIDDLE="10">high pitch</PITCH>
'<PITCH MIDDLE="-10">low pitch</PITCH>
Function v_pitch(n As Integer) As String
  Function = "<pitch absmiddle="+Chr(34)+Str(n)+Chr(34)+"> "
End Function


'Setzt die Lautstärke <VOLUME> LEVEL = int
'Beispiele:
'<VOLUME LEVEL="100">This is loud!</VOLUME>
'<VOLUME LEVEL="10">This is pretty soft!</VOLUME>
Function v_volumen(n As Integer) As String
  Function = "<volume level="+Chr(34)+Str(n)+Chr(34)+"> "
End Function


'gut verständlich mit den deutschen Stimmen LH Anna oder LH Stefan
'http://msdn2.microsoft.com/en-us/library/ms723629(VS.85).aspx
Function say_time (s As String = Time) As String
  Function = "<context ID = "+Chr(34)+"time"+Chr(34)+">"+s+"</context>"
End Function

Function say_date (s As String = Date) As String
  Function = "<context ID = "+Chr(34)+"date_mdy"+Chr(34)+">"+ s +"</context>"
End Function

Function say_number (n As Integer) As String
  Function = "<context ID = "+Chr(34)+"number_cardinal"+Chr(34)+">"+ Str(n) +"</context>"
End Function

Function say_decimal (n As Single) As String
  Function = "<context ID = "+Chr(34)+"number_decimal"+Chr(34)+">"+ Str(n) +"</context>"
End Function

Function say_price (s As String) As String
  Function = "<context ID = "+Chr(34)+"Currency"+Chr(34)+">"+ s +"</context>"
End Function

Function say_url (s As String) As String
  Function = "<context ID = "+Chr(34)+"web_url"+Chr(34)+"> "+ s +"</context>"
End Function

Sub say (s As String)
  If WaitForSingleObject(ISpVoice_SpeakCompleteEvent(voice), 0) Then Exit Sub
  ISpVoice_Speak(voice, s, SPF_ASYNC, NULL)
End Sub

Sub read_file (s As String)
  If WaitForSingleObject(ISpVoice_SpeakCompleteEvent(voice), 0) Then Exit Sub
  ISpVoice_Speak(voice, s, SPF_IS_FILENAME, NULL)
  ISpVoice_WaitUntilDone(voice, INFINITE)
End Sub

Ein Testprogramm sapi_test.bas:

#Include Once "voice.bi"

'Hilfsdefinitionen
#Define Frau say v_speaker(0)+
#Define Mann say v_speaker(1)+
#Define Mike say v_speaker(2)+
#Define Mary say v_speaker(3)+
#Define Sam  say v_speaker(4)+
#Define Steffan say v_speaker(5)+
#Define Anna say v_speaker(6)+
#Define warte ISpVoice_WaitUntilDone(voice, INFINITE)

voice_ini

say "under construction by Volta"
warte
Frau say_date
warte
Mann v_speed(-2) + v_pitch(+10) + say_time
warte
Mike v_speed(-2) + "ich bin ein Berliner"
warte
Mary say_price("$1031.40")
warte
'read_file("c:/FB0200b/sapi_test.bas")


'funktioniert nur mit den deutschen Stimmen
Steffan v_speed(-4) + __FB_SIGNATURE__
warte
Anna say_price("€31.40")
warte
Steffan say_url("w w w .freebasic-portal.d e")
warte

voice_end

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 20.08.2008 von RedakteurVolta angelegt.
  • Die aktuellste Version wurde am 20.08.2008 von RedakteurVolta gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen