VB实验报告.docx

VB实验报告.docx

《VB实验报告.docx》由会员分享，可在线阅读，更多相关《VB实验报告.docx（33页珍藏版）》请在冰豆网上搜索。

VB实验报告

PrivateSubcomdJj_Click（）

lblXh=lblXh+1'累计商品顺序号

lblJz=Val（txtDj）*Val（txtSl）'计算商品价值

lblLjYsk=Val（lblLjYsk）+Val（lblJz）'累计商品总价值

txtDj=0'单价清零

txtSl=0'数量清零

txtDj.SetFocus'单价框获得焦点

EndSub

PrivateSubcomdQl_Click（）

Ql'调用清零过程

EndSub

PrivateSubcomdExit_Click（）

UnloadMe'关闭窗体

EndSub

PrivateSubForm_Load（）

Ql'调用清零过程

EndSub

'清零过程

PrivateSubQl（）

txtDj=0

txtSl=0

lblJz=0

lblXh=1

lblLjYsk=0

EndSub

表1-1窗体中控件属性值的设置

对象

类型

属性

设置值

作用

frmSpxsjj

窗体

Caption

商品销售计价

lblxh

标签

BorderStyle

1

显示商品顺序号

txtDj

文本框

输入单价

txtSl

文本框

输入数量

lblJz

标签

BorderStyle

1

显示商品价值

lblLjYsk

标签

BorderStyle

1

显示累计价值

Label1

标签

Caption

AutoSize

商品序号：

True

Label2

标签

Caption

AutoSize

单价（元）：

True

Label3

标签

Caption

AutoSize

数量：

True

Label4

标签

Caption

AutoSize

价值（元）：

True

Label5

标签

Caption

AutoSize

累计总价（元）：

True

comdJj

命令按钮

Caption

计价

启动计价计算

comdQl

命令按钮

Caption

清零

下一轮计价准备

comdExit

命令按钮

Caption

退出

退出程序

实验参考源代码

首先在模块的“通用”段声明变量：

DimvAsBoolean’是否第1次按运算符

DimsAsInteger’存放上次按的运算符

DimxAsDouble’存放第1个操作数

DimyAsDouble’存放第2个操作数

编写数字类命令按钮组Command1（）的Click事件代码：

PrivateSubCommand1Click（IndexAsInteger）

IfForm1.Tag="T"Then’向显示中的数追加新数

IfIndex＝10Then

Text1.Text＝”0”

Else

Textl.Text=Command1（Index）.Caption

EndIf

Form1.Tag＝””

Else

Textl.Text＝Textl.Text＆Command1（Index）.Caption

EndIf

EndSub

编写运算符类命令按钮组Command2（）的Click事件代码：

PrivateSubCommand2Click（IndexAsInteger）

Form1.Tag＝"T"

IfvThen’第1次按运算符

x=Val（Text1.Text）’将键入的数存入、

v＝Notv

Else

y＝Val（Text1.Text）

SelectCases

Case0

Textl.Text＝x＋y

Case1

Text1.Text＝x一y

Case2

Textl.Text＝x*y

Case3

Ify<>0Then

Textl.Text=x／y

Else

MsgBox（"不能以0为除数”：

）

Textl.Text＝x

v＝False

EndIf

Case4

Y＝0

v＝False

EndSelect

x=Val（Text1.Text）

EndIf

s＝Index

EndSub

实验参考源代码

首先编写自定义的Sub过程代码：

PrivateSubDelay（PauseTime）’PauseTime为暂停时间

DimStart

Start＝Timer’设置开始暂停的时刻

DoWhileTimer＜Start＋PauseTime

Loop

EndSub

编写命令按钮Commandl的Click事件代码：

PrivateSubCommandl,ClickU

Cls

Form1.FontSize＝16’设置字体大小

Print

Forml.ForeColor=QBColor（9）’设置对象中文本或图形的前景色

PrintTab（4）；“暂停3秒钟”

Print

Delay（3）’暂停3秒

Form1.ForeColor＝QBColor（10）

PrintTab（4）；“暂停5秒钟”

Print

Delay5’暂停5秒

Forml.ForeColor=QBColor（12）

PrintTab（4）;“结束!

”

Print

Delay

（1）’暂停1秒

EndSub

为了在程序暂停时不致于使用户误认为“死机”了，可以在窗体的标题栏中显示剩余时间。

只需修改“延时”Sub过程代码：

PrivateSubDelay（PauseTime）

Start＝Timer

DoWhileTimer

m=Start＋PauseTime-Timer’计算剩余时间

m0=（m*10）Mod10’剩余时间的1位小数

m=Int（m）’剩余秒数

Me.Caption＝Format（m,"0:

”＆Format（m0,"0”）

Loop

EndSub

表2-3frmJsq窗体中控件属性值设置

对象

类型

属性

设置值

作用

frmJsq

窗体

Caption

计时器

Timer1

