VB实验报告.docx

1、VB实验报告Private Sub comdJj_Click() lblXh = lblXh + 1 累计商品顺序号 lblJz = Val(txtDj) * Val(txtSl) 计算商品价值 lblLjYsk = Val(lblLjYsk) + Val(lblJz) 累计商品总价值 txtDj = 0 单价清零 txtSl = 0 数量清零 txtDj.SetFocus 单价框获得焦点End SubPrivate Sub comdQl_Click() Ql 调用清零过程End SubPrivate Sub comdExit_Click() Unload Me 关闭窗体End SubPriv

2、ate Sub Form_Load() Ql 调用清零过程End Sub清零过程Private Sub Ql() txtDj = 0 txtSl = 0 lblJz = 0 lblXh = 1 lblLjYsk = 0End Sub表1-1窗体中控件属性值的设置对象类型属性设置值作用frmSpxsjj窗体Caption商品销售计价lblxh标签BorderStyle1显示商品顺序号txtDj文本框输入单价txtSl文本框输入数量lblJz标签BorderStyle1显示商品价值lblLjYsk标签BorderStyle1显示累计价值Label1标签CaptionAutoSize商品序号：Tru

3、eLabel2标签CaptionAutoSize单价（元）：TrueLabel3标签CaptionAutoSize数量：TrueLabel4标签CaptionAutoSize价值（元）：TrueLabel5标签CaptionAutoSize累计总价（元）：TruecomdJj命令按钮Caption计价启动计价计算comdQl命令按钮Caption清零下一轮计价准备comdExit命令按钮Caption退出退出程序 实验参考源代码 首先在模块的“通用”段声明变量： Dim v As Boolean 是否第1次按运算符 Dim s As Integer 存放上次按的运算符 Dim x As Dou

4、ble 存放第1个操作数 Dim y As Double 存放第2个操作数 编写数字类命令按钮组Command1 ( )的Click事件代码： Private Sub Command1 Click(Index As Integer) If Form1.Tag =T Then 向显示中的数追加新数 If Index 10 Then Text1 .Text”0” Else Textl.Text = Command1 (Index).Caption End If Form1.Tag” ” Else Textl.TextTextl.Text Command 1 (Index).Caption End

