vb实验报告

2009-2010学年度第二学期Vi s u a l B a s i c 6.0实习报告姓名：XX班级：XXXX学号：XXXXXXXXX指导教师：XX时间：XXXXXXXXXXXXXXX目录目录 ............................................................................................................................................. - 1 -一、实习目的和要求.......................................................................................................... - 2 -二、实验内容...................................................................................................................... - 2 -三、实验步骤（界面设计）.............................................................................................. - 2 -四、程序代码编写.............................................................................................................. - 5 -五、错误分析.................................................................................................................... - 11 -六、实习的心得体会........................................................................................................ - 11 -七、教师评语.................................................................................................................... - 13 -一、实习目的和要求a)通过上机实训，加深对VB6.0的认识，能够更加熟练对VB6.0进行一些操作，并编写出简单的Windows应用程序；b)掌握一些基本控件的事件和属性；c)掌握一些API函数的应用；d)能够运用自定义过程及其调用；e)模块的应用。

二、实验内容设计一个电子琴，当程序运行后，单击电子琴键或用鼠标在电子琴键上滑动，都可以产生音乐。

运行时，也可以选择具体的设备和乐器，并能以拖动滚动条来调节音量和音调。

双击窗体可退出程序。

三、实验步骤（界面设计）a)单击菜单栏中的“文件/新建工程”命令，这时会弹出“新建工程”对话框，如图1。

图 1b)选择窗体，设置窗体的几个属性：Caption改为“电子琴”，Boardstyle为“1-Fixed Single”。

c)单击工具箱中的工具按钮，在窗体中，按下鼠标左键进行拖动，并设置Caption属性为“设备与乐器”，BackColor 属性为黑色，ForeColor为白色。

d)单击工具箱中的工具按钮，在Frame1框架中添加2个下拉列表框，再向该框架中添加2个标签。

e)单击工具箱的工具按钮，在窗体中按下鼠标左键进行拖动，BackColor属性为黑色。

f)在Frame2框架中添加2个水平滚动条、3个标签。

g)单击工具箱中的工具按钮，在窗体中添加图片框数组，共65个元素，它们的名称为“Picture1”，Index属性分别为“1”、“2”、、、、、、“64”。

h)在窗体中添加2个计时器控件、1个标签，如图2所示。

i)添加模块。

单击菜单栏中的“工程/添加模块”命令，弹出“添加模块”对话框，如图3。

单击“打开”就可以创建一个模块。