定时器

Enabled

Interval

False

100

计时

lblTimeSlice

标签

BorderStyle

1

显示时间

comdStart

命令按钮

Caption

Enabled

启动

true

启动计时

comdPause

命令按钮

Caption

Enabled

暂停

False

暂停计时

comdContinue

命令按钮

Caption

Enabled

继续

False

继续计时

comdStop

命令按钮

Caption

Enabled

停止

False

停止计时

OptionExplicit

DimTimeStart,TimeSlice1AsDate,TimeSlice2AsDate

PrivateSubcomdContinue_Click（）

StartTime

comdContinue.Enabled=False

comdPause.Enabled=True

EndSub

PrivateSubcomdStop_Click（）

Timer1.Enabled=False

lblTimeSlice=Format（0,"LongTime"）

comdStop.Enabled=False

comdPause.Enabled=False

comdContinue.Enabled=False

comdStart.Enabled=True

EndSub

PrivateSubcomdStart_Click（）

TimeSlice1=0

StartTime

comdStart.Enabled=False

comdPause.Enabled=True

comdStop.Enabled=True

EndSub

PrivateSubcomdPause_Click（）

TimeSlice1=TimeSlice2

Timer1.Enabled=False

comdContinue.Enabled=True

comdPause.Enabled=False

EndSub

PrivateSubTimer1_Timer（）

TimeSlice2=Time-TimeStart+TimeSlice1

lblTimeSlice=Format（TimeSlice2,"LongTime"）

EndSub

PrivateSubStartTime（）

TimeStart=Time

Timer1.Enabled=True

EndSub

实验参考源代码：

编写窗体的Load事件代码：

PrivateSubForm_Load（）

Filet.Pattern=”*.Txt”

EndSub

编写驱动器列表框Drive1的Change事件代码：

PrivateSubDrivel_Change（）

Dirt.Path=Drivel.Drive

EndSub

编写目录列表框Dirl的Change事件代码：

PrivateSubDirl_Change（）

File1.Path=Dirt.Path

Text2.Text=Dir1.Path

EndSub

编写文件列表框Filel的Click事件代码：

PrivateSubFilel_Ciick（）

Text2.Text＝File1.Path&”\”&File1.FileName

EndSub

编写组合框Combo1的Click事件代码：

PrivateSubCombo1_Click（）

aa=Combo1.List（Combo1.ListIndex）

File1.Pattern＝aa

EndSub

编写命令按钮控件数组Command1的Click事件代码：

PrivateSubCommand1_Click（IndexAsInteger）

SelectCaseIndex

Case0

IfText2.Text<>””Then

OpenText2.TextForOutputAs#1

Print#1，Text1.Text

Close#1

EndIf

Case1

IfText2.Text<>””Then

Textl.Text=””

OpenText2.TextForInputAs#1

b=””

DoUntilEOF

（1）

LineInput#1，nextline

b=b&nextline&Chr（13）&Chr（10）

Loop

Close#1

Textl.Text=b

EndIf

EndSelect

EndSub

表3-2frmTpssq窗体中控件属性值设置

对象

类型

属性

设置值

作用

frmTpssq

窗体

Caption

图片搜索器

Image1

图象

BorderStyle

Streth

1

True

显示图片

Frame1

框架

BorderStyle

Caption

1

搜索图片

分组控件

Combo1

组合框

Style

2

选择图片文件类型

Drive1

驱动器列表框

搜索驱动器

Dir1

文件夹列表框

搜索文件夹

File1

文件列表框

搜索文件

Label1

标签

Caption

图片类型：

Label2

标签

Caption

驱动器：

Label3

标签

Caption

文件夹：

Label4

标签

Caption

图片文件：

实验参考源代码：

OptionExplicit

PrivatestrDriAsString

PrivateSubFile1_Click（）

OnErrorResumeNext

DimstrFilePathAsString

strFilePath=File1.Path&"\"&File1.FileName

Image1.Picture=LoadPicture（strFilePath）

EndSub

PrivateSubForm_Load（）

Combo1.AddItem"*.BMP"

Combo1.AddItem"*.JPG"

Combo1.AddItem"*.GIF"

Combo1.AddItem"*.BMP;*.JPG;*.GIF"

Combo1.ListIndex=Combo1.ListCount-1

EndSub

PrivateSubDir1_Change（）

File1.Path=Dir1.Path

EndSub

PrivateSubDrive1_Change（）

OnErrorGoToERR

Dir1.Path=Drive1.Drive

strDri=Drive1.Drive

ExitSub

ERR:

MsgBox"该驱动器内无数据可读",_

vbOKOnly+vbExclamation+_

vbDefaultButton1+vbSystemModal,"提示"

Drive1.Drive=strDri

Dir1.Path=strDri

ResumeNext

EndSub

PrivateSubDrive1_GotFocus（）

strDri=Drive1.Drive

EndSub

PrivateSubCombo1_Click（）

