wave.frm

一个VB编写的校园即时广播系统,具有简单的定时广播性能

VERSION 5.00
Object = "{C1A8AF28-1257-101B-8FB0-0020AF039CA3}#1.1#0"; "MCI32.OCX"
Begin VB.Form Wave 
   BorderStyle     =   4  'Fixed ToolWindow
   Caption         =   "语音发送"
   ClientHeight    =   1785
   ClientLeft      =   1410
   ClientTop       =   3885
   ClientWidth     =   2850
   LinkMode        =   1  'Source
   LinkTopic       =   "Form4"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1785
   ScaleWidth      =   2850
   ShowInTaskbar   =   0   'False
   Begin VB.Frame Frame1 
      ClipControls    =   0   'False
      Height          =   1305
      Left            =   75
      TabIndex        =   3
      Top             =   60
      Width           =   2610
      Begin VB.CommandButton Command2 
         Caption         =   "语音另存为"
         Height          =   300
         Left            =   1260
         TabIndex        =   12
         Top             =   1020
         Width           =   1380
      End
      Begin VB.CommandButton Command1 
         Caption         =   "发送已有文件"
         Height          =   300
         Left            =   -30
         TabIndex        =   11
         Top             =   1020
         Width           =   1335
      End
      Begin VB.CommandButton Command3 
         Caption         =   "发送◆"
         Enabled         =   0   'False
         Height          =   300
         Left            =   1935
         TabIndex        =   4
         ToolTipText     =   "按此键发送"
         Top             =   735
         Width           =   705
      End
      Begin VB.CommandButton Command5 
         Caption         =   "●"
         Height          =   300
         Left            =   1260
         Style           =   1  'Graphical
         TabIndex        =   5
         ToolTipText     =   "录音"
         Top             =   735
         UseMaskColor    =   -1  'True
         Width           =   705
      End
      Begin VB.CommandButton Command6 
         Enabled         =   0   'False
         Height          =   300
         Left            =   600
         Picture         =   "Wave.frx":0000
         Style           =   1  'Graphical
         TabIndex        =   6
         ToolTipText     =   "暂停"
         Top             =   735
         UseMaskColor    =   -1  'True
         Width           =   705
      End
      Begin VB.CommandButton Command4 
         Enabled         =   0   'False
         Height          =   300
         Left            =   -30
         Picture         =   "Wave.frx":0542
         Style           =   1  'Graphical
         TabIndex        =   7
         ToolTipText     =   "播放键"
         Top             =   735
         UseMaskColor    =   -1  'True
         Width           =   675
      End
      Begin VB.Label loge 
         AutoSize        =   -1  'True
         Caption         =   "0"
         Height          =   180
         Left            =   1935
         TabIndex        =   8
         Top             =   360
         Width           =   90
      End
      Begin VB.Label lSt 
         AutoSize        =   -1  'True
         Caption         =   "0"
         Height          =   180
         Left            =   855
         TabIndex        =   9
         Top             =   360
         Width           =   90
      End
      Begin VB.Label L1 
         AutoSize        =   -1  'True
         Caption         =   "录音时间:  秒 估计有       K"
         Height          =   180
         Left            =   45
         TabIndex        =   10
         Top             =   360
         Width           =   2520
      End
   End
   Begin VB.ComboBox Combo1 
      Height          =   300
      ItemData        =   "Wave.frx":0A84
      Left            =   975
      List            =   "Wave.frx":0A91
      TabIndex        =   1
      Text            =   "电话音质"
      Top             =   1470
      Width           =   1545
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   500
      Left            =   2655
      Top             =   1365
   End
   Begin MCI.MMControl mciWave 
      Height          =   330
      Left            =   -90
      TabIndex        =   0
      Top             =   5380
      Visible         =   0   'False
      Width           =   2340
      _ExtentX        =   4128
      _ExtentY        =   582
      _Version        =   327681
      BorderStyle     =   0
      BackVisible     =   0   'False
      StepVisible     =   0   'False
      EjectVisible    =   0   'False
      DeviceType      =   ""
      FileName        =   ""
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "录音品质:"
      Height          =   180
      Left            =   135
      TabIndex        =   2
      Top             =   1515
      Width           =   810
   End
End
Attribute VB_Name = "Wave"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function waveOutGetNumDevs Lib "winmm" () As Long

Private Type WaveSpec
RiffID           As String * 4
RiffLength       As Long
WavID            As String * 4
FmtID            As String * 4
FmtLength        As Long
wavformattag     As Integer
Channels         As Integer
SamplesPerSec    As Integer
BytesPerSec      As Integer
BlockAlign       As Integer
FmtSpecific      As Integer
Padding          As Long
DataID           As String * 4
DataLength       As Long
End Type
Const conInterval = 50
Const conIntervalPlus = 55
Const WavFile$ = "VbCode.wav"
Const FileSize = 52 'in bytes, correct if U use bigger example
Dim WaveSpec As WaveSpec
Dim Yz As Integer, Tempath As String
Dim PauseR As Boolean
Dim Rstime As Long

Private Sub iniSound()
Dim FreeFileNumber As Integer, SoundPath As String
SoundPath = Tempath & "\nc.wav"
Select Case Combo1.Text
Case "电话音质"
Yz = 11025
Case "CD音质"
Yz = -21436
Case "收音机音质"
Yz = 22050
End Select
WaveSpec.SamplesPerSec = Yz           '11025 22050 -21436(44100)
FreeFileNumber = FreeFile
If Dir(SoundPath, vbNormal) <> "" Then mciWave.Command = "Close": Kill SoundPath
Open SoundPath For Binary As FreeFileNumber
Put FreeFileNumber, , WaveSpec
xx$ = Chr$((Cos(1 * 0.0245) + 1) * 64 + 64)
Put FreeFileNumber, , xx$
Close FreeFileNumber
    mciWave.Command = "Close"
    mciWave.Wait = True
    mciWave.Filename = SoundPath
    mciWave.Command = "Open"
End Sub


Private Sub Combo1_Change()
Call iniSound
End Sub

Private Sub Command1_Click()
Dim OFName As OPENFILENAME
    With OFName
    .lStructSize = Len(OFName)
    .lpstrFile = Space$(254)
    .nMaxFile = 255
    .lpstrFilter = "Wave Files (*.wav)" + Chr$(0) + "*.txt" + Chr$(0)
    .lpstrFileTitle = Space$(254)
    .nMaxFileTitle = 255
    .lpstrTitle = "校园及时通--选择要发送的文件"
    End With
    If GetOpenFileName(OFName) Then
If Dir(Trim$(OFName.lpstrFile)) = "" Then
MsgBox "没有此文件"
Else
Form1.Comm = Trim$(OFName.lpstrFile)
Form1.SoundSend = True
Load Form2
End If
End If
End Sub

Private Sub Command2_Click()
Dim OFName As OPENFILENAME
    With OFName
    .lStructSize = Len(OFName)
    .lpstrFile = Space$(254)
    .lpstrFilter = "Wave Files (*.wav)" + Chr$(0) + "*.txt" + Chr$(0)
    .nMaxFile = 255
    .lpstrFileTitle = Space$(254)
    .nMaxFileTitle = 255
    .lpstrTitle = "校园及时通--另存为"
    End With
    If GetSaveFileName(OFName) Then
If Dir(Trim$(OFName.lpstrFile), vbNormal) <> "" Then Kill Trim$(OFName.lpstrFile)
mciWave.Filename = Trim$(OFName.lpstrFile)
mciWave.Command = "Save"
End If
End Sub

Private Sub Command3_Click()
On Error Resume Next
Form1.t1.SetFocus
Timer1.Enabled = False
Command5.Enabled = False
Command3.Enabled = False
Close
Kill (Tempath & "\RTmp")
Form1.Comm = Tempath & "\RTmp"
mciWave.Filename = Tempath & "\RTmp"
mciWave.Command = "Save"
Form1.SoundSend = True
Load Form2
End Sub

Private Sub Command4_Click()
Form1.t1.SetFocus
Timer1.Enabled = False
mciWave_PrevClick (0)
mciWave.Command = "play"
End Sub

Private Sub Command5_Click()
Dim i As Long
i = waveOutGetNumDevs()
If i > 0 Then         ' There is at least one device.
iniSound
Combo1.Enabled = False
Command3.Enabled = True
Command4.Enabled = True
Command6.Enabled = True
mciWave.Command = "Close"
mciWave.Command = "open"
mciWave_PrevClick (0)
mciWave.Command = "Record"
Rstime = Timer()
Timer1.Enabled = True
Else
MsgBox "对不起,你没配置声卡", vbOKOnly + vbSystemModal
Unload Me
End If
End Sub

Private Sub Command6_Click()
On Error Resume Next
Timer1.Enabled = False
Form1.t1.SetFocus
If PauseR = False Then Timer1.Enabled = True Else Timer1.Enabled = False
mciWave_PauseClick (0)
mciWave.Command = "pause"
End Sub

Private Sub Form_Load()
On Error Resume Next
WaveSpec.RiffID = "RIFF"                 'must be "RIFF"
WaveSpec.RiffLength = FileSize - 8       'FileSize - 8
WaveSpec.WavID = "WAVE"                  'must be "WAVE"
WaveSpec.FmtID = "fmt "                  'must be "fmt "
WaveSpec.FmtLength = 16
WaveSpec.wavformattag = 1                '1=PCM
WaveSpec.Channels = 1                    '1=mono, 2=stereo
WaveSpec.BytesPerSec = 0
WaveSpec.BlockAlign = 11025
WaveSpec.FmtSpecific = 0
WaveSpec.Padding = 524289
WaveSpec.DataID = "data"                 'must be "data"
WaveSpec.DataLength = FileSize - 44      'FileSize - 44 'the header is 44 bytes
Tempath = Getwin(True)
Call iniSound
Form1.SSound.Enabled = False
Form1.Sfile.Enabled = False
Me.Show
Form1.Chang 1, "传送语音"
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Me.Visible = False
Unload Form2
With Form1
.Chang 0, "校园及时通-" & .Locateuser
.SSound.Enabled = True
.Sfile.Enabled = True
.SoundSend = False
End With
End Sub


Private Sub mciWave_PauseClick(Cancel As Integer)
On Error Resume Next
mciWave.UpdateInterval = 0
End Sub

Private Sub mciWave_PlayClick(Cancel As Integer)
On Error Resume Next
mciWave.UpdateInterval = conInterval
End Sub

Private Sub mciWave_PrevClick(Cancel As Integer)
On Error Resume Next
mciWave.UpdateInterval = 0
    mciWave.Command = "Prev"
End Sub

Private Sub mciWave_RecordClick(Cancel As Integer)
On Error Resume Next
mciWave.UpdateInterval = 0
    mciWave.RecordMode = 0
    mciWave.Command = "Record"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
Dim Size As Integer
Select Case Yz
Case 11025
Size = 11
Case 22050
Size = 23
Case -21436
Size = 50
End Select
lSt.Caption = Abs(Int(Timer() - Rstime))
loge.Caption = Abs(Int(Timer() - Rstime) * Size)
End Sub