VB实验设计报告.docVIP

VB实验报告1功能说明运行后出现如图所示画面打开文件，点击打开一个文件，弹出如图所示对话框，可以播放avi,mp3,rmvb等文件点击播放按钮，出现如图所示对话框，按功能调节例如，点击声音调节，可以调节声音，等。2源代码(只选取部分代码)Dialog3 Dim i As IntegerPrivate Sub Combo1_Click() Dim index As Integer File1.Pattern = Combo1.Text Select Case Combo1.ListIndex Case 0 Label2.Caption = 所有支持的媒体文件 Case 1 Label2.Caption = wav文件 Case 2 Label2.Caption = VCD视频 Case 3 Label2.Caption = 影音文件 Case 4 Label2.Caption = 所有文件 End SelectEnd SubPrivate Sub Command1_Click() On Error Resume Next Static t As Boolean Dim index As Integer t = Not t i = 0 Form1.MMControl1.DeviceType = MPEGVideo Form1.MMControl1.Command = Stop Form1.MMControl1.Command = Close index = File1.ListCount For x = 1 To 50 Unload Form1.meu(x) Next x If Text1.Text Then For x = 0 To 24 Form1.Label8(x).Enabled = False Next x For index = 0 To index - 1 If File1.Selected(index) Then /如果被选中则添加到曲目列表 Form1.meu(i).Checked = False i = i + 1 Load Form1.meu(i) Form1.Label8(i - 1).Enabled = True Form1.meu(i).Caption = Dir1.Path & & File1.List(index) End If Next index Form1.Label2.Caption = 总曲目数: & i Form1.meuPlayFile.Visible = True Form1.MMControl1.FileName = Form1.meu(1).Caption Form1.meu(1).Checked = True Form1.Label7.Caption = Super Player 9.0 正在播放： & Form1.MMControl1.FileName Form1.MMControl1.Command = Open Form1.MMControl1.Command = Play Form1.MMControl1.UpdateInterval = 1000 Form1.Slider1.Enabled = True Form1.meuPlayList.Visible = False Form1.meuCDQuMu.Visible = False Form1.meuMusic.Visible = False If Form1.MMControl1.Mode 526 Then MsgBox 未装声卡或驱动程序未正确安装或未加载, vbInformation + vbOKOnly, 提示 End If x = Drive1.Drive y = Dir1.Path Open App.Path & tempdir For Output As #1 有何用处，缺少为何无法写入 Print #1, Close #1 Open App.Path & tempdir For Output As #1 将打开的路径保存 Print #1, x Print #1, Print #1, y Close #1 Open App.Path & tempMusic.m3u For Output As #1 For x = 1 To 40 Print #1, Form1.meu(x).Caption If Form1.meu(x).Caption = Then Exit For Next x Close #1 Unload Form2 Unload MeElse DoEventsEnd IfEnd SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub Command3_Click() On Error Resume Next With Cmd1 .FileName = 播放列表 .DialogTitle = 另存为播放列表 .Filter = 播放列表(*.m3u)|*.m3u|All Files(*.*)|*.*| .CancelError = True .ShowSave If Err.Number = cdlCancel Then Dialog3.SetFocus Exit Sub End If Open Cmd1.FileName For Output As #1 If Text1.Text Then For index = 0 To File1.ListCount - 1 If File1.Selected(index) Then /如果被选中则添加到曲目列表 i = i + 1 Print #1, Dir1.Path & & File1.List(index) End If Next index End If Close #1 End With Dialog3.SetFocusEnd SubPrivate Sub Dir1_Change() File1.Path = Dir1.Path Label5.Caption = 文件夹： & Dir1.PathEnd SubPrivate Sub Drive1_Change() On Error GoTo errorlabel Dir1.Path = Drive1.Drive Label3.Caption = 驱动器： & Drive1.Drive Exit Suberrorlabel: MsgBox 设备可能未准备好，请准备好再试., vbExclamation, 提示End SubPrivate Sub File1_Click() Text1.Text = Text1.Text & & File1.FileNameEnd SubPrivate Sub File1_DblClick() On Error Resume Next For x = 2 To 50 Unload Form1.meu(x) Next x Form1.meuPlayFile.Visible = True With Form1.MMControl1 .Command = Close .FileName = Dir1.Path & & File1.FileName .Command = Open .Command = Play .UpdateInterval = 1000 End With Open App.Path & tempdir For Output As #1 有何用处，缺少为何无法写入 Print #1, Close #1 Open App.Path & tempdir For Output As #1 将打开的路径保存 Print #1, x Print #1, Print #1, y Close #1 Form1.meuPlayList.Visible = False Form1.meuCDQuMu.Visible = False Form1.meuMusic.Visible = False Form1.meu(1).Caption = Form1.MMControl1.FileName Unload Dialog3 Form1.Label7.Caption = Super Player 9.0 正在播放： & Form1.MMControl1.FileNameEnd SubPrivate Sub File1_KeyDown(KeyCode As Integer, Shift As Integer) If Shift = 2 And KeyCode = vbKeyA Then For index = 0 To File1.ListCount - 1 File1.Selected(index) = True Next index End IfEnd SubPrivate Sub File1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Command1_Click End IfEnd SubPrivate Sub File1_KeyUp(KeyCode As Integer, Shift As Integer) On Error Resume Next If Shift = 2 And KeyCode = vbKeyA Then For Index = 0 To File1.ListCount - 1 File1.Selected(Index) = True Next Index End IfEnd SubPrivate Sub Form_Load() On Error Resume Next Text1.Text = Label3.Caption = 驱动器： & Drive1.Drive Label5.Caption = 文件夹： & Dir1.Path File1.Pattern = *.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU Label2.Caption = 所有支持的媒体文件 /支持格式 Drive1.Drive = F: Dir1.Path = F: With Combo1 .Text = *.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU .AddItem *.Mp3;*.MPEG;*.mpg;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.DVD;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU .AddItem *.wav .AddItem *.Dat .AddItem *.Mpeg .AddItem *.* End With Open App.Path & tempdir For Input As #1 将上次打开的路径读入 Do While Not EOF(1) Line Input #1, nextline If nextline = Then Exit Sub 为空则退出 Else Seek #1, 0 Line Input #1, nextline Dir1.Path = nextline nextline = Seek #1, 1 Line Input #1, nextline Drive1.Drive = nextline End If Exit Sub Loop Close #1End SubDialog6Private Sub Command1_Click() On Error Resume Next Dim x As Integer x = Drive1.Drive y = Dir1.Path Open App.Path & tempdir For Output As #1 有何用处，缺少为何无法写入 Print #1, Close #1 Open App.Path & tempdir For Output As #1 将打开的路径保存 Print #1, x Print #1, y Close #1 For x = 0 To File1.ListCount - 1 If File1.Selected(x) = True Then Dialog9.List1.AddItem Dir1.Path & & File1.List(x) End If Next x Unload MeEnd SubPrivate Sub Command2_Click() Unload MeEnd SubPrivate Sub Dir1_Change() File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change() On Error GoTo errorlabel Dir1.Path = Drive1.Drive Exit Suberrorlabel: MsgBox 设备可能未准备好，请准备好再试., vbExclamation, 提示End SubPrivate Sub File1_KeyDown(KeyCode As Integer, Shift As Integer) Dim x As Integer x = 0 If Shift = 2 And KeyCode = vbKeyA Then For x = 0 To File1.ListCount - 1 File1.Selected(x) = True Next x End IfEnd SubPrivate Sub File1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Command1_Click End IfEnd SubPrivate Sub Form_Load() On Error Resume Next File1.Pattern = *.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mid;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU With Combo1 .Text = *.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU .AddItem *.Mp3;*.MPEG;*.avi;*.wav;*.DAT;*.WM;*.Wma;*.midi;*.mps;*.mp4;*.mpga;*.mp1;*.mp2;*.pls;*.xpl;*.AU .AddItem *.wav .AddItem *.Dat .AddItem *.Mpeg .AddItem *.* End With Open App.Path & tempdir For Input As #1 将上次打开的路径读入 On Error Resume Next Do While Not EOF(1) Line Input #1, nextline If nextline = Then Close #1 Exit Sub 为空则退出 Else Seek #1, 0 Line Input #1, nextline Dir1.Path = nextline nextline = Seek #1, 1 Line Input #1, nextline Drive1.Drive = nextline Exit Do End If Loop Close #1End SubDialog7Private Sub Command1_Click() On Error Resume Next List1.RemoveItem List1.ListIndex MsgBox 请在我的媒体库中删除该结点, vbOKOnly + vbExclamation, 提示 Form6.SetFocusEnd SubPrivate Sub Command2_Click() On Error Resume Next Dim nextline As String Dim i As Integer i = 0 Form6.List1.ClearFor i = 0 To List1.ListCount - 1 Form6.List1.AddItem List1.List(i)Next iOpen App.Path & temp & Form6.TreeView1.SelectedItem.Text & .m3u For Output As #4 For i = 0 To List1.ListCount - 1 Print #4, List1.List(i) Next iClose #4 Unload Me Set Dialog7 = NothingEnd SubPrivate Sub Command3_Click() Unload MeEnd SubPrivate Sub Command4_Click() MsgBox 请在我的媒体库中添加文件, vbOKOnly + vbInformation, 提示 Form6.SetFocusEnd SubPrivate Sub Form_Load() On Error Resume Next Dim Dir_1 As String Dim nextline As String Dir_1 = Dir(App.Path & temp & Form6.TreeView1.SelectedItem.Text & .m3u) If Dir_1 Then If FileLen(App.Path & temp & Form6.TreeView1.SelectedItem.Text & .m3u) 0 Then Open App.Path & temp & Form6.TreeView1.SelectedItem.Text & .m3u For Input As #1 List1.Clear Do While Not EOF(1) Line Input #1, nextline List1.AddItem nextline Loop Close #1 End If Else Exit Sub End IfEnd SubForm4Private Sub Command1_Click(index As Integer) Select Case index Case 0 Ric2.Move 2280, 720, 10575, 10215 Ric2.Top = 2280 Ric2.Left = 720 Ric2.Width = 10575 Ric2.Height = 10215 Ric2.SelStart = 0 Ric2.SelLength = Len(Ric2.Text) Ric2.SelFontName = 宋体 Ric2.SelFontSize = 15 Ric2.SelLength = 0 Case 1 Ric2.Move 4200, 1320, 7575, 9015 Ric2.Top = 4200 Ric2.Left = 1320 Ric2.Width = 7575 Ric2.Height = 9015 Ric2.SelStart = 0 Ric2.SelLength = Len(Ric2.Text) Ric2.SelFontName = 宋体 Ric2.SelFontSize = 9 Ric2.SelLength = 0 Case 2 MsgBox 此功能不可用, vbOKOnly + vbExclamation, 提示 Case 3 MsgBox 此功能不可用, vbOKOnly + vbExclamation, 提示 Case 4 Ric2.SelStart = 0 Ric2.SelLength = Len(Ric2.Text) Ric2.SelIndent = Ric2.SelIndent + 200 Ric2.SelLength = 0 Case 5 Ric2.SelStart = 0 Ric2.SelLength = Len(Ric2.Text) Ric2.SelIndent = Ric2.SelIndent - 200 Ric2.SelLength = 0 End SelectEnd SubPrivate Sub Form_Load() On Error Resume Next Label1.Top = 600 Label1.Left = 0 Label1.Height = Form4.Height - 600 Label1.Width = Form4.Width Ric2.Text = Form3.Ric.Text Ric2.SelStart = 0 Ric2.SelLength = Len(Ric2.Text) Ric2.SelIndent = 1000 Ric2.SelLength = 0 Ric2.Top = Label1.Top + 1000 Ric2.Left = Label1.Left + 2000End SubPrivate Sub Form_Resize() On Error Resume Next Label1.Height = Form4.Height - 600 Label1.Width = Form4.Width Form4.Width = Screen.Width Form4.Height = Screen.Height Ric2.Height = Form4.Height + 3000 Ric2.Width = Form4.Width + 1000End SubForm5Private Sub Form_Load() With Flash1 .Top = 0 .Left = 0 .Width = Form5.Width .Height = Form5.Height End With Flash1.ScaleMode = 1End SubPrivate Sub Form_Resize() On Error Resume Next Flash1.Width = Form5.Width Flash1.Height = Form5.HeightEnd SubPrivate Sub meuAbout_Click() Dialog4.ShowEnd SubPrivate Sub meuAll_Click() Form5.Top = 0 Form5.Left = 0 Form5.Width = Screen.Width Form5.Height = Screen.HeightEnd SubPrivate Sub meuExit_Click() Unload Form5End SubPrivate Sub meuOpen_Click() On Error Resume Next With CommonDialog2 .FileName = .DialogTitle = Flash文件 .Filter = Flash(*.swf)|*.swf|All Files(*.*)|*.*| .ShowOpen If Err.Number = cdlCancel Then Exit Sub Flash1.Movie = .FileName End With Flash1.Playing = TrueEnd SubPrivate Sub meuPlayer_Click() Flash1.Playing = TrueEnd SubPrivate Sub meuStop_Click() Flash1.StopEnd SubfrmFindOption Explicit Const conHwndTopmost = -1 API函数的 SetWindowsPos 函数的设置值 Const conHwndNoTopmost = -2 Const conSwpNoActivate = &H10 Const conSwpShowWindow = &H40 Dim x As Long Private Sub Command1_Click(index As Integer) Select Case index Case 0 Dim FoundPos As Integer Dim FoundLine As Integer Dim s As String 查找 TextBox 控件中指定的文本。 s = Trim(Text1.Text) Form3.SetFocus FoundPos = Form3.Ric.Find(s, 0, Len(Form3.Ric.Text), rtfWholeWord) 根据是否找到文本，显示相应的消息。 If FoundPos -1 Then 返回已找到文本所在行的行号。 FoundLine = Form3.Ric.GetLineFromChar(FoundPos) MsgBox Word found on line & CStr(FoundLi