File1.Pattern=Combo1.Text

EndSub

表4-1菜单属性设置

主菜单项

子菜单项

属性

设置值

MnuFile

Caption

文件（&F）

mnuFileNew

Caption

Shortcut

新建（&N）

Ctrl+N

mnuFileOpen

Caption

Shortcut

打开（&O）

Ctrl+O

mnuFileSave

Caption

Shortcut

保存（&S）

Ctrl+S

mnuFileSaveAs

Caption

另存为（&A）

mnuFilePeint

Caption

打印（&P）

mnuFileExit

Caption

退出（&X）

mnuEdit

Caption

编辑（&E）

mumEditCut

Caption

Shortcut

剪切（&T）

Ctrl+X

mumEditCopy

Caption

Shortcut

复制（&C）

Ctrl+C

mumEditPaste

Caption

Shortcut

粘贴（&P）

Ctrl+V

mumEditSpecial

Caption

全选（&A）

mnuFormat

Caption

格式（&O）

mnuFormatFont

Caption

字体（&O）

mnuFormatAlignLeft

Caption

左对齐（&L）

mnuFormatAlignCenter

Caption

居中对齐（&C）

mnuFormatAlignRight

Caption

右对齐（&R）

mnuWindow

Caption

WindowList

窗口（&W）

True

mnuWindowCascade

Caption

层叠（&C）

mnuWindowTileHorizontal

Caption

横向平铺（&C）

mnuWindowTileVertical

Caption

纵向平铺（&C）

mnuWindowArrangeIcons

Caption

排列图标（&C）

mnuWindowToolbar

Caption

Checked

工具栏（&T）

True

mnuWindowStatusBar

Caption

Checked

状态栏（&B）

True

实验参考源代码

1）标准模块Modulel中的源代码

OptionExplicit

PublicfMainFormAsfrmMain

SubMain（）

SetfMainForm=NewfrmMain

fMainForm.Show

EndSub

2）主窗体frmMain中的源代码

OptionExplicit

PrivateSubMDIForm_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）

LoadNewDoc

EndSub

PrivateSubLoadNewDoc（）

StaticlDocumentCountAsLong

DimfrmDAsfrmDocument

lDocumentCount=lDocumentCount+1

SetfrmD=NewfrmDocument

frmD.Caption="文档"&lDocumentCount

frmD.Show

EndSub

PrivateSubMDIForm_Unload（CancelAsInteger）

'在窗体集合中循环并卸载每个窗体。

DimiAsInteger

Fori=Forms.Count-1To0Step-1

UnloadForms（i）

Next

IfWindowState<>vbMinimizedThen

SaveSettingApp.Title,"Settings","MainLeft",Left

SaveSettingApp.Title,"Settings","MainTop",Top

SaveSettingApp.Title,"Settings","MainWidth",Width

SaveSettingApp.Title,"Settings","MainHeight",Height

EndIf

EndSub

PrivateSubmnuEditSpecial_Click（）

ActiveForm.rtfText.SelStart=0

ActiveForm.rtfText.SelLength=Len（ActiveForm.rtfText.Text）

EndSub

PrivateSubmnuFormatAlignCenter_Click（）

ActiveForm.rtfText.SelAlignment=rtfCenter

EndSub

PrivateSubmnuFormatAlignLeft_Click（）

ActiveForm.rtfText.SelAlignment=rtfLeft

EndSub

PrivateSubmnuFormatAlignRight_Click（）

ActiveForm.rtfText.SelAlignment=rtfRight

EndSub

PrivateSubmnuFormatFont_Click（）

dlgCommonDialog.CancelError=True

OnErrorGoToErrHandler

dlgCommonDialog.Flags=cdlCFEffectsOrcdlCFBoth

dlgCommonDialog.ShowFont

WithActiveForm

.rtfText.SelFontName=dlgCommonDialog.FontName

.rtfText.SelFontSize=dlgCommonDialog.FontSize

.rtfText.SelBold=dlgCommonDialog.FontBold

.rtfText.SelItalic=dlgCommonDialog.FontItalic

.rtfText.SelUnderline=dlgCommonDialog.FontUnderline

.rtfText.SelStrikeThru=dlgCommonDialog.FontStrikethru

.rtfText.SelColor=dlgCommonDialog.Color

EndWith

ErrHandler:

EndSub

PrivateSubmnuWindowStatusBar_Click（）

mnuWindowStatusBar.Checked=NotmnuWindowStatusBar.Checked

sbStatusBar.Visible=mnuWindowStatusBar.Checked

EndSub

PrivateSubmnuWindowToolbar_Click（）

mnuWindowToolbar.Checked=NotmnuWindowToolbar.Checked

tbToolBar.Visible=mnuWindowToolbar.Checked

EndSub

PrivateSubtbToolBar_ButtonClick（ByValButtonAsMSComCtlLib.Button）

OnErrorResumeN