📄 play.frm
字号:
VERSION 5.00
Object = "{90F3D7B3-92E7-44BA-B444-6A8E2A3BC375}#1.0#0"; "ACTSKIN4.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form play
BorderStyle = 3 'Fixed Dialog
Caption = "文本朗读精灵"
ClientHeight = 4350
ClientLeft = 45
ClientTop = 330
ClientWidth = 5685
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "play.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 4350
ScaleWidth = 5685
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "默认设置"
Height = 495
Left = 4410
TabIndex = 14
Top = 3690
Width = 1185
End
Begin ACTIVESKINLibCtl.Skin Skin1
Left = 5190
OleObjectBlob = "play.frx":08CA
Top = 1950
End
Begin MSComDlg.CommonDialog ComDlg
Left = 3960
Top = 1440
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.CommandButton Command1
Caption = "保存为WAV"
Height = 495
Left = 4410
TabIndex = 6
Top = 3060
Width = 1185
End
Begin VB.Frame Frame1
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 1935
Left = 60
TabIndex = 4
Top = 2340
Width = 4215
Begin VB.HScrollBar VolumeSldr
Height = 315
Left = 780
Max = 100
TabIndex = 13
Top = 1080
Value = 100
Width = 3315
End
Begin VB.HScrollBar RateSldr
Height = 315
Left = 780
Max = 10
Min = -10
TabIndex = 12
Top = 690
Width = 3315
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 315
Index = 0
Left = 150
OleObjectBlob = "play.frx":2AA5B
TabIndex = 8
Top = 240
Width = 645
End
Begin VB.ComboBox FormatCB
Height = 330
Left = 810
Style = 2 'Dropdown List
TabIndex = 7
Top = 1470
Width = 3300
End
Begin VB.ComboBox VoiceCB
Height = 330
ItemData = "play.frx":2AAB6
Left = 810
List = "play.frx":2AAB8
Style = 2 'Dropdown List
TabIndex = 5
Top = 240
Width = 3300
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 315
Index = 1
Left = 150
OleObjectBlob = "play.frx":2AABA
TabIndex = 9
Top = 660
Width = 645
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 315
Index = 2
Left = 150
OleObjectBlob = "play.frx":2AB15
TabIndex = 10
Top = 1050
Width = 645
End
Begin ACTIVESKINLibCtl.SkinLabel SkinLabel1
Height = 315
Index = 3
Left = 150
OleObjectBlob = "play.frx":2AB70
TabIndex = 11
Top = 1470
Width = 645
End
End
Begin VB.CommandButton SpeakBtn
Caption = "朗读"
Height = 495
Left = 4410
TabIndex = 3
Top = 2430
Width = 1185
End
Begin VB.CommandButton PauseBtn
Caption = "暂停"
Height = 435
Left = 5370
MaskColor = &H00808080&
TabIndex = 2
Top = 6120
Width = 1185
End
Begin VB.TextBox MainTxtBox
Appearance = 0 'Flat
BackColor = &H00EFEFEF&
BeginProperty Font
Name = "宋体"
Size = 9
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2175
HideSelection = 0 'False
Left = 60
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Top = 60
Width = 5535
End
Begin VB.CommandButton StopBtn
Caption = "停止"
Enabled = 0 'False
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 435
Left = 8130
TabIndex = 0
Top = 6480
Width = 1185
End
End
Attribute VB_Name = "play"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' 声明SAPI对象
Dim WithEvents voice As SpVoice
Attribute voice.VB_VarHelpID = -1
'朗读风格
Dim m_speakFlags As SpeechVoiceSpeakFlags
' 设置默认格式.
Const DefaultFmt = "22kHz 16Bit Mono"
Private isspeaking As Boolean
Private ispaused As Boolean
Private Sub Command1_Click()
'保存为WAV文件
ComDlg.CancelError = True
On Error GoTo ErrHandler
'设置对话框标题
ComDlg.DialogTitle = "保存到声音文件"
' Set filters
ComDlg.Filter = "所有文件(*.*)|*.*|声音文件(*.wav)|*.wav"
ComDlg.FilterIndex = 2
'显示保存对话框
ComDlg.ShowSave
Dim cpFileStream As New SpFileStream
' 设置输出格式为所选格式
cpFileStream.Format.Type = FormatCB.ItemData(FormatCB.ListIndex)
cpFileStream.Open ComDlg.filename, SSFMCreateForWrite, False
voice.AllowAudioOutputFormatChangesOnNextSet = False
Set voice.AudioOutputStream = cpFileStream
voice.Speak MainTxtBox.Text, m_speakFlags
voice.WaitUntilDone -1
cpFileStream.Close
Set cpFileStream = Nothing
MsgBox "WAV 文件成功保存!", vbOKOnly, "文件存盘"
Exit Sub
ErrHandler:
If Not cpFileStream Is Nothing Then
Set cpFileStream = Nothing
End If
End Sub
Private Sub Command2_Click()
On Error Resume Next
RateSldr.Value = 0
VolumeSldr.Value = 100
FormatCB.ListIndex = 0
VoiceCB.ListIndex = 0
Call VoiceCB_Click
Call RateSldr_Scroll
Call VolumeSldr_Scroll
Call FormatCB_Click
End Sub
Private Sub Form_Load()
On Error Resume Next
' Skin1.LoadSkin App.Path & "\SKIN\0.SK"
Skin1.ApplySkin Me.hwnd ' 创建语音对象
' MainTxtBox.SelText = "" 'This step is crucial!!! for undoing actions
' MainTxtBox.SelText = Clipboard.GetText(1)
Set voice = New SpVoice
Dim Token As ISpeechObjectToken
For Each Token In voice.GetVoices
VoiceCB.AddItem (Token.GetDescription())
Next
VoiceCB.ListIndex = 0
AddItemToFmtCB
' 设置速度与音量
RateSldr.Value = voice.Rate
VolumeSldr.Value = voice.Volume
'设置默认格式
FormatCB.ListIndex = 0
SetSpeakingState False, False
Exit Sub
End Sub
Private Sub Form_Unload(Cancel As Integer)
On Error Resume Next
Set voice = Nothing
End Sub
Private Sub FormatCB_Click()
On Error GoTo ErrHandler
voice.AllowAudioOutputFormatChangesOnNextSet = False
voice.AudioOutputStream.Format.Type = FormatCB.ItemData(FormatCB.ListIndex)
Set voice.AudioOutputStream = voice.AudioOutputStream
Exit Sub
ErrHandler:
MsgBox "设置格式错误: ", Err.Description
End Sub
Private Sub PauseBtn_Click()
On Error Resume Next
'暂停
Select Case PauseBtn.Caption
Case "暂停"
voice.Pause
SetSpeakingState isspeaking, True
Case "继续"
voice.Resume
SetSpeakingState isspeaking, False
End Select
End Sub
Private Sub RateSldr_Change()
voice.Rate = RateSldr.Value
End Sub
Private Sub RateSldr_Scroll()
voice.Rate = RateSldr.Value
End Sub
Private Sub SpeakBtn_Click()
MousePointer = vbHourglass
On Error GoTo ErrHandler
If MainTxtBox.Text = "" Then
MousePointer = vbDefault
Exit Sub
End If
If Not (ispaused And isspeaking) Then
voice.Speak MainTxtBox.Text, m_speakFlags
MousePointer = vbDefault
End If
If ispaused Then voice.Resume
MousePointer = vbDefault
SetSpeakingState True, False
Exit Sub
MousePointer = vbDefault
ErrHandler:
SetSpeakingState False, ispaused
MousePointer = vbDefault
End Sub
Private Sub StopBtn_Click()
'停止
On Error GoTo ErrHandler
voice.Speak vbNullString, SVSFPurgeBeforeSpeak
If ispaused Then voice.Resume
SetSpeakingState False, False
Exit Sub
ErrHandler:
End Sub
Private Sub VoiceCB_Click()
' 改变语言
Set voice.voice = voice.GetVoices().Item(VoiceCB.ListIndex)
End Sub
Private Sub VolumeSldr_Change()
voice.Volume = VolumeSldr.Value
End Sub
Private Sub VolumeSldr_Scroll()
'设置音量
voice.Volume = VolumeSldr.Value
End Sub
Private Sub AddFmts(ByRef name As String, ByVal fmt As SpeechAudioFormatType)
Dim index As String
index = FormatCB.ListCount
FormatCB.AddItem name, index
FormatCB.ItemData(index) = fmt
End Sub
Private Sub AddItemToFmtCB()
AddFmts "8kHz 8Bit Mono", SAFT8kHz16BitMono
AddFmts "8kHz 8Bit Stereo", SAFT8kHz8BitStereo
AddFmts "8kHz 16Bit Mono", SAFT8kHz16BitMono
AddFmts "8kHz 16Bit Stereo", SAFT8kHz16BitStereo
AddFmts "11kHz 8Bit Mono", SAFT11kHz8BitMono
AddFmts "11kHz 8Bit Stereo", SAFT11kHz8BitStereo
AddFmts "11kHz 16Bit Mono", SAFT11kHz16BitMono
AddFmts "11kHz 16Bit Stereo", SAFT11kHz16BitStereo
AddFmts "12kHz 8Bit Mono", SAFT12kHz8BitMono
AddFmts "12kHz 8Bit Stereo", SAFT12kHz8BitStereo
AddFmts "12kHz 16Bit Mono", SAFT12kHz16BitMono
AddFmts "12kHz 16Bit Stereo", SAFT12kHz16BitStereo
AddFmts "16kHz 8Bit Mono", SAFT16kHz8BitMono
AddFmts "16kHz 8Bit Stereo", SAFT16kHz8BitStereo
AddFmts "16kHz 16Bit Mono", SAFT16kHz16BitMono
AddFmts "16kHz 16Bit Stereo", SAFT16kHz16BitStereo
AddFmts "22kHz 8Bit Mono", SAFT22kHz8BitMono
AddFmts "22kHz 8Bit Stereo", SAFT22kHz8BitStereo
AddFmts "22kHz 16Bit Mono", SAFT22kHz16BitMono
AddFmts "22kHz 16Bit Stereo", SAFT22kHz16BitStereo
AddFmts "24kHz 8Bit Mono", SAFT24kHz8BitMono
AddFmts "24kHz 8Bit Stereo", SAFT24kHz8BitStereo
AddFmts "24kHz 16Bit Mono", SAFT24kHz16BitMono
AddFmts "24kHz 16Bit Stereo", SAFT24kHz16BitStereo
AddFmts "32kHz 8Bit Mono", SAFT32kHz8BitMono
AddFmts "32kHz 8Bit Stereo", SAFT32kHz8BitStereo
AddFmts "32kHz 16Bit Mono", SAFT32kHz16BitMono
AddFmts "32kHz 16Bit Stereo", SAFT32kHz16BitStereo
AddFmts "44kHz 8Bit Mono", SAFT44kHz8BitMono
AddFmts "44kHz 8Bit Stereo", SAFT44kHz8BitStereo
AddFmts "44kHz 16Bit Mono", SAFT44kHz16BitMono
AddFmts "44kHz 16Bit Stereo", SAFT44kHz16BitStereo
AddFmts "48kHz 8Bit Mono", SAFT48kHz8BitMono
AddFmts "48kHz 8Bit Stereo", SAFT48kHz8BitStereo
AddFmts "48kHz 16Bit Mono", SAFT48kHz16BitMono
AddFmts "48kHz 16Bit Stereo", SAFT48kHz16BitStereo
End Sub
Private Sub SetSpeakingState(ByVal bSpeaking As Boolean, ByVal bPaused As Boolean)
SpeakBtn.Enabled = True
StopBtn.Enabled = bSpeaking
' PauseBtn.Enabled = bSpeaking
If bPaused Then
PauseBtn.Caption = "继续"
Else
PauseBtn.Caption = "暂停"
End If
isspeaking = bSpeaking
ispaused = bPaused
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -