DP Tool Club 16

home *** CD-ROM | disk | FTP | other *** search

/ DP Tool Club 16 / CD_ASCQ_16_0994.iso / news / 4609 / wavplus / mciwav.frm (.txt) < prev next >

Wrap

Visual Basic Form | 1994-06-28 | 27.0 KB | 869 lines

VERSION 2.00 Begin Form MCIwav BackColor = &H00C0C0C0& BorderStyle = 3 'Fixed Double Caption = "MCI WAV Player" ClientHeight = 6225 ClientLeft = 1200 ClientTop = 795 ClientWidth = 4470 ControlBox = 0 'False Height = 6630 Left = 1140 LinkTopic = "Form1" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 6225 ScaleWidth = 4470 Top = 450 Width = 4590 Begin CommandButton CmdEraseToEnd BackColor = &H00C0C0C0& Caption = "Erase ->" Height = 375 Left = 240 TabIndex = 9 Top = 5640 Width = 1335 End Begin CommandButton CmdEraseToStart BackColor = &H00C0C0C0& Caption = "<- Erase" Height = 375 Left = 240 TabIndex = 8 Top = 5280 Width = 1335 End Begin CommandButton CmdEraseAll BackColor = &H00C0C0C0& Caption = "Erase All" Height = 375 Left = 240 TabIndex = 7 Top = 4920 Width = 1335 End Begin CommandButton CmdUndo BackColor = &H00C0C0C0& Caption = "Undo" Height = 375 Left = 2880 TabIndex = 13 Top = 4920 Width = 1335 End Begin CommandButton CmdSave BackColor = &H00C0C0C0& Caption = "Save Wav" Height = 375 Left = 2880 TabIndex = 15 Top = 5640 Width = 1335 End Begin CommandButton CmdAddToStart BackColor = &H00C0C0C0& Caption = "Add To Start" Height = 375 Left = 1560 TabIndex = 11 Top = 5280 Width = 1335 End Begin CommandButton CmdNewWav BackColor = &H00C0C0C0& Caption = "Begin New" Height = 375 Left = 2880 TabIndex = 14 Top = 5280 Width = 1335 End Begin CommandButton CmdAddToEnd BackColor = &H00C0C0C0& Caption = "Add To End" Height = 375 Left = 1560 TabIndex = 12 Top = 5640 Width = 1335 End Begin CommandButton CmdInsertAt BackColor = &H00C0C0C0& Caption = "Insert At" Height = 375 Left = 1560 TabIndex = 10 Top = 4920 Width = 1335 End Begin Timer Timer1 Interval = 50 Left = 120 Top = 960 End Begin CommandButton CmdStop BackColor = &H00C0C0C0& Caption = "&Stop" Height = 375 Left = 2880 TabIndex = 4 Top = 3480 Width = 1335 End Begin CommandButton CmdToEnd BackColor = &H00C0C0C0& Caption = "To &End" Height = 375 Left = 1560 TabIndex = 3 Top = 3840 Width = 1335 End Begin CommandButton CmdToStart BackColor = &H00C0C0C0& Caption = "To S&tart" Height = 375 Left = 1560 TabIndex = 2 Top = 3480 Width = 1335 End Begin CommandButton CmdPause BackColor = &H00C0C0C0& Caption = "P&ause" Height = 375 Left = 240 TabIndex = 1 Top = 3840 Width = 1335 End Begin CommandButton CmdPlay BackColor = &H00C0C0C0& Caption = "&Play" Height = 375 Left = 240 TabIndex = 0 Top = 3480 Width = 1335 End Begin HScrollBar HScroll1 Height = 255 LargeChange = 10 Left = 240 TabIndex = 6 Top = 3000 Width = 3975 End Begin CommandButton CmdOkay BackColor = &H00C0C0C0& Cancel = -1 'True Caption = "O &K A Y" Height = 375 Left = 2880 TabIndex = 5 Top = 3840 Width = 1335 End Begin Label Label4 Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "WAV Record Options:" Height = 200 Left = 240 TabIndex = 33 Top = 4560 Width = 3975 End Begin Line Line1 BorderWidth = 2 X1 = 240 X2 = 4200 Y1 = 4440 Y2 = 4440 End Begin Label Label7 BackColor = &H00C0C0C0& Caption = "Label7" Height = 195 Index = 6 Left = 2400 TabIndex = 32 Top = 1680 Width = 1815 End Begin Label Label6 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "WAV Length (bytes):" Height = 195 Index = 6 Left = 240 TabIndex = 31 Top = 1680 Width = 1935 End Begin Label Label7 BackColor = &H00C0C0C0& Caption = "Label7" ForeColor = &H00000080& Height = 195 Index = 5 Left = 2400 TabIndex = 30 Top = 2520 Width = 1815 End Begin Label Label6 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Percent Played:" ForeColor = &H00000080& Height = 195 Index = 5 Left = 240 TabIndex = 29 Top = 2520 Width = 1935 End Begin Label Label7 BackColor = &H00C0C0C0& Caption = "Label7" ForeColor = &H00000080& Height = 195 Index = 4 Left = 2400 TabIndex = 19 Top = 2280 Width = 1815 End Begin Label Label7 BackColor = &H00C0C0C0& Caption = "Label7" Height = 195 Index = 3 Left = 2400 TabIndex = 20 Top = 1920 Width = 1815 End Begin Label Label7 BackColor = &H00C0C0C0& BackStyle = 0 'Transparent Caption = "Label7" Height = 195 Index = 2 Left = 2400 TabIndex = 28 Top = 1440 Width = 1815 End Begin Label Label7 BackColor = &H00C0C0C0& BackStyle = 0 'Transparent Caption = "Label7" Height = 195 Index = 1 Left = 2400 TabIndex = 27 Top = 1200 Width = 1815 End Begin Label Label7 BackColor = &H00C0C0C0& BackStyle = 0 'Transparent Caption = "Label7" Height = 195 Index = 0 Left = 2400 TabIndex = 26 Top = 960 Width = 1815 End Begin Label Label6 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "Current Position (ms):" ForeColor = &H00000080& Height = 195 Index = 4 Left = 240 TabIndex = 25 Top = 2280 Width = 1935 End Begin Label Label6 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "WAV Length (ms):" Height = 195 Index = 3 Left = 240 TabIndex = 24 Top = 1920 Width = 1935 End Begin Label Label6 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Sample Rate:" Height = 195 Index = 2 Left = 240 TabIndex = 23 Top = 1440 Width = 1935 End Begin Label Label6 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Channels:" Height = 195 Index = 1 Left = 240 TabIndex = 22 Top = 1200 Width = 1935 End Begin Label Label6 Alignment = 1 'Right Justify BackStyle = 0 'Transparent Caption = "Bit Size:" Height = 195 Index = 0 Left = 240 TabIndex = 21 Top = 960 Width = 1935 End Begin Label Label3 BackColor = &H00C0C0C0& Caption = "Label3" ForeColor = &H00800000& Height = 195 Left = 2400 TabIndex = 18 Top = 600 Width = 1815 End Begin Label Label2 Alignment = 1 'Right Justify BackColor = &H00C0C0C0& Caption = "WAV mode:" ForeColor = &H00800000& Height = 195 Left = 240 TabIndex = 17 Top = 600 Width = 1935 End Begin Label Label1 Alignment = 2 'Center BackColor = &H00C0C0C0& Caption = "Label1" Height = 195 Left = 240 TabIndex = 16 Top = 240 Width = 3975 End Dim nl As String Dim Recorded As Integer Dim FirstNew As Integer Dim FirstTime As Integer Sub CmdAddToEnd_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will begin inserting the" + nl msg$ = msg$ + "recording at the END of the file!" response = MsgBox(msg$, 33, "Record Add To End") If response = 2 Then Exit Sub CmdToEnd_Click CmdAddToEnd.Enabled = False CmdInsertAt.Enabled = False CmdNewWav.Enabled = False CmdOkay.Enabled = False CmdPause.Enabled = False CmdPlay.Enabled = False CmdAddToStart.Enabled = False CmdSave.Enabled = False CmdToEnd.Enabled = False CmdToStart.Enabled = False CmdEraseAll.Enabled = False CmdEraseToEnd.Enabled = False CmdEraseToStart.Enabled = False CmdUndo.Enabled = False HScroll1.Enabled = False Label6(4).Visible = False Label7(4).Visible = False Label6(5).Visible = False Label7(5).Visible = False Label6(3).ForeColor = QBColor(4) Label7(3).ForeColor = QBColor(4) Label6(6).ForeColor = QBColor(4) Label7(6).ForeColor = QBColor(4) Recorded = True Answer$ = Space$(255) WavRecord Answer$ If Left$(Answer$, 1) <> Chr$(0) Then MsgBox "Incompatible file format!", 16, "File Error" Recorded = False CmdStop_Click End If End Sub Sub CmdAddToStart_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will begin inserting the" + nl msg$ = msg$ + "recording at the START of the file!" response = MsgBox(msg$, 33, "Record Add To Start") If response = 2 Then Exit Sub CmdToStart_Click CmdAddToEnd.Enabled = False CmdInsertAt.Enabled = False CmdNewWav.Enabled = False CmdOkay.Enabled = False CmdPause.Enabled = False CmdPlay.Enabled = False CmdAddToStart.Enabled = False CmdSave.Enabled = False CmdToEnd.Enabled = False CmdToStart.Enabled = False CmdEraseAll.Enabled = False CmdEraseToEnd.Enabled = False CmdEraseToStart.Enabled = False CmdUndo.Enabled = False HScroll1.Enabled = False Label6(4).Visible = False Label7(4).Visible = False Label6(5).Visible = False Label7(5).Visible = False Label6(3).ForeColor = QBColor(4) Label7(3).ForeColor = QBColor(4) Label6(6).ForeColor = QBColor(4) Label7(6).ForeColor = QBColor(4) Recorded = True Answer$ = Space$(255) WavRecord Answer$ If Left$(Answer$, 1) <> Chr$(0) Then MsgBox "Incompatible file format!", 16, "File Error" Recorded = False CmdStop_Click End If End Sub Sub CmdEraseAll_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will ERASE the" + nl msg$ = msg$ + "entire Wav file contents!" response = MsgBox(msg$, 33, "Erase All") If response = 2 Then Exit Sub Recorded = True Screen.MousePointer = 11 Answer$ = Space$(255) WavEraseAll Answer$ CmdStop_Click Screen.MousePointer = 0 End Sub Sub CmdEraseToEnd_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will ERASE the Wav file from" + nl msg$ = msg$ + "the current position to the END of the file!" response = MsgBox(msg$, 33, "Erase To End") If response = 2 Then Exit Sub Recorded = True Screen.MousePointer = 11 Answer$ = Space$(255) WavStatusPosition Answer$ SecStart$ = Trim$(Str$(Val(Answer$))) Answer$ = Space$(255) WavStatusLengthMS Answer$ SecEnd$ = Trim$(Str$(Val(Answer$))) Answer$ = Space$(255) WavEraseSection SecStart$, SecEnd$, Answer$ CmdStop_Click Screen.MousePointer = 0 End Sub Sub CmdEraseToStart_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will ERASE the Wav file from" + nl msg$ = msg$ + "the current position to the START of the file!" response = MsgBox(msg$, 33, "Erase To Start") If response = 2 Then Exit Sub Recorded = True Screen.MousePointer = 11 SecStart$ = "0" Answer$ = Space$(255) WavStatusPosition Answer$ SecEnd$ = Trim$(Str$(Val(Answer$))) Answer$ = Space$(255) WavEraseSection SecStart$, SecEnd$, Answer$ CmdStop_Click Screen.MousePointer = 0 End Sub Sub CmdInsertAt_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If msg$ = "This option will begin inserting the" + nl msg$ = msg$ + "recording at the CURRENT POSITION!" response = MsgBox(msg$, 33, "Record Insert At") If response = 2 Then Exit Sub CmdAddToEnd.Enabled = False CmdInsertAt.Enabled = False CmdNewWav.Enabled = False CmdOkay.Enabled = False CmdPause.Enabled = False CmdPlay.Enabled = False CmdAddToStart.Enabled = False CmdSave.Enabled = False CmdToEnd.Enabled = False CmdToStart.Enabled = False CmdEraseAll.Enabled = False CmdEraseToEnd.Enabled = False CmdEraseToStart.Enabled = False CmdUndo.Enabled = False HScroll1.Enabled = False Label6(4).Visible = False Label7(4).Visible = False Label6(5).Visible = False Label7(5).Visible = False Label6(3).ForeColor = QBColor(4) Label7(3).ForeColor = QBColor(4) Label6(6).ForeColor = QBColor(4) Label7(6).ForeColor = QBColor(4) Recorded = True Answer$ = Space$(255) WavRecord Answer$ If Left$(Answer$, 1) <> Chr$(0) Then MsgBox "Incompatible file format!", 16, "File Error" Recorded = False CmdStop_Click End If End Sub Sub CmdNewWav_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If If Recorded = True Then msg$ = "The Wav file changes have not been" + nl msg$ = msg$ + "saved. Do you want to save now?" response = MsgBox(msg$, 36, "Exit WAV Storage Warning") If response = 6 Then Exit Sub End If msg$ = "This option will create a new Wav file." + nl msg$ = msg$ + "You may record after entering a name." response = MsgBox(msg$, 33, "Begin New") If response = 2 Then Exit Sub Screen.MousePointer = 11 WavName.Show 1 If FormPassString2 = "" Then Exit Sub Screen.MousePointer = 11 Me.Refresh FormPassString = FormPassString2 Answer$ = Space$(255) WavClose Answer$ Answer$ = Space$(255) WavOpenNew Answer$ Answer$ = Space$(255) lpValue$ = "8" WavSetBitSize lpValue$, Answer$ Answer$ = Space$(255) lpValue$ = "1" WavSetChannels lpValue$, Answer$ Answer$ = Space$(255) lpValue$ = "11025" WavSetSampleRate lpValue$, Answer$ Answer$ = Space$(255) WavStatusBitSize Answer$ Label7(0).Caption = Answer$ Answer$ = Space$(255) WavStatusChannels Answer$ If Val(Answer$) = 1 Then Answer$ = "mono" Else Answer$ = "stereo" End If Label7(1).Caption = Answer$ Answer$ = Space$(255) WavStatusSampleRate Answer$ Label7(2).Caption = Format$(Val(Answer$), "###,##0") + " Hz" Answer$ = Space$(255) WavStatusLengthMS Answer$ Label7(3).Caption = Format$(Val(Answer$), "###,##0") + " ms" Answer$ = Space$(255) WavStatusLengthBytes Answer$ Label7(6).Caption = Format$(Val(Answer$), "###,##0") + " bytes" TempName$ = FormPassString RevString TempName$ pos% = InStr(TempName$, "\") TempName$ = Left$(TempName$, pos% - 1) RevString TempName$ Label1.Caption = UCase$(TempName$) CmdStop_Click Screen.MousePointer = 0 Recorded = True FirstNew = True End Sub Sub CmdOkay_Click () Answer$ = Space$(255) WavClose Answer$ Unload Me End Sub Sub CmdPause_Click () Answer$ = Space$(255) WavPause Answer$ End Sub Sub CmdPlay_Click () Answer$ = Space$(255) WavStatusLengthMS Answer$ MSlength% = Val(Answer$) If MSlength% = 0 Then MsgBox "The Wav file is empty!", 16, "User Error" Exit Sub End If Answer$ = Space$(255) WavStart Answer$ If Left$(Answer$, 1) <> Chr$(0) Then MsgBox "Incompatible file format!", 16, "File Error" End If End Sub Sub CmdSave_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If If Recorded = False Then MsgBox "No changes to save!", 16, "User Error" Exit Sub End If Answer$ = Space$(255) WavStatusLengthMS Answer$ MSlength% = Val(Answer$) If MSlength% = 0 Then MsgBox "Can not save an empty file!", 16, "User Error" Exit Sub End If Screen.MousePointer = 11 Answer$ = Space$(255) WavSave FormPassString, Answer$ If FirstNew = True Then FirstNew = False Else Answer$ = Space$(255) WavSave FormPassString, Answer$ End If Recorded = False WavPlay.File1.Pattern = "abcdefgh.zyx" WavPlay.File1.Pattern = "*.WAV" Screen.MousePointer = 0 End Sub Sub CmdStop_Click () Answer$ = Space$(255) WavStop Answer$ Answer$ = Space$(255) WavStatusLengthMS Answer$ Label7(3).Caption = Format$(Val(Answer$), "###,##0") + " ms" HScroll1.Max = Val(Answer$) Answer$ = Space$(255) WavStatusLengthBytes Answer$ Label7(6).Caption = Format$(Val(Answer$), "###,##0") + " bytes" CmdAddToEnd.Enabled = True CmdInsertAt.Enabled = True CmdNewWav.Enabled = True CmdOkay.Enabled = True CmdPause.Enabled = True CmdPlay.Enabled = True CmdAddToStart.Enabled = True CmdSave.Enabled = True CmdToEnd.Enabled = True CmdToStart.Enabled = True CmdEraseAll.Enabled = True CmdEraseToEnd.Enabled = True CmdEraseToStart.Enabled = True CmdUndo.Enabled = True HScroll1.Enabled = True Label6(4).Visible = True Label7(4).Visible = True Label6(5).Visible = True Label7(5).Visible = True Label6(3).ForeColor = QBColor(0) Label7(3).ForeColor = QBColor(0) Label6(6).ForeColor = QBColor(0) Label7(6).ForeColor = QBColor(0) Answer$ = Space$(255) WavSeekStart Answer$ Answer$ = Space$(255) WavStatusPosition Answer$ position% = Val(Answer$) Label7(4).Caption = Format$(position%, "###,##0") + " ms" DoPercent HScroll1.Value = position% End Sub Sub CmdToEnd_Click () Answer$ = Space$(255) WavSeekEnd Answer$ HScroll1.Value = HScroll1.Max End Sub Sub CmdToStart_Click () Answer$ = Space$(255) WavSeekStart Answer$ HScroll1.Value = 0 End Sub Sub CmdUndo_Click () If HowManyWavRecordDevices() = 0 Then MsgBox "Sound card can not record!", 16, "Device Error" Exit Sub End If If Recorded = False Then MsgBox "No changes to undo!", 16, "User Error" Exit Sub End If response = MsgBox("Really undo changes?", 36, "Undo Warning") If response = 7 Then Exit Sub Screen.MousePointer = 11 Answer$ = Space$(255) WavClose Answer$ Answer$ = Space$(255) WavOpen FormPassString, Answer$ Answer$ = Space$(255) WavStatusLengthMS Answer$ Label7(3).Caption = Format$(Val(Answer$), "###,##0") + " ms" Answer$ = Space$(255) WavStatusLengthBytes Answer$ Label7(6).Caption = Format$(Val(Answer$), "###,##0") + " bytes" Recorded = False CmdStop_Click Screen.MousePointer = 0 End Sub Sub DoPercent () If HScroll1.Max = 0 Then Percent$ = "0%" Else Answer$ = Space$(255) WavStatusPosition Answer$ position% = Val(Answer$) Percent$ = Format$(Int((position% / HScroll1.Max) * 100), "##0") + "%" End If Label7(5).Caption = Percent$ End Sub Sub Form_Load () FormCenterForm Me, WavPlay nl = Chr$(13) + Chr$(10) Recorded = False FirstNew = False FirstTime = True TempName$ = FormPassString RevString TempName$ pos% = InStr(TempName$, "\") TempName$ = Left$(TempName$, pos% - 1) RevString TempName$ Label1.Caption = UCase$(TempName$) Answer$ = Space$(255) WavOpen FormPassString, Answer$ Answer$ = Space$(255) WavStatusMode Answer$ Label3.Caption = UCase$(Answer$) Answer$ = Space$(255) WavStatusBitSize Answer$ Label7(0).Caption = Answer$ Answer$ = Space$(255) WavStatusChannels Answer$ If Val(Answer$) = 1 Then Answer$ = "mono" Else Answer$ = "stereo" End If Label7(1).Caption = Answer$ Answer$ = Space$(255) WavStatusSampleRate Answer$ Label7(2).Caption = Format$(Val(Answer$), "###,##0") + " Hz" Answer$ = Space$(255) WavStatusLengthMS Answer$ Label7(3).Caption = Format$(Val(Answer$), "###,##0") + " ms" HScroll1.Max = Val(Answer$) Answer$ = Space$(255) WavStatusLengthBytes Answer$ Label7(6).Caption = Format$(Val(Answer$), "###,##0") + " bytes" Answer$ = Space$(255) WavStatusPosition Answer$ Label7(4).Caption = Format$(Val(Answer$), "###,##0") + " ms" HScroll1.Value = Val(Answer$) DoPercent Screen.MousePointer = 0 End Sub Sub Form_Paint () DoForm3D Me, sunken, 3, 0 DoForm3D Me, raised, 1, 3 DoForm3D Me, sunken, 3, 0 DoForm3D Me, raised, 1, 3 DoControl3D Label1, sunken, 1 DoControl3D Label2, sunken, 1 DoControl3D Label3, sunken, 1 DoControl3D Label4, sunken, 1 For i = 3 To 6 DoControl3D Label6(i), sunken, 1 DoControl3D Label7(i), sunken, 1 Next End Sub Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer) If Recorded = True Then msg$ = "The Wav file changes have not been" + nl msg$ = msg$ + "saved. Do you want to save now?" response = MsgBox(msg$, 36, "Exit WAV Storage Warning") If response = 6 Then Cancel = True End If End Sub Sub HScroll1_Change () Answer$ = Space$(255) WavStatusMode Answer$ If Left$(Answer$, 7) <> "playing" Then Answer$ = Space$(255) NewValue$ = Trim$(Str$(HScroll1.Value)) WavSeekPosition NewValue$, Answer$ Answer$ = Space$(255) WavStatusPosition Answer$ position% = Val(Answer$) Label7(4).Caption = Format$(position%, "###,##0") + " ms" DoPercent End If End Sub Sub Timer1_Timer () Answer$ = Space$(255) WavStatusMode Answer$ Label3.Caption = UCase$(Answer$) If Left$(Answer$, 7) = "playing" Then Answer$ = Space$(255) WavStatusPosition Answer$ position% = Val(Answer$) Label7(4).Caption = Format$(position%, "###,##0") + " ms" DoPercent HScroll1.Value = position% End If If Left$(Answer$, 9) = "recording" Then Answer$ = Space$(255) WavStatusLengthMS Answer$ MSlength% = Val(Answer$) Label7(3).Caption = Format$(MSlength%, "###,##0") + " ms" Answer$ = Space$(255) WavStatusLengthBytes Answer$ Label7(6).Caption = Format$(Val(Answer$), "###,##0") + " bytes" If MSlength% = 60000 Then CmdStop_Click End If End Sub