图 2图 3四、程序代码编写a)模块中的代码如下：Option ExplicitPrivate Declare Function midiOutGetDevCaps Lib "winmm.dll" Alias "midiOutGetDevCapsA" (ByVal uDeviceID As Long, lpCaps As MIDIOUTCAPS, ByVal uSize As Long) As LongPrivate Declare Function midiOutGetNumDevs Lib "winmm" () As IntegerPrivate Declare Function MIDIOutOpen Lib "winmm.dll" Alias "midiOutOpen" (lphMidiOut As Long, ByVal uDeviceID As Long, ByVal dwCallback As Long, ByVal dwInstance As Long, ByVal dwFlags As Long) As LongPrivate Declare Function midiOutClose Lib "winmm.dll" (ByVal hMidiOut As Long) As LongPrivate Declare Function midiOutShortMsg Lib "winmm.dll" (ByVal hMidiOut As Long, ByVal dwMsg As Long) As LongPrivate Declare Function midiOutGetErrorText Lib "winmm.dll" Alias "midiOutGetErrorTextA" (ByVal err As Long, ByVal lpText As String, ByVal uSize As Long) As LongPrivate Const MAXERRORLENGTH = 128Private Const MIDIMAPPER = (-1)Private Const MIDI_MAPPER = (-1)Type MIDIOUTCAPSwMid As IntegerwPid As IntegervDriverVersion As LongszPname As String * 32wTechnology As IntegerwVoices As IntegerwNotes As IntegerwChannelMask As IntegerdwSupport As LongEnd TypeDim hMidi As LongPublic Function Midi_OutDevsToList(Obj As Control) As BooleanDim i As IntegerDim midicaps As MIDIOUTCAPSDim isAdd As BooleanObj.ClearisAdd = FalseIf midiOutGetDevCaps(MIDIMAPPER, midicaps, Len(midicaps)) = 0 Then Obj.AddItem midicaps.szPnameObj.ItemData(Obj.NewIndex) = MIDIMAPPERisAdd = TrueEnd IfFor i = 0 To midiOutGetNumDevs() - 1If midiOutGetDevCaps(i, midicaps, Len(midicaps)) = 0 ThenObj.AddItem midicaps.szPnameObj.ItemData(Obj.NewIndex) = iisAdd = TrueEnd IfNextMidi_OutDevsToList = isAddEnd FunctionPublic Function MIDI_OutOpen(ByVal dev_id As Integer) As IntegerDim midi_error As Integermidi_OutClosemidi_error = MIDIOutOpen(hMidi, dev_id, 0, 0, 0)If Not midi_error = 0 ThenCall midi_outerr(midi_error)End IfMIDI_OutOpen = (hMidi <> 0)End FunctionPublic Sub midi_OutClose()Dim midi_error As IntegerIf hMidi <> 0 Thenmidi_error = midiOutClose(hMidi)If Not midi_error = 0 ThenCall midi_outerr(midi_error)End IfhMidi = 0End IfEnd SubPublic Sub note_on(ch As Integer, ByVal kk As Integer, v As Integer) Call midi_outshort(&H90 + ch, kk, v)End SubPublic Sub note_off(ch As Integer, ByVal kk As Integer)Call midi_outshort(&H80 + ch, kk, 0)End SubSub midi_outshort(b1 As Integer, b2 As Integer, b3 As Integer)Dim midi_error As Integermidi_error = midiOutShortMsg(hMidi, b3 * &H10000 + b2 * &H100 + b1)If Not midi_error = 0 ThenCall midi_outerr(midi_error)End IfEnd SubSub program_change(ch As Integer, cc0nr As Integer, ByVal pnr As Integer) Call control_change(ch, 0, cc0nr)Call midi_outshort(&HC0 + ch, pnr, 0)End SubSub control_change(ch As Integer, ccnr As Integer, ByVal v As Integer)Call midi_outshort(&HB0 + ch, ccnr, v)End SubSub midisetrpn(ch As Integer, pmsb As Integer, plsb As Integer, msb As Integer, lsb As Integer)Call midi_outshort(ch, &H65, pmsb)Call midi_outshort(ch, &H64, plsb)Call midi_outshort(ch, &H6, msb)Call midi_outshort(ch, &H26, lsb)End SubSub midi_outerr(ByVal midi_error As Integer)Dim s As StringDim x As Integers = Space(MAXERRORLENGTH)x = midiOutGetErrorText(midi_error, s, MAXERRORLENGTH)MsgBox sEnd Subb)窗体中的代码：Option ExplicitPrivate Declare Function GetKeyState% Lib "user32" (ByVal nVirtKey As Long)Private sudu As IntegerPrivate Const VK_LBUTTON& = &H1Private isOgain As BooleanPrivate Sta As IntegerPrivate Sub ComDevies_Click()Dim dl As Integerdl = MIDI_OutOpen(ComDevies.ItemData(ComDevies.ListIndex)) End SubPrivate Sub Command1_Click()Unload MeEnd SubPrivate Sub Command2_Click()Open App.Path & "\haap.txt" For Input As #1ComDevies.ListIndex = 0ComSounds.ListIndex = 9HScroll1.Value = 32Timer2.Enabled = TrueCommand2.Enabled = FalseEnd SubPrivate Sub ComSounds_Click()Call program_change(0, 0, ComSounds.ListIndex)End SubPrivate Sub Form_Load()Dim Retu As BooleanDim i As IntegerRetu = Midi_OutDevsToList(ComDevies)ComDevies.ListIndex = 0Call fill_sound_listFor i = 0 To 64Picture1(i).DragMode = 1NextHScroll1.Value = 36HScroll2.Value = 127End SubPrivate Sub fill_sound_list()Dim s As StringOpen App.Path & "\genmidi.txt" For Input As #1Do While Not EOF(1)Line Input #1, sComSounds.AddItem sLoopComSounds.ListIndex = 0Close #1End SubPrivate Sub Form_Unload(Cancel As Integer)midi_OutCloseEndEnd SubPrivate Sub HScroll1_Change()Sta = HScroll1.ValueLabel2.Caption = Diao(Sta Mod 12)End SubPrivate Sub HScroll2_Change()sudu = HScroll2.V alueEnd SubPrivate Sub HScroll3_Change()Label6.Caption = HScroll3.ValueEnd SubPrivate Sub Label1_MouseMove(Button As Integer, Shift As Integer, x As Single, Y As Single)Dim i As IntegerFor i = 0 To 64Call note_off(0, i + Sta)NextEnd SubPrivate Sub mnu_Close_Click()Unload MeEnd SubPrivate Sub Picture1_DragOver(Index As Integer, Source As Control, x As Single, Y As Single, State As Integer)Static OldNote As IntegerIf (OldNote <> Index) Or (isOgain = True) ThenCall note_off(0, OldNote + Sta)Call note_on(0, Index + Sta, sudu)OldNote = IndexisOgain = FalseEnd IfEnd SubPrivate Sub Timer1_Timer()Dim MyKey As IntegerMyKey% = GetKeyState(VK_LBUTTON)If MyKey% And &H4000 ThenisOgain = FalseElseisOgain = TrueEnd IfEnd SubPrivate Sub Timer2_Timer()Dim s As StringDim Index As IntegerLine Input #1, ss = Trim(s)If s = "End" ThenClose #1Timer2.Enabled = FalseCommand2.Enabled = TrueLabel1_MouseMove 0, 0, 1, 1Exit SubEnd IfIndex = Val(s)If Index < 100 ThenIndex = Index + 7Picture1_DragOver Index, Picture1(Index), 1, 1, 1Index = Index + 24Picture1_DragOver Index, Picture1(Index), 1, 1, 1 End IfisOgain = TrueEnd SubPrivate Function Diao(i As Integer) As StringSelect Case iCase 0Diao = "C"Case 1Diao = "C#"Case 2Diao = "D"Case 3Diao = "D#"Case 4Diao = "E"Case 5Diao = "F"Case 6Diao = "F#"Case 7Diao = "G"Case 8Diao = "G#"Case 9Diao = "A"Case 10Diao = "A#"Case 11Diao = "B"End SelectEnd Function五、错误分析在编程过程中最容易错的地方往往是一些不起眼的细节。