5、If End Sub编写运算符类命令按钮组Command2( )的Click事件代码： Private Sub Command2 Click(Index As Integer) Form1.TagT If v Then 第1次按运算符 x =Val(Text1.Text） 将键入的数存入、 vNot v Else yVal(Text1.Text) Select Case s Case 0 Textl.Textxy Case 1 Text1.Textx一y Case 2 Textl.Textx * y Case 3 If y0 Then Textl.Text =xy Else MsgBox (不

6、能以0为除数”：） Textl.Textx vFalse End If Case 4 Y0 vFalse End Select x=Val(Text1.Text) End If sIndex End Sub 实验参考源代码 首先编写自定义的Sub过程代码： Private Sub Delay（PauseTime） PauseTime为暂停时间 Dim Start StartTimer 设置开始暂停的时刻 Do While TimerStartPauseTime Loop End Sub 编写命令按钮Commandl的Click事件代码： Private Sub Commandl,ClickU

7、Cls Form1. FontSize16 设置字体大小 Print Forml.ForeColor=QBColor(9) 设置对象中文本或图形的前景色 Print Tab(4）；“暂停3秒钟” Print Delay (3) 暂停3秒 Form1.ForeColorQBColor(10) Print Tab(4）；“暂停5秒钟” Print Delay 5 暂停5秒 Forml.ForeColor=QBColor(12)Print Tab(4);“结束!” Print Delay (1） 暂停1秒 End Sub 为了在程序暂停时不致于使用户误认为“死机”了，可以在窗体的标题栏中显示剩余时间

8、。只需修改“延时”Sub过程代码： Private Sub Delay(PauseTime) StartTimer Do While Timer StartPauseTime m=StartPauseTime-Timer 计算剩余时间 m0=(m*10) Mod 10 剩余时间的1位小数 m=Int(m) 剩余秒数 Me.CaptionFormat(m, 0:” Format(m0, 0” ) Loop End Sub表2-3 frmJsq窗体中控件属性值设置对象类型属性设置值作用frmJsq窗体Caption计时器Timer1定时器EnabledIntervalFalse100计时lblTi

9、meSlice标签BorderStyle1显示时间comdStart命令按钮CaptionEnabled启动true启动计时comdPause命令按钮CaptionEnabled暂停False暂停计时comdContinue命令按钮CaptionEnabled 继续False继续计时comdStop命令按钮CaptionEnabled停止False停止计时Option ExplicitDim TimeStart, TimeSlice1 As Date, TimeSlice2 As DatePrivate Sub comdContinue_Click() StartTime comdContin

10、ue.Enabled = False comdPause.Enabled = TrueEnd SubPrivate Sub comdStop_Click() Timer1.Enabled = False lblTimeSlice = Format(0, Long Time) comdStop.Enabled = False comdPause.Enabled = False comdContinue.Enabled = False comdStart.Enabled = TrueEnd SubPrivate Sub comdStart_Click() TimeSlice1 = 0 StartT

11、ime comdStart.Enabled = False comdPause.Enabled = True comdStop.Enabled = TrueEnd SubPrivate Sub comdPause_Click() TimeSlice1 = TimeSlice2 Timer1.Enabled = False comdContinue.Enabled = True comdPause.Enabled = FalseEnd SubPrivate Sub Timer1_Timer() TimeSlice2 = Time - TimeStart + TimeSlice1 lblTimeS

12、lice = Format(TimeSlice2, Long Time)End SubPrivate Sub StartTime() TimeStart = Time Timer1.Enabled = TrueEnd Sub实验参考源代码： 编写窗体的Load事件代码： Private Sub Form_ Load( ) Filet.Pattern =”*.Txt” End Sub 编写驱动器列表框Drive1的Change事件代码： Private Sub Drivel_ Change( ) Dirt.Path=Drivel.Drive End Sub 编写目录列表框Dirl的Change事

13、件代码： Private Sub Dirl _Change( ) File1.Path = Dirt.Path Text2.Text = Dir1.Path End Sub 编写文件列表框Filel的Click事件代码： Private Sub Filel_ Ciick( ) Text2.TextFile1.Path & ” & File1.FileName End Sub 编写组合框Combo1的Click事件代码： Private Sub Combo1_ Click( ) aa = Combo1.List(Combo1.ListIndex) File1.Patternaa End Sub

14、编写命令按钮控件数组Command 1的Click事件代码： Private Sub Command1_Click(Index As Integer) Select Case Index Case 0 If Text2.Text ” Then Open Text2.Text For Output As #1 Print # 1，Text1.Text Close #1 End If Case1 If Text2.Text ” Then Text l.Text =”Open Text2.Text For Input As #1 b =” Do Until EOF(1) Line Input #1，

15、nextline b=b & nextline & Chr(13) & Chr(10) Loop Close #1 Textl.Text = b End If End SelectEnd Sub表3-2 frmTpssq窗体中控件属性值设置对象类型属性设置值作用frmTpssq窗体Caption图片搜索器Image1图象BorderStyleStreth1True显示图片Frame1框架BorderStyleCaption1搜索图片分组控件Combo1组合框Style2选择图片文件类型Drive1驱动器列表框搜索驱动器Dir1文件夹列表框搜索文件夹File1文件列表框搜索文件Label1标签C

16、aption图片类型：Label2标签Caption驱动器：Label3标签Caption文件夹：Label4标签Caption图片文件：实验参考源代码：Option ExplicitPrivate strDri As StringPrivate Sub File1_Click() On Error Resume Next Dim strFilePath As String strFilePath = File1.Path & & File1.FileName Image1.Picture = LoadPicture(strFilePath)End Sub Private Sub Form_L

17、oad() Combo1.AddItem *.BMP Combo1.AddItem *.JPG Combo1.AddItem *.GIF Combo1.AddItem *.BMP;*.JPG;*.GIF Combo1.ListIndex = Combo1.ListCount - 1End SubPrivate Sub Dir1_Change() File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change() On Error GoTo ERR Dir1.Path = Drive1.Drive strDri = Drive1.Drive Exit

18、 Sub ERR: MsgBox 该驱动器内无数据可读, _ vbOKOnly + vbExclamation + _ vbDefaultButton1 + vbSystemModal, 提示 Drive1.Drive = strDri Dir1.Path = strDri Resume NextEnd SubPrivate Sub Drive1_GotFocus() strDri = Drive1.DriveEnd SubPrivate Sub Combo1_Click() File1.Pattern = Combo1.TextEnd Sub 表4-1菜单属性设置主菜单项子菜单项属性设置值M

19、nuFileCaption文件(&F)mnuFileNew CaptionShortcut新建(&N)Ctrl+NmnuFileOpenCaptionShortcut打开(&O)Ctrl+OmnuFileSaveCaptionShortcut保存(&S)Ctrl+SmnuFileSaveAsCaption另存为(&A)mnuFilePeintCaption打印(&P)mnuFileExitCaption退出(&X)mnuEditCaption编辑(&E)mumEditCutCaptionShortcut剪切(&T)Ctrl+XmumEditCopyCaptionShortcut复制(&C)Ct

20、rl+CmumEditPasteCaptionShortcut粘贴(&P)Ctrl+VmumEditSpecialCaption全选(&A)mnuFormatCaption格式(&O)mnuFormatFontCaption字体(&O)mnuFormatAlignLeftCaption左对齐(&L)mnuFormatAlignCenterCaption居中对齐(&C)mnuFormatAlignRightCaption右对齐(&R)mnuWindowCaptionWindowList窗口(&W)TruemnuWindowCascadeCaption层叠(&C)mnuWindowTileHori

21、zontalCaption横向平铺(&C)mnuWindowTileVerticalCaption纵向平铺(&C)mnuWindowArrangeIconsCaption排列图标(&C)mnuWindowToolbarCaptionChecked工具栏(&T)TruemnuWindowStatusBarCaptionChecked状态栏(&B)True 实验参考源代码1）标准模块Modulel中的源代码Option ExplicitPublic fMainForm As frmMainSub Main( ) Set fMainForm = New frmMain fMainForm.ShowE

22、nd Sub2）主窗体frmMain中的源代码Option ExplicitPrivate Sub MDIForm_Load() Left = GetSetting(App.Title, Settings, MainLeft, 1000) Top = GetSetting(App.Title, Settings, MainTop, 1000) Width = GetSetting(App.Title, Settings, MainWidth, 6500) Height = GetSetting(App.Title, Settings, MainHeight, 6500) LoadNewDocE

23、nd SubPrivate Sub LoadNewDoc() Static lDocumentCount As Long Dim frmD As frmDocument lDocumentCount = lDocumentCount + 1 Set frmD = New frmDocument frmD.Caption = 文档 & lDocumentCount frmD.ShowEnd SubPrivate Sub MDIForm_Unload(Cancel As Integer) 在窗体集合中循环并卸载每个窗体。 Dim i As Integer For i = Forms.Count -

24、 1 To 0 Step -1 Unload Forms(i) Next If WindowState vbMinimized Then SaveSetting App.Title, Settings, MainLeft, Left SaveSetting App.Title, Settings, MainTop, Top SaveSetting App.Title, Settings, MainWidth, Width SaveSetting App.Title, Settings, MainHeight, Height End IfEnd SubPrivate Sub mnuEditSpe

25、cial_Click() ActiveForm.rtfText.SelStart = 0 ActiveForm.rtfText.SelLength = Len(ActiveForm.rtfText.Text)End SubPrivate Sub mnuFormatAlignCenter_Click() ActiveForm.rtfText.SelAlignment = rtfCenterEnd SubPrivate Sub mnuFormatAlignLeft_Click() ActiveForm.rtfText.SelAlignment = rtfLeftEnd SubPrivate Sub

26、 mnuFormatAlignRight_Click() ActiveForm.rtfText.SelAlignment = rtfRightEnd SubPrivate Sub mnuFormatFont_Click() dlgCommonDialog.CancelError = True On Error GoTo ErrHandler dlgCommonDialog.Flags = cdlCFEffects Or cdlCFBoth dlgCommonDialog.ShowFont With ActiveForm .rtfText.SelFontName = dlgCommonDialo

27、g.FontName .rtfText.SelFontSize = dlgCommonDialog.FontSize .rtfText.SelBold = dlgCommonDialog.FontBold .rtfText.SelItalic = dlgCommonDialog.FontItalic .rtfText.SelUnderline = dlgCommonDialog.FontUnderline .rtfText.SelStrikeThru = dlgCommonDialog.FontStrikethru .rtfText.SelColor = dlgCommonDialog.Col

28、or End WithErrHandler:End SubPrivate Sub mnuWindowStatusBar_Click() mnuWindowStatusBar.Checked = Not mnuWindowStatusBar.Checked sbStatusBar.Visible = mnuWindowStatusBar.CheckedEnd SubPrivate Sub mnuWindowToolbar_Click() mnuWindowToolbar.Checked = Not mnuWindowToolbar.Checked tbToolBar.Visible = mnuWindowToolbar.CheckedEnd SubPrivate Sub tbToolBar_ButtonClick(ByVal Button As MSComCtlLib.Button) On Error Resume N