VB大作业模板

《面向对象程序设计》大作业题目：记事本的设计及实现姓名：学号：专业：学院：指导教师：1 课程设计题目和要求 (3)2 功能分析 (3)3 系统设计 (3)3.1主流程图 (3)3.2 “文件”菜单操作流程图 (4)3.3 “编辑”菜单操作流程图 (5)3.4 “格式”菜单操作流程图 (6)3.5“帮助”菜单操作流程图 (7)4. 界面设计 (8)4.1 系统主界面设计 (8)4.2“文件”菜单的菜单项 (8)4.3 打开文件及另存文件时的界面 (9)4.4“编辑”菜单的菜单项 (9)4.5“格式”菜单的菜单项 (10)4.6“帮助”菜单的菜单项 (10)4.7 帮助界面设计 (11)4.8 “查找”功能界面设计 (12)5 总结 (12)6. 附录（源程序清单） (14)6.1全局变量 (14)6.2主程序加载 (14)6.3新建记事本文件 (14)6.4打开已有的记事本文件 (14)6.5 保存记事本文件 (15)6.6另存为所打开的记事本文件 (15)6.7打印所打开的记事本文件 (16)6.8退出主程序 (16)6.9 撤销命令 (16)6.10 剪切命令 (16)6.11 复制命令 (17)6.12 黏贴命令 (17)6.13 “删除”菜单源程序 (17)6.14“查找”菜单源程序 (17)6.15“查找下一个”菜单源程序 (17)6.16“全选”菜单源程序 (18)6.17插入时间/日期源程序 (18)6.18 统计字数源程序 (18)6.19 “自动换行”菜单源程序 (19)6.20 字体的选择 (19)6.21 “帮助”菜单栏源程序 (19)6.22 关于此记事本的信息 (19)1 课程设计题目和要求题目：记事本的设计及实现基本设计要求：(1)功能齐全；(2)保证文件安全，操作简便；(3)操作方便、简单，界面友好；(4)易于维护和补充；(5)对系统的运行效率要高，绝对不能出错，对系统响应速度的要求不高；2 功能分析本程序要构建的记事本程序参照了Windows操作系统的记事本工具，其功能有以下几个方面：(1) 菜单中有“文件”、“编辑”、“格式”、“帮助”四个主菜单；(2) “文件”有“新建”、“打开”、“保存”、“另存为”、“打印”及“退出”分别用于新建文件，打开文件，保存文件，另存文件，打印文件及退出记事本。

VB课程大作业要求1.题目安排：每个同学根据自己的学号后两位数字，做对应的题目。

题目在附件中，文件名为《VB大作业题库》。

例如：学号201120007,后两位数字为“07”，做第“7题”；学号201120017,后两位数字为“17”，做第“17题”；学号201120100,后两位数字为“00”，做第“100题”；2.答题要求：每个同学针对各自的题目，首先进行算法分析；然后设计直观、可操作性强的界面；上机编程和调试后，进行结果分析与总结。

3.提交形式：纸质报告+源程序（.vbp和.frm文件）（1）纸质报告分四部分，篇幅大小为2page，字号为“五号”；一张A4纸正反打印。

<1> 班级姓名学号题目；<2> 算法分析；<3> 界面与结果截图；<4> 结果分析与总结；（2）源程序包括工程和窗体文件等（.vbp和.frm），做成一个压缩文件，文件名统一为：班级+姓名+学号<注意：只提交.exe文件的没有成绩！>4.提交时间与方式：(1) 纸质报告交各班学委，由学委排序后，于5月17日17点之前，交到7教314。

(2) 源程序文件，由各位同学本人，于5月17日17点之前，发送到lining@纸质报告与源程序两者缺一不可。

打印所有不超过n(取n<256) 的其平方具有对称性质的数(也称回文数)。

*题目分析与算法设计对于要判断的数n，计算出其平方后(存于a)，将a的每一位进行分解，再按a的从低到高的顺序将其恢复成一个数k(如n=13，则a=169且k=961)，若a等于k则可判定n为回文数。

#include <stdio.h>int main(int argc, char *argv[]){int i, n, a, m[16], k, count=0, t;printf("no\tnumber\tvalue\n");for(n=1; n<256; n++){k = 0, t = 1, a = n * n;for(i=0; a!=0; i++){m[i] = a % 10;a /= 10;}int j = 0;for(i--; j<=i; j++, i--){if(m[j] != m[i])break;if(j >= i)printf("%d\t%d\t%d\t\n", ++count, n, n*n);}}return 0;}。

VB数学型大作业题目下面题目中任选两个完成。

1.歌星大奖赛在歌星大奖赛中，有10个评委为参赛的选手打分，分数为1~100分。

选手最后得分为：去掉一个最高分和一个最低分后其余8个分数的平均值。

请编写一个程序实现。

算法提示：这个问题的算法十分简单，但是要注意在程序中判断最大、最小值的变量是如何赋值的。

2.求最大数问555555的约数中最大的三位数是多少？算法提示：根据约数的定义，对于一个整数N，除去1和它自身外，凡能整除N的数即为N的约数。

因此，最简单的方法是用2到N-1之间的所有数去除N，即可求出N的全部约数。

本题只要求取约数中最大的三位数，则其取值范围可限制在100到999之间。

3.高次方数的尾数求13的13次方的最后三位数算法提示：解本题最直接的方法是：将13累乘13次方截取最后三位即可。

但是由于计算机所能表示的整数范围有限，用这种“正确”的算法不可能得到正确的结果。

事实上，题目仅要求最后三位的值，完全没有必要求13的13次方的完整结果。

研究乘法的规律发现：乘积的最后三位的值只与乘数和被乘数的后三位有关，与乘数和被乘数的高位无关。

利用这一规律，可以大大简化程序。

4.杨辉三角形在屏幕上显示杨辉三角形11 11 2 11 3 3 11 4 6 4 11 5 10 10 5 1......................................算法提示：杨辉三角形中的数，正是(x+y)的N次方幂展开式各项的系数。

本题作为程序设计中具有代表性的题目，求解的方法很多，这里仅给出一种。

从杨辉三角形的特点出发，可以总结出：1)第N行有N+1个值(设起始行为第0行)2)对于第N行的第J个值：(N>=2)当J=1或J=N+1时：其值为1J!=1且J!=N+1时：其值为第N-1行的第J-1个值与第N-1行第J个值之和本程序应是根据以上递归的数学表达式编制的。

5.该存多少钱假设银行一年整存零取的月息为0.63%。

VB作业文档格式(只写题号答案，不用抄题)习题二3. 写VB表达式(1) Abs(x + y) + z ^ 5(2) (1 + x * y) ^ 6(3) (10 * x + Sqr(3 * y)) / (x * y)(4) (-b + Sqr(b ^ 2 - 4 * a * c)) / (2 * a)(5) 1 / (1 / r1 + 1 / r2 + 1 / r3)(6) Sin(45 * 3.14159 / 180) + (Exp(10) + Log(10)) / Sqr(x + y + 1)4. 根据条件写表达式(1) 随机产生大写字母Chr(Int(Rnd * (Asc("L") - Asc("C") + 1) + Asc("C")))(2) [100,200]内的随机数Int(Rnd * 101) + 100(3) 点(x,y)位于第一或第三象限x > 0 And y > 0 Or x < 0 And y < 0 或x *y > 0(4) x是5或7的整数倍x Mod 5 = 0 Or Int(x / 7) = x / 7(5) 将两位整数x的个位与十位对换x \ 10 + (x Mod 10) * 10(6) 四舍五入取两位小数Round(x, 2)(7) 字符变量C是字母字符（不区分大小写）——准确地说是：字符变量C的第一个字符是字母C >= "A" And C <= "Z" Or C >= "a" And C < "z"或UCase(C) >= "A" And UCase(C) <= "Z"或LCase(C) >= "a" And LCase(C) <= "z"(8) 字符变量S第5个字符起取6个字符Mid(S, 5, 6)(9) 10≤x＜20 10 <= x And x < 20(10) x，y至少有一个小于z x < z Or y < z(11)x，y都大于z x > z And y > z5. 写表达式的值(1) 188 ——注意运算的优先级顺序，以及整除运算“\”的计算(2) 200100 ——计算100 + "100"时，由于两个操作数类型不同，在可能的情况下自动采用精度较高的类型，即把字符型转换为数值型，100 +100 得到200；然后进行字符串连接运算200 & 100 ，再自动将两个数值转换为字符串，得200100。

1、编写一个计算矩形面积的通用过程，然后调用该过程计算矩形的面积。

分析：本题需要设计一个求矩形面积的Sub通用过程。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象的属性。

设置下图所示。

②编写事件代码。

2、一个有9个元素的一维数组，随机产生9个两位数赋值给该数组，从中找出最大值、最小值和平均值。

分析：首先声明一个有9个元素的一维数组，利用随机函数随机产生9个两位数赋值给该数组。

然后，对每个数组元素值进行比较，从中找出最大值、最小值和平均值。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象的属性。

在窗体上添加1个框架，7个标签和3个按钮控件。

设置如图所示。

②编写事件代码。

求最大、最小、平均值3、将一个数组按照元素值从大到小重新排序。

分析：数组元素排序有多种方法，比如选择排序法。

首先找出最大数，将它放在第一个数的位置。

在余下的n-1个数中再找出最大数，放在第二个数的位置。

依次类推，最终将数组元素按照从大到小排序。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象的属性。

设置如图所示。

②编写事件代码。

4π分析：首先找出公式中无穷乘积各项的规律。

设第n 项的分母为P n ，则第n+1项的分母为P n+1n 项乘积为S n ，则前n 项乘积为S n+1=2 S n / P n+1。

根据以上分析，画出流程图所示。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象属性。

如图所示。

②当程序运行时，输入小数位数，单击“计算”，在下方的文本框中显示计算结果。

5、利用Do…Loop循环语句求从1到100的累加和。

分析：采用累加的方法，用变量numberSum来存储从1到100的累加和。

用变量n来存放“加数”（加到numberSum中的数），从1开始到100为止。

根据以上分析，画出流程图所示。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象属性。

②编写“计算”命令按钮的Click事件代码：③运行程序，当单击“计算”按钮，结果如图5-6所示运行程序，当单击“计算”按钮，结果如图所示。

Private Sub Command1_Click() Form2.ClsForm2.ForeColor = vbYellow Form2.Print "右移"Form2.Left = Form2.Left + 100 End SubPrivate Sub Command2_Click() Form2.BackColor = vbBlack Form2.Show左移.Enabled = True Command5.Enabled = True Command1.Enabled = True Command6.Enabled = True End SubPrivate Sub Command3_Click() Form2.Hide左移.Enabled = False Command5.Enabled = False Command1.Enabled = False Command6.Enabled = False End SubPrivate Sub Command4_Click() EndEnd SubPrivate Sub Command5_Click() Form2.ClsForm2.ForeColor = vbYellow Form2.Print "放大"Form2.Width = Form2.Width * 2 Form2.Height = Form2.Height * 2 End SubPrivate Sub Command6_Click() Form2.ClsForm2.ForeColor = vbYellow Form2.Print "缩小"Form2.Width = Form2.Width / 2 Form2.Height = Form2.Height / 2 End SubPrivate Sub Command7_Click() Form1.ForeColor = vbBlack Form1.Print "ok!"End SubPrivate Sub Command8_Click() Form1.ClsEnd SubPrivate Sub 左移_Click()Form2.ClsForm2.ForeColor = vbYellow Form2.Print "左移"Form2.Left = Form2.Left - 100 End SubPrivate Sub Command1_Click()Dim a As Single, b As Single, c As SingleLabel1.Caption = ""a = Val(Text1.Text)b = Val(Text2.Text)c = a + bLabel1.Caption = Val(Text1.Text) & "+" & Val(Text2.Text) & "=" & c End SubPrivate Sub Command2_Click()Dim a As Single, b As Single, c As SingleLabel1.Caption = ""a = Val(Text1.Text)b = Val(Text2.Text)c = a - bLabel1.Caption = Val(Text1.Text) & "-" & Val(Text2.Text) & "=" & c End SubPrivate Sub Command3_Click()Text1 = ""Text2 = ""Label1.Caption = ""End SubPrivate Sub Command4_Click()EndEnd SubPrivate Sub Command1_Click()Text1.Text = Int(Rnd * (99 - 10 + 1)) + 10Text2.Text = Int(Rnd * (99 - 10 + 1)) + 10End SubPrivate Sub Command2_Click()Text1.Text = ""Text2.Text = ""Text3.Text = ""Text1.SetFocusEnd SubPrivate Sub Text1_Change()Text3.Text = Trim(Str(Val(Text1.Text) + Val(Text2.Text))) End SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)If KeyAscii > Asc("9") Or KeyAscii < Asc("0") Then KeyAscii = 0End IfEnd SubPrivate Sub Text2_Change()Text3.Text = Trim(Str(Val(Text1.Text) + Val(Text2.Text))) End SubPrivate Sub Text2_KeyPress(KeyAscii As Integer)If KeyAscii > Asc("9") Or KeyAscii < Asc("0") Then KeyAscii = 0End IfEnd SubDim a As StringDim b As StringPrivate Sub Check1_Click()If Check1.Value = 1 ThenOption1.Enabled = TrueOption2.Enabled = TrueOption3.Enabled = True ElseOption1.Enabled = FalseOption2.Enabled = FalseOption3.Enabled = False End IfEnd SubPrivate Sub Check2_Click()If Check2.Value = 1 ThenOption4.Enabled = TrueOption5.Enabled = True ElseOption4.Enabled = FalseOption5.Enabled = False End IfEnd SubPrivate Sub Command1_Click()Label3.Caption = "你订购了" + b + "系统的" + a + Text1.Text + "台"End SubPrivate Sub Option4_Click()b = Option4.CaptionEnd SubPrivate Sub Option5_Click()b = Option5.CaptionEnd SubPrivate Sub Option1_Click()a = Option1.CaptionEnd SubPrivate Sub Option2_Click()a = Option2.CaptionEnd SubPrivate Sub Option3_Click()a = Option3.CaptionEnd SubPrivate Sub Timer1_Timer()Label1.Caption = "当前时间是：" & Hour(Time) & "时" & Minute(Time) & "分" & Second(Time) & "秒"Label2.Caption = "当前时间是：" & DateEnd SubPrivate Sub Command1_Click()If List1.ListIndex = -1 Thenn = MsgBox("请先选择一个选项！", 0, "提示") ElseCombo1.AddItem List1.TextList1.RemoveItem List1.ListIndexEnd IfEnd SubPrivate Sub Command2_Click()If Combo1.ListIndex = -1 Thenn = MsgBox("请先选择一个选项！", 0, "提示") ElseList1.AddItem Combo1.TextCombo1.RemoveItem Combo1.ListIndexEnd IfEnd SubPrivate Sub Command3_Click()For i = List1.ListCount - 1 To 0 Step -1Combo1.AddItem List1.List(i)Next iList1.ClearEnd SubDim x, y As IntegerPrivate Sub Command1_Click()Timer1.Enabled = TrueCommand1.Enabled = FalseCommand2.Enabled = TrueEnd SubPrivate Sub Command2_Click()Timer1.Enabled = FlaseCommand1.Enabled = TrueCommand2.Enabled = FalseEnd SubPrivate Sub Command3_Click()EndEnd SubPrivate Sub Form_Load()x = 50y = 50End SubPrivate Sub Timer1_Timer()Shape1.Left = Shape1.Left + xShape1.Top = Shape1.Top + yIf Shape1.Left >= Picture1.ScaleWidth - Shape1.Width Or Shape1.Left <= 0 Then x = -xEnd IfIf Shape1.Top >= Picture1.ScaleHeight - Shape1.Height Or Shape1.Top <= 0 Then y = -yEnd IfEnd SubPrivate Sub Command1_Click()CommonDialog1.Action = 3Text1.ForeColor = CommonDialog1.ColorEnd SubPrivate Sub Command2_Click()CommonDialog1.Flags = 257CommonDialog1.Action = 4Text1.FontName = CommonDialog1.FontNameText1.FontSize = CommonDialog1.FontSizeText1.FontBold = CommonDialog1.FontBoldText1.FontUnderline = CommonDialog1.FontUnderline Text1.FontStrikethru = CommonDialog1.FontStrikethru Text1.ForeColor = CommonDialog1.ColorEnd SubPrivate Sub Tc1_Click()If Shape1.FillStyle = 1 ThenMsgBox "请选用非透明的填充类型！" ElseCommonDialog1.ShowColorShape1.FillColor = CommonDialog1.Color End IfEnd SubPrivate Sub Yd1_Click(Index As Integer) Select Case IndexCase 0Shape1.Top = Shape1.Top - 100Case 1Shape1.Top = Shape1.Top + 100Case 2Shape1.Left = Shape1.Left - 100Case 3Shape1.Left = Shape1.Left + 100End SelectEnd SubPrivate Sub Tc31_Click(Index As Integer) Select Case IndexCase 0Shape1.FillStyle = 0Case 1Shape1.FillStyle = 1End SelectEnd SubPrivate Sub Xz1_Click(Index As Integer)Shape1.Shape = IndexEnd SubPrivate Sub dq_Click(Index As Integer)Text1.Alignment = IndexEnd SubPrivate Sub Form_Mouseup(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 2 ThenPopupMenu SzEnd IfEnd SubPrivate Sub jc_Click()jc.Checked = Not jc.CheckedText1.FontBold = jc.CheckedEnd SubPrivate Sub qx_Click()qx.Checked = Not qx.CheckedText1.FontItalic = qx.CheckedEnd SubPrivate Sub Zt_Click(Index As Integer)Text1.FontName = Zt(Index).CaptionEnd SubPrivate Sub Dir1_Change()File1.Path = Dir1.PathEnd SubPrivate Sub Drive1_Change()Dir1.Path = Drive1.DriveEnd SubPrivate Sub File1_Click()Dim fs As StringIf Right(File1.Path, 1) = "\" Thenfs = File1.Path + File1.FileName Elsefs = File1.Path + "\" + File1.FileName End IfImage1.Picture = LoadPicture(fs)End SubPrivate Sub Form_Load()Drive1.Drive = "c:"File1.Pattern = "*.bmp;*.gif;*.jpg"End SubPrivate Sub Command1_Click()Dim s As StringText1.Text = ""CommonDialog1.ShowOpenOpen CommonDialog1.FileName For Input As #1 Do While Not EOF(1)Line Input #1, sText1.Text = Text1.Text + s + Chr(13) + Chr(10) LoopClose #1End SubPrivate Sub Command2_Click()CommonDialog1.ShowSaveOpen CommonDialog1.FileName For Output As #1 Print #1, Text1.TextClose #1End SubPrivate Sub Command3_Click()EndEnd SubDim t As IntegerPrivate Sub Command1_Click()Timer1.Enabled = TrueCommand1.Enabled = FalseFrame1.Enabled = FalseEnd SubPrivate Sub Option1_Click(Index As Integer) Command1.Enabled = TrueSelect Case IndexCase 0t = 6Label1.Caption = tCase 1t = 10Label1.Caption = tEnd SelectEnd SubPrivate Sub Timer1_Timer()t = t - 1If t >= 0 ThenBeepLabel1.Caption = tElseLabel1.Caption = "时间到！"Frame1.Enabled = TrueTimer1.Enabled = FalseEnd IfEnd SubPrivate Sub Command1_Click()If Command1.Caption = "开始" Then Timer1.Enabled = TrueCommand1.Caption = "停止"ElseTimer1.Enabled = FalseCommand1.Caption = "开始"End IfEnd SubPrivate Sub Timer1_Timer()If Label1.Left <= Form1.Width Then Label1.Left = Label1.Left + 100 ElseLabel1.Left = -Label1.Width End IfEnd SubPrivate Sub Form_Load()Text1.Text = HScroll1.ValueText2.Text = HScroll2.ValueText3.Text = HScroll3.ValueEnd SubPrivate Sub HScroll1_Change()Label1.BackColor = RGB(HScroll1.Value, _HScroll2.Value, HScroll3.Value) '给标签的背景色赋值，该值用颜色函数RGB来实现，而颜色函数RGB的三个颜色参数分别来自滚动条Text1.Text = HScroll1.Value '将Hscroll对象中的值赋给Text对象，使两者值相同End SubPrivate Sub HScroll1_Scroll()Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)Text1.Text = HScroll1.ValueEnd SubPrivate Sub HScroll2_Change()Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)Text2.Text = HScroll2.ValueEnd SubPrivate Sub HScroll2_Scroll()Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) Text2.Text = HScroll2.ValueEnd SubPrivate Sub HScroll3_Change()Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) Text3.Text = HScroll3.ValueEnd SubPrivate Sub HScroll3_Scroll()Label1.BackColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) Text3.Text = HScroll3.ValueEnd SubPrivate Sub Label1_Click()Text1.SetFocusEnd SubPrivate Sub Text1_KeyPress(KeyAscii As Integer)Label1.BackColor = RGB(Val(Text1.Text), Val(Text2.Text), Val(Text3.Text)) HScroll1.Value = Val(Text1.Text)End SubPrivate Sub Text2_KeyPress(KeyAscii As Integer)HScroll2.Value = V al(Text2.Text)End SubPrivate Sub Text3_KeyPress(KeyAscii As Integer)HScroll3.Value = Val(Text3.Text)End Sub。

姓名： 宋望 学号： 20101968 班级： 工业工程1班2011年6月27日VB程序设计作业注：1. 黑色题号是第一版教材的，红色题号是第二版教材的，只有一个题号的是第一、二版教材的 2. 将运行结果的截图粘贴到题下，并将程序代码也复制到题下。

3．期末打印出来交上来。

4. 每章做出两道题即可，其它题选做。

（4 -1）设计一个计算购书价程序，界面如图所示。

要求：1） 界面上的文字全部为宋体五号字2） 按图示给文本框取名。

为“计算总价（C ）”和“退出（X ）”按钮设访问键3） 编写代码，使得运行时焦点定位在DJ 文本框中，输入单价后，按Tab 键可输入数量。

在输入单价和数量后，点击“计算总价（C ）”按钮，将计算出的总价钱，先是在文本框ZJ 中，单击“退出（X ）”按钮结束运行。

运行时，计算出的总价为只读，用户不能在界面上修改计算出的总价，且焦点不能定位在ZJ 文本框中。

提示：先将文本框中的内容使用Val 函数转换后再进行计算。

4） 将ZJ 文本框改换成标签，将标签的BorderStyle 属性设置为1-Fixed Single ，用标签输出计算结果。

Private Sub Command1_Click() ZJ.Text = V al(DJ.Text) * V al(SJ.Text) End SubPrivate Sub Command2_Click() End End Sub文本框DJ 文本框SJ 文本框ZJPrivate Sub Command1_Click()ZJ.Caption = V al(DJ.Text) * V al(SJ.Text) End SubPrivate Sub Command2_Click()EndEnd Sub（4 -2）设计一个收款计算程序，界面如图所示。

要求：1）三个输入文本框依次取名为T1、T2、T3，应付款文本框取名为TRESULT。

2）运行时焦点在折扣一栏，输入折扣后，按Tab键可输入单价，再按Tab键可输入数量。

第五章(1)例5-2Private Sub Command1_Click()Dim sum!, n%, aver!sum = 0n = 0x = Val(InputBox("请输入"))Do While x <> -9999sum = sum + xn = n + 1x = Val(InputBox("请输入"))Loopaver = sum / nMsgBox "共输入" & n & " 个数,平均值为:" & averEnd Sub(2)例5-3Private Sub Command1_Click()Dim a%(65 To 90), c As String * 1le = Len(Text1)For i = 1 To lec = UCase(Mid(Text1, i, 1))If c >= "A" And c <= "Z" Thenj = Asc(c)a(j) = a(j) + 1End IfNext iFor j = 65 To 90If a(j) > 0 Then ""; Chr(j); "="; a(j); ""; Next jEnd Sub(3)例5-4Private Sub Command1_Click()Dim a$()Dim x(0 To 10) As Integera = Split(Text1, ",")For i = o To UBound(a)If (a(i) <= 100 And a(i) > 0) Thenk = a(i) \ 10x(k) = x(k) + 1End IfNext iPrintPrint "100分的有:" & x(10) & "人"For i = 9 To 0 Step -1Print i * 10 & "分-"; i * 10 + 9&; "分有:" & x(i) & "人"Next iEnd SubPrivate Sub Command2_Click()EndEnd Sub(4)) 输入多名学生的一门课程成绩（成绩用数组存放，要求成绩用文本框输入），统计0-59、60-69、70-79、80-89、90-100个分数段人数。

1、抽奖程序利用组合框，设计一个抽奖程序。

分析：首先通过下拉组合框输入若干参加抽奖的身份证号码。

每输完一个号码，按回车键把该号码加入组合框。

同时统计组合框项目的数目，在文本框中显示。

然后单击开始抽奖按钮，加入组合框中的号码将在一个标签中不停显示，显示的顺序是随机的。

当再一次单击按钮，随机抽出其中的一个号码。

设计步骤如下：①建立应用程序用户界面和添加控件，并设置各对象属性。

如图所示。

②编写事件代码。

2、利用循环结构和列表控件框，设计的“选项移动”窗体分析：所谓“选项移动”窗体是指由两个列表框和4个命令按钮所构成的界面。

①当单击“>”按钮时，将左边列表框中选中的列表项加入右边的列表框中。

也就是把ListBox1中选中的列表项，用Add方法加入到ListBox2中，同时用RemoveAt方法将ListBox1中选中的列表项清除。

允许同时选中ListBox1的多个列表项。

②当单击“>>”按钮时，将ListBox1中所有的列表项都加入ListBox2中。

并将ListBox1中所有的列表项用Clear方法清除。

③当单击“<”按钮时，将右边列表框中选中的列表项加入左边的列表框中。

只允许一次选中ListBox1的一个列表项。

④当单击“<<”按钮时，将ListBox2中所有的列表项都加入ListBox1中。

并将ListBox2中所有的列表项清除。

方法同“>>”按钮。

如图所示。

3、设计一个指针式时钟程序如下图所示。

分析：指针式时钟程序可以用画图动画来实现。

使用定时器控件Timer定时取得系统时间，然后使用Graphics类提供的Graphics.DrawLine(ByVal pen As Pen, ByVal x1 As Integer, ByVal y1 As Integer, ByVal x2 As Integer, ByVal y2 As Integer)方法在面版上画出指针即可。

一、课题的选材过程鉴于VB强大的设计功能，而自己所学的知识有限，思路不够宽广。

所以参考老师给的题目决定编一个简单实用的电子计算器。

设计思路：1.界面设计计算器主体是一个计算器，需要一个标签Lable（属性CAPTION）作为显示，然后需要0 1 2 3 4 5 6 7 8 9 . + - * / CE C Sqrt 1/X = 共计20个COMMAND控件。

2.程序基本思路数字键的事件过程主要是靠调用number（num）过程来实现，一个控件数组和“0”键组成。

加、减、乘、除运算键的事件过程主要是靠调用Calculation()过程来实现。

开方等特殊运算键的事件过程主要是靠调用VB工具内相应VBA函数来实现，例如sqr()函数。

接受键盘输入的运算操作是打开了建立了一个Form_KeyPress(KeyAscii)通用过程，根据KeyAscii的值响应相应事件。

在代码中针对每个过程都有简单注释；在代码的开头例如“'''operand ----------------------------操作数'''Calculation -------------------------计算”，这些都是帮助说明变量用途而写。

二、设计将要达到的目标用一个窗体模块，完成模仿市面简单计算器的功能。

例如加减乘除，开方，求倒数，支持键盘输入，可以清零，重置。

并可连贯运算这些功能。

三、总体设计结构1.总体设计结构介绍，设计结构图2.主要功能模块运行界面的介绍运行结果：四、设计结果生成可执行程序运行结果：五、设计总结经过这学期VB的学习，使我对VB有了更进一步的认识和了解，要想学好它要重在实践，要通过不断的上机操作才能更好地学习它，虽然学校开的VB是选修课，但它的实用性和通用性很强大，不比学过的C语言差，因为是面向对象，所以很直观，学习中也可以发现很多乐趣，也激起了学习VB的兴趣；因为是初学，对VB的一些标准库函数不太了解，还有对函数调用的正确使用不够熟悉，还有对VB中经常出现的错误也不了解，同时在设计的过程中发现了自己的不足之处，对以前所学过的知识理解得不够深刻，掌握得不够牢固，通过实践的学习，我认识到学习编程要重视实践操作，不仅仅是学习VB，还是其它的语言，以及其它的计算机方面的知识都要重在实践，所以后在学习过程中，我会更加注视实践操作，使自己便好地学好计算机。

第一题Private Sub Form_Click()Height = Height + 500Width = Width + 500End Sub第2题Private Sub Form_click()Form1.Left = Left + 500Form1.Top = Top + 500End Sub第3题Private Sub Command1_Click() Command1.Height = Command1.Height + 50 Command1.Width = Command1.Width + 50End SubPrivate Sub Command2_Click()Command2.Height = Command2.Height - 50Command2.Width = Command2.Width - 50End Sub第4题Private Sub Command1_Click()If Text1.Text = "hello" And Text2.Text = "12345" Then MsgBox "欢迎使用"ElseMsgBox "用户名或密码错误"End IfEnd SubPrivate Sub Command2_Click()EndEnd Sub第5题Private Sub Command1_Click()r = Val(InputBox("请输入第一个整数:", "输入")) e = Val(InputBox("请输入第二个整数", "输入")) Form1.Print "你输入的两个数是:", r, ePrint "你输入的两个数的和是：", r + ePrint "你输入的两个数的平均值是：", (r + e) / 2a = MsgBox("完成得非常好，你很棒！", 0 + 64, "鼓励") End Sub第6题Dim r$, e$Private Sub Command1_Click()r = InputBox("请输入字符串a：", "输入a")e = InputBox("请输入字符串b：", "输入b")End SubPrivate Sub Command2_Click()d = MsgBox(r & e, 0, "结果")End Sub第7题Private Sub Command1_Click()Dim a$a = Text1.TextIf a = "红" ThenForm1.BackColor = vbRedElseIf a = "绿" Then Form1.BackColor = vbGreen ElseIf a = "蓝" Then Form1.BackColor = vbBlue ElseIf a = "黄" Then Form1.BackColor = vbYellowElseIf a = "白" Then Form1.BackColor = vbWhite Else: Form1.BackColor = vbBlackEnd IfEnd Sub第8题Private Sub Form_Click()x = InputBox("请输入x", "输入")y = InputBox("请输入y", "输入")z = InputBox("请输入z", "输入")Print "排序前"Print "X=", xPrint "Y=", yPrint "Z=", zIf x > z And z > y Thent = zz = yy = tElseIf y > x And x > z Then t = yy = xx = tElseIf y > z And z > x Then t = yy = xx = tr = yy = zz = rElseIf z > x And x > y Then t = xx = zz = tr = yy = zz = rElseIf z > y And y > x Then t = zz = xx = tElseEnd IfPrint "排序后"Print "X=", xPrint "Y=", yPrint "Z=", zEnd Sub第9题Private Sub Form_Click()Dim x%, y%, z%x = InputBox("请输入第一条边长", "输入框")y = InputBox("请输入第二条边长", "输入框")z = InputBox("请输入第三条边长", "输入框")If x + y > z And x + z > y And y + z > x Thent = 1 / 2 * (x + y + z)Print "三角形的周长是：", x + y + z; "三角形的面积是：", (t * (t - x) * (t - y) * (t - z)) ^ (1 / 2)Else: h = MsgBox("不能构成三角形", 0 + 48, "警告")End IfEnd Sub第10题Private Sub Command1_Click() Dim a%a = Text1.TextIf a < 10 ThenText2.Text = 30ElseIf a >= 10 And a < 50 Then Text2.Text = a * 5 / 2 ElseIf a >= 50 And a < 75 Then Text2.Text = a * 2Else: Text2.Text = 150End IfEnd Sub第11题Private Sub Form_Click() Dim x%, y%, s%x = 0y = 0s = 0For i = 1 To 99 Step 2 x = x + iNext iFor r = 2 To 100 Step 2 y = y + rNext rs = x - yPrint sEnd Sub第12题Private Sub Form_Click()Dim s%s = 0For i = 100 To 200If i Mod 3 = 0 Or i Mod 7 = 0 Then s = s + iEnd IfNext iPrint sEnd Sub第13题Private Sub Form_Click()Dim i%, s#, y#s = 0y = 0For i = 1 To 30s = s + 2 ^ (i - 1) * 0.01 y = y + 100000Next iPrint "富翁给陌生人的钱是：", s Print "陌生人给富翁的钱是：", y End Sub第14题Private Sub Command1_Click() Dim h!, s!, i%, y!h = Text1.Texts = hFor i = 1 To 9h = h * 0.5s = s + h * 2Next iy = h / 2Text2 = sText3 = yEnd SubPrivate Sub Command1_Click() Dim i%i = Text1For a = 1 To iPrint Space(1)For b = 1 To aPrint "*";Next bNext aEnd SubPrivate Sub Form_Click()Dim x&, s&x = 50000s = 0i = 0While s < 1000000s = s + x * 0.6x = x * (1 + 0.1)i = i + 1WendPrint "成为百万富翁所需年数为", i End Sub第17题Private Sub Command1_Click() Dim a$, b$, c$, x%a = Text1x = Len(a)For i = x To 1 Step -1b = Mid(a, i, 1)c = c + bNext iText2 = cEnd Sub第18题Private Sub Form_Click()Dim a(1 To 20) As Integer, b$ For i = 1 To 20a(i) = (20 - i + 1) ^ 2 Print "a("; i; ")="; a(i) Next iEnd Sub第19题Private Sub Form_Click()Dim a(1 To 10) As Integer Dim i%, max%, j%ClsPrint "数组元素是："For i = 1 To 10a(i) = Int(Rnd * 100 + 1) Print a(i);Next iPrintmax = a(1)For i = 1 To 10If a(i) > max Thenmax = a(i)j = iEnd IfNext iPrint "最大元素的值是：", maxPrint "最大元素是数组的第" & j & "个元素" End Sub第20题Private Sub Form_Click()ClsDim a(1 To 4, 1 To 4) As IntegerDim i%, j%Print "二维数组元素为："For i = 1 To 4For j = 1 To 4a(i, j) = Int(Rnd * 90 + 10)Print a(i, j);Next jPrintNext iPrint "转置后，二维数组元素变为：" For j = 1 To 4For i = 1 To 4Print a(i, j);Next iPrintNext jEnd Sub第22题Private Sub Form_Load()Dim i As IntegerList1.ClearFor i = 0 To Screen.FontCount - 1If Asc(Screen.Fonts(i)) < 0 Then List1.AddItem Screen.Fonts(i) End IfNextCombo1.AddItem "5"Combo1.AddItem "6"Combo1.AddItem "7"Combo1.AddItem "8"Combo1.AddItem "9"Combo1.AddItem "10"Combo1.AddItem "12"Combo1.AddItem "14"Combo1.AddItem "16"Combo1.AddItem "18"Combo1.AddItem "20"Combo1.AddItem "22"Combo1.AddItem "24"Combo1.AddItem "26"Combo1.AddItem "28"Combo1.AddItem "36"Combo1.AddItem "48"End SubPrivate Sub list1_Click()Label1.FontName = List1.TextEnd SubSub Check1_Click()If Check1.Value = 1 ThenLabel1.FontBold = TrueElseLabel1.FontBold = False End IfEnd SubSub Check2_Click()If Check2.Value = 1 ThenLabel1.FontItalic = True ElseLabel1.FontItalic = False End IfEnd SubSub Check3_Click()If Check3.Value = 1 ThenLabel1.FontUnderline = TrueElseLabel1.FontUnderline = FalseEnd IfEnd SubPrivate Sub Combo1_Click()Label1.FontSize = Combo1.TextEnd SubSub hscroll1_change()Label1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)End SubSub hscroll2_change()Label1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)End SubSub hscroll3_change()Label1.ForeColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value)End Sub第23题Private Sub Command1_Click()Timer1.Enabled = Not Timer1.Enabled If Command1.Caption = "开" ThenCommand1.Caption = "停"ElseCommand1.Caption = "开"End IfEnd SubPrivate Sub Timer1_Timer()Image1.Left = Image1.Left + 10If Image1.Left > Form1.Width ThenImage1.Left = -Image1.Width End IfEnd Sub第24题Private Sub Form_Load()c = Chr(13) + Chr(10)msg = "滚滚黄河东逝水" & cmsg = msg & "浪花淘尽英雄" & c msg = msg & "是非成败转成空" & c msg = msg & "青山依旧在" & cmsg = msg & "几度夕阳红"Text1.Text = msgEnd SubText1.Text = ""Text1.SetFocusEnd SubPrivate Sub fonBond_Click() Text1.FontBold = TrueEnd SubPrivate Sub fonItalic_Click() Text1.FontItalic = TrueEnd SubPrivate Sub fonUnder_Click() Text1.FontUnderline = True End SubPrivate Sub fonStri_Click() Text1.FontStrikethru = True End SubText1.FontName = "宋体" End SubPrivate Sub fonL_Click() Text1.FontName = "隶书" End SubPrivate Sub fonH_Click() Text1.FontName = "黑体" End SubPrivate Sub fonY_Click() Text1.FontName = "幼圆" End SubPrivate Sub fon14_Click() Text1.FontSize = 14End SubPrivate Sub fon20_Click() Text1.FontSize = 20End SubText1.FontSize = 24End SubPrivate Sub fon32_Click() Text1.FontSize = 32End SubPrivate Sub fonRed_Click() Text1.ForeColor = vbRedEnd SubPrivate Sub fonBlue_Click() Text1.ForeColor = vbBlueEnd SubPrivate Sub fonBlack_Click() Text1.ForeColor = vbBlack End SubPrivate Sub fonYellow_Click() Text1.ForeColor = vbYellow End Sub第25题Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)If Button = 2 Then PopupMenu popMenu, vbPopupMenuCenterAlignEnd SubPrivate Sub popa_Click()Label1 = "瞒天过海"Text1 = "备周则意怠，常见则不疑。

酒店管理系统软件（VB)大作业声明：本作品完全由个人创作，对于应付老师留得软件大作业很有帮助（西工大)，本作品仅供个人交流学习，不建议作为商业用途，否则后果自负. 由于vb软件还有很多参数的设定,在此不变于抓图。

因此如果读者完全按照本文档所示结果可能出错，请设置data控件的数据库连接（本作品用access数据库，需要时读者自行建立)以上两个图是程序运行后的部分截图数据库截图(图上的各个名字必须与之对应）Form1截图Form1的代码:Pub lic yonghu As String, mima As String Public jibie As Integer ’用户的身份级别Dim r0 As Single ’x0,y0为圆心坐标Dim r1 As Single, r2 As Single, r3 As Single ’r0圆半径，r1时钟刻度外圈半径Dim r4 As Single ’r2时钟长刻度内圈半径,r3时钟短刻度内半径Dim r5 As Single, r6 As Single, r7 As Single ’r4时钟标注文字半径，r5时钟时针半径，r6时钟分针半径Dim x0 As Single， y0 As Single 'r7时钟秒针半径Private Sub bangzhu_Click（）Form9.ShowEnd SubPrivate Sub bumen_Click()Form6.ShowEnd SubPrivate Sub fangcha_Click(） Form2。

ShowEnd SubPrivate Sub Form_Load（） Label1。

Top = 1000 '初始化两个标签的位置Label2.Top = 1000dingwei '将时针，秒针和分针定位到圆心位置jibie = -1yonghu = ""mima = ””End SubPrivate Sub guanli_Click() Form14.ShowEnd SubPrivate Sub Timer1_Timer（）’利用定时时钟采用文字的移动 Label1.Top = Label1。

Sub createLineAndText()Dim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleFor i = 0 To 10p0(0) = 0: p0(1) = ip1(0) = 10: p1(1) = iSet ln0 = ThisDrawing.ModelSpace.AddLine(p0, p1)NextFor i = 0 To 10p0(0) = i: p0(1) = 0p1(0) = i: p1(1) = 10Set ln = ThisDrawing.ModelSpace.AddLine(p0, p1)NextFor i = 0 To 9For j = 0 To 9p0(0) = i + 0.4: p0(1) = j + 0.4Set tt = ThisDrawing.ModelSpace.AddText(i * 10 + j, p0, 0.2) Next jNext iEnd SubSub createFrameDim()Dim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleDim pt(0 To 2) As Doubles = 500: num = 70p1(0) = s * numSet ln0 = ThisDrawing.ModelSpace.AddLine(p0, p1)For i = 0 Tonump0(0) = i * sp1(0) = i * s: p1(1) = 50If i Mod 5 = 0 Thenp1(1) = 150pt(0) = i * s: pt(1) = -200Set tt = ThisDrawing.ModelSpace.AddText(i, pt, 180)End IfSet ln = ThisDrawing.ModelSpace.AddLine(p0, p1)NextEnd SubSub createRegion()Dim ea(0 To 2) As AcadEntityDim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleDim p2(0 To 2) As Doublep1(1) = 1000p2(0) = 1500: p2(1) = 1000Set ln0 = ThisDrawing.ModelSpace.AddLine(p0, p1)Set ln1 = ThisDrawing.ModelSpace.AddLine(p1, p2)Dim pta(0 To 3 * 3 - 1) As Doublepta(3) = 1000: pta(4) = 500: pta(6) = 1500: pta(7) = 1000Set sp = ThisDrawing.ModelSpace.AddSpline(pta, p0, p0)Set ea(0) = ln0Set ea(1) = ln1Set ea(2) = sprega = ThisDrawing.ModelSpace.AddRegion(ea)Dim tt As StringDim cen As Variantcen = rega(0).Centroidtxt = "A=" &rega(0).Area & " LCG=" &cen(0)MsgBox (txt)End SubSub InsertBlock()Dim blockObj As AcadBlockDim pos(0 To 2) As DoubleSet blockObj = ThisDrawing.Blocks.Add(pos, "txy")Dim cen(0 To 2) As DoubleSet a = blockObj.AddCircle(cen, 50)Set b = blockObj.AddCircle(cen, 100)Set c = blockObj.AddCircle(cen, 150)Dim ref As AcadBlockReferencepos(0) = 2: pos(1) = 2Set ref = ThisDrawing.ModelSpace.InsertBlock(pos, "txy", 1, 1, 1, 0) ZoomAllEnd SubPublic Sub selectEntity()Dim obj As AcadObjectOn Error GoToendofsubThisDrawing.Utility.GetEntityobj, p1, "select a object please" obj.color = 1End SubSub TexttoPos()Dim tt As AcadTextWhile 1ThisDrawing.Utility.GetEntitytt, p1, "选择文本"tt.TextString = Format(tt.InsertionPoint(0), 0) & "," & Format(tt.InsertionPoint(1), 0) WendEnd SubPublic Sub SetPoint() '可以画直线Dim p1(0 To 2) As DoubleDim rp As VariantOn Error GoTotoExitWhile 1rp = ThisDrawing.Utility.GetPoint(p1, "选择点")ThisDrawing.ModelSpace.AddPoint (rp)Set ln = ThisDrawing.ModelSpace.AddLine(p1, rp)p1(0) = rp(0): p1(1) = rp(1)WendtoExit:End SubPublic Sub SetPoint2() '可以画splineDim p1(0 To 2) As DoubleDim rp As VariantOn Error GoToendofsubReDimpta(0 To 1000) As DoubleCount = 0While 1rp = ThisDrawing.Utility.GetPoint(p1, "选择下一点")ThisDrawing.ModelSpace.AddPoint (rp)pta(Count * 3) = rp(0): pta(Count * 3 + 1) = rp(1)Count = Count + 1Wendendofsub:ReDim Preserve pta(0 To Count * 3 - 1) As DoubleThisDrawing.ModelSpace.AddSplinepta, p1, p1End SubSub drawcoodinate()Dim rp As Variantrp = ThisDrawing.Utility.GetPoint(p1, "选择位置点") 'rp=thisdrawing.utility.getEntity p1,"选择位置点"Set tt = ThisDrawing.ModelSpace.AddText(Format(rp(0), 0) & "," & Format(rp(1), 0), rp, 50)End SubSub changecolor()Dim ss1 As AcadSelectionSetSet ss1 = ThisDrawing.SelectionSets.Add("set")ss1.SelectOnScreenFor Each element In ss1element.color = 1Nextss1.DeleteEnd SubPublic Sub multSelect()On Error GoTotoExitDim ss1 As AcadSelectionSetSet ss1 = ThisDrawing.SelectionSets.Add("set2")ss1.SelectOnScreenDim tt As AcadTextFor Each element In ss1Set tt = elementtt.TextString = Format(tt.InsertionPoint(0), 0) & "," & Format(tt.InsertionPoint(1), 0)Nextss1.DeletetoExit:End SubPublic Sub createSinCurve()num = 50PI = 3.1415Dim st(0 To 2) As DoubleDim et(0 To 2) As DoubleReDimpta(0 To num * 3 - 1) As DoubleDim splineObj As AcadSplineFor i = 0 Tonum - 1pta(i * 3) = i * 2 * PI / num: pta(i * 3 + 1) = Sin(pta(i * 3))NextSet splineObj = ThisDrawing.ModelSpace.AddSpline(pta, st, et)Public Sub getFixPoint()Dim pt(0 To 2) As DoubleDim spAsAcadSplineThisDrawing.Utility.GetEntitysp, p1, "选择一条曲线"For i = 0 Tosp.NumberOfFitPoints - 1pt(0) = sp.FitPoints(i * 3)pt(1) = sp.FitPoints(i * 3 + 1)pt(2) = sp.FitPoints(i * 3 + 2)Set point = ThisDrawing.ModelSpace.AddPoint(pt)point.color = 1NextEnd SubPublic Sub curveIntersections() '插一条曲线与一组曲线的交点Dim ss1 As AcadSelectionSetDim Obj2 AsAcadObjectDim pt(0 To 2) As DoubleDim ptaAs VariantOn Error GoToendfunSet ss1 = ThisDrawing.SelectionSets.Add("set3")ss1.SelectOnScreenThisDrawing.Utility.GetEntity Obj2, pt, "选择第二个实体"For Each element In ss1pta = Obj2.IntersectWith(element, acExtendNone)Count = (UBound(pta) + 1) / 3For i = 0 To Count - 1pt(0) = pta(i * 3): pt(1) = pta(i * 3 + 1)ThisDrawing.ModelSpace.AddPoint (pt)Next iNextendfun:End SubPublic Sub createlineplan()Dim ssAsAcadSelectionSetOn Error GoToendfunSet ss = ThisDrawing.SelectionSets.Add("set4")ss.SelectOnScreenlpp = 189Dim pt0(0 To 2) As DoubleDim pt1(0 To 2) As DoubleReDimpta(0 To 1000) As DoubleDim t0(0 To 2) As DoubleDim t1(0 To 2) As Doublet0(2) = -1For i = 0 To 20pt0(0) = i * lpp / 20: pt1(0) = pt0(0)pt1(1) = b / 2Set X1 = ThisDrawing.ModelSpace.AddXline(pt0, pt1)ptCount = 0For Each element Inssptx = X1.IntersectWith(element, acExtendNone)If UBound(ptx) <> 0 Thenpta(i * 3) = ptx(0): pta(i * 3 + 1) = element.lintypescale: pta(i * 3 + 2) = ptx(1) End IfptCount = ptCount + 1NextReDim Preserve pta(0 To ptCount * 3 - 1) As DoubleFor i = 0 ToptCount - 1For j = i ToptCount - 1ThisDrawing.ModelSpace.AddSplinepta, t0, t1X1.DeleteNext iendfun:End SubPublic Sub SplineToPolyline()ptNum = 100Dim spAsAcadSplineDim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleReDimpta(0 To (ptNum + 1) * 2 - 1) As DoubleThisDrawing.Utility.GetEntitysp, pt, vbCr& "选择一条样条曲线"X0 = sp.ControlPoints(0)X1 = sp.ControlPoints(3 * sp.NumberOfControlPoints - 3)For i = 0 ToptNump0(0) = X0 + (X1 - X0) / ptNum * i: p1(0) = p0(0)p1(1) = 1000Set xx = ThisDrawing.ModelSpace.AddXline(p0, p1)If UBound(ptb) > 1 Thenpta(i * 2) = p0(0): pta(i * 2 + 1) = ptb(1)End Ifxx.DeleteNextSet pl = ThisDrawing.ModelSpace.AddLightWeightPolyline(pta) pl.color = 2: sp.Visible = 0End SubPublic Sub derivative() '求导数Dim spAsAcadEntityDim rp As VariantDim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleDim p2(0 To 2) As DoubleDim p3(0 To 2) As DoubleThisDrawing.Utility.GetEntitysp, pt, "选择一条曲线"rp = ThisDrawing.Utility.GetPoint(, "选择所求导数的位置点") p0(0) = rp(0): p0(1) = rp(1)p1(0) = p0(0): p1(1) = rp(1) + 1000Set X1 = ThisDrawing.ModelSpace.AddXline(p0, p1)pta = X1.IntersectWith(sp, acExtendNone)X1.DeleteIf UBound(pta) > 1 Thenfx = pta(1)End Ifp2(0) = p0(0) + 0.01: p2(1) = p0(1)p3(0) = p2(0): p3(1) = p2(1) + 1000Set X2 = ThisDrawing.ModelSpace.AddXline(p2, p3)ptb = X2.IntersectWith(sp, acExtendNone)X2.DeleteIf UBound(ptb) > 1 Thenfxx = ptb(1)End Iff = (fxx - fx) / 0.01MsgBox fEnd SubPublic Sub drawtangent()Dim pl As AcadLWPolylineDim lnAsAcadLineDim px(0 To 2) As Doublemin = 10000#On Error GoTotoExitThisDrawing.Utility.GetEntitypl, p1, "选择一条多义线"ThisDrawing.Utility.GetEntityln, p2, "选择一条直线"x0 = ln.StartPoint(0): y0 = ln.StartPoint(1)x1 = ln.EndPoint(0): y1 = ln.EndPoint(1)k = (y1 - y0) / (x1 - x0): A = k: B = -1: C = y0 - kx0num = (UBound(pl.Coordinates) + 1) / 2For i = 0 Tonum - 1dis = (A * pl.Coordinates(i * 2) + B * pl.Coordinates(i * 2 + 1) + C) / Sqr(A * A + B * B) If dis < min Thenmin = dispt(0) = pl.Coordinates(i * 2): pt(1) = pl.Coordinates(i * 2 + 1)End IfNext ipx(0) = pt(0) + 1: px(1) = pt(1) + kSet xl = ThisDrawing.ModelSpace.AddXline(pt, px)xl.color = 3Set p = ThisDrawing.ModelSpace.AddPoint(pt)p.color = 3toExit:If Err.Description<> "" ThenMsgBoxErr.DescriptionEnd IfEnd SubPublic Sub intergralCurve()Dim pl As AcadLWPolylineReDimpta(0 To 10000 * 3 - 1) As DoubleDim t(0 To 2) As DoubleThisDrawing.Utility.GetEntitypl, "选择一条多义线"ptnum = (UBound(pl.Coordinates) + 1) / 2pta(0) = pl.Coordinates(0)For i = 1 Toptnum - 1x0 = pl.Coordinates((i - 1) * 2): x1 = pl.Coordinates(i * 2)h0 = pl.Coordinates((i - 1) * 2 + 1): h1 = pl.Coordinates(i * 2 + 1)pta(3 * i) = x0: pta(3 * i + 1) = 1 / 2 * (h0 + h1) * (x1 - x0)NextReDim Preserve pta(0 To ptnum * 3 - 1)Set sp = ThisDrawing.ModelSpace.AddSpline(pta, t, t)Public Sub hide()Dim ssAsAcadSelectionSetSet ss = ThisDrawing.SelectionSets.Add("set") ss.SelectOnScreenFor Each element Insselement.Visible = 0Nextss.DeleteEnd SubPublic Sub show()Dim ent As AcadEntityFor Each ent In ThisDrawing.ModelSpace ent.Visible = 1NextEnd SubPublic Sub showBySelectionSet() '有点问题Set ss = ThisDrawing.SelectionSets.Item("set") For Each element Insselement.Visible = 1Nextss.DeleteEnd SubPublic Sub showBycolor()Dim ent As AcadEntityFor Each ent In ThisDrawing.ModelSpaceIf ent.color = 1 Thenent.Visible = 1End IfNextEnd SubPublic Sub showhide()Dim ent As AcadEntityFor Each ent In ThisDrawing.ModelSpaceIf ent.Visible = 0 Thenent.Visible = 1ElseEnd IfNextEnd SubSub secProp()Dim AsumAs DoubleDim MsumAs DoubleDim IsumAs DoubleDim lnAsAcadLineyd = 0For Each lnInThisDrawing.ModelSpacex0 = ln.StartPoint(0): x1 = ln.EndPoint(0)y0 = ln.StartPoint(1): y1 = ln.EndPoint(1)If y0 >yd Then yd = y0If y1 >yd Then yd = y1If y0 = y1 = 0 Thenym = t / 2Elseym = 1 / 2 * (y1 + y0)End Ifl = Sqr((y1 - y0) ^ 2 + (x1 - x0) ^ 2)t = ln.LinetypeScaleA = l * tM = A * ymIf Abs(x0 - x1) < 0.00001 ThenI = 1 / 3 * t * Abs(y1 ^ 3 - y0 ^ 3)Elsek = (y1 - y0) / (x1 - x0): b = y0 - k * x0I = t * Sqr(1 + k ^ 2) * Abs((1 / 3 * k ^ 2 * x1 ^ 3 + k * b * x1 ^ 2 + b ^ 2 * x1) - (1 / 3 * k ^ 2 * x0 ^ 3 + k * b * x0 ^ 2 + b ^ 2 * x0))End IfAsum = Asum + AMsum = Msum + MIsum = Isum + INextyc = Msum / AsumIa = Isum - Asum * yc ^ 2Wb = Ia / ycWd = Ia / (yd - yc)MsgBox "A=" & Format(Asum, ".00") & " M=" & Format(Msum, ".00") & " Yc=" & Format(yc, ".00") & " I=" & Format(Ia, ".00") & " Wd=" & Format(Wd, ".00") & " Wb=" & Format(Wb, ".00")Sub OneplusCp()‘未试验，可能有错Lpp0 = 186: Lpp = 189B0 = 34: B = 35dCpf = 0.0012: dCpa = -0.0003Cpf0 = 0.76: Cpa0 = 0.54Dim p0(0 To 2) As DoubleDim p1(0 To 2) As DoubleDim pta(0 To 21 * 2 - 1) As DoubleOn Error GoTotoExitDim ssAsAcadSelectionSetSet ss = ThisDrawing.SelectionSets.Add("wl")ss.SelectOnScreenDim pl As AcadLWPolylineFor Each pl In ssFor i = 0 To 20x0 = i / 10 - 1p0(0) = (x0 + 1) * Lpp0 / 2: p1(0) = p0(0)p1(1) = 1000Set xx = ThisDrawing.ModelSpace.AddXline(p0, p1) ptx = xx.IntersectWith(pl, acExtendNone)xx.DeleteIf UBound(ptx) <> 0 Then y0 = ptx(1) / B0If x0 > 0 Thendx = dCpf / (1 - Cpf0) * (1 - x)Elsedx = -dCpa / (1 - Cpa0) * (1 + x)End Ifx1 = x0 + dx: y1 = y0 * Bpta(i * 2) = (x1 + 1) * Lpp / 2pta(i * 2 + 1) = y1ThisDrawing.ModelSpace.AddLightWeightPolyline (pta) Next iNexttoExit:If Err.Description<> "" Then MsgBox (Err.Description) End SubSub setMesh()Dim ssAsAcadSelectionSetOn Error GoTotoExitSet ss = ThisDrawing.SelectionSets.Add("sp")ss.SelectOnScreenDim spAsAcadSplineDim p0(0 To 2) As DoubleDim p1(0 To 2) As Doublem = ss.Countn = 10ReDimpmn(0 To m * n * 3 - 1) As Doublei = 0For Each spInssx0 = sp.ControlPoints(0): x1 = sp.ControlPoints(3 * sp.NumberOfControlPoints - 3)dis = (x1 - x0) / (n - 1)For j = 0 To n - 1p0(0) = x0 + dis * j: p0(1) = 0p1(0) = p0(0): p1(1) = 1000Set xxx = ThisDrawing.ModelSpace.AddXline(p0, p1)ptx = xxx.IntersectWith(sp, acExtendNone)pmn(i * n * 3 + j * 3) = ptx(0): pmn(i * n * 3 + j * 3 + 1) = ptx(1): pmn(i * n * 3 + j * 3 + 2) = sp.LinetypeScalexxx.DeleteNext ji = i + 1NextSet mesh = ThisDrawing.ModelSpace.Add3DMesh(m, n, pmn)mesh.color = acBluetoExit:If Err.Description<> "" Then MsgBox (Err.Description)End Sub。

Vb大作业程序设计目的：将理论教学中涉及到的知识点贯穿起来，对不同的数据类型、程序控制结构、数据结构作一比较和总结，结合设计题目进行综合性练习，以达到对所学知识熟练掌握、灵活应用的目的。

1．对于自己所设想的vb程序进行分析、理解，以做到思路清晰。

2．掌握自顶而下的设计方法，将大问题进行模块化分解，领会结构化程序设计的方法，同时深刻认识到面向对象程序设计与面向过程程序设计的根本区别。

3．熟练掌握VB常用控件的使用，灵活运用各种数据类型。

4．学会运用函数进行程序设计。

5．进一步掌握在集成环境下调试程序和修改程序的方法和技巧。

程序设计思路：了解六十个学生的成绩情况：程序界面包括，一个Form显示六十个学生的成绩情况，包括六十个学生的最高分、最低分、平均分、及格人数和优秀人数，五个Label显示各个项目情况的标题，对应五个text作为学生成绩情况显示框，两个command按钮分别用于开始输入六十个学生的成绩和退出程序。

1.在窗体中添加五个label，五个textbox和两个command按钮。

2.编辑各个控件属性。

3.编辑程序代码，运用循环结构输入学生成绩，并使用数组使程序设计和运行简单化。

4.试运行vb程序，对错误代码进行调试和完善，使程序可运行并符合逻辑思路。

代码注释：Private Sub Command1_Click()Dim val(1 To 60) As IntegerDim pass%, good%, i%, j%, temp%, sum%'输入60个学生的成绩For i = 1 To 60val(i) = InputBox("输入第" & i & "个学生的成绩：")'计算总成绩sum = sum + val(i)'计算及格(大于60分)人数和优秀(大于90分)人数If val(i) > 59 Then pass = pass + 1If val(i) > 89 Then good = good + 1Next i'对60个学生成绩按从小到大排序For i = 1 To 60For j = i + 1 To 60If val(i) > val(j) Thentemp = val(i): val(i) = val(j): val(j) = tempEnd IfNext jNext iText1 = val(1) '最低分Text2 = val(60) '最高分Text3 = sum / 60 '平均分Text4 = pass '及格人数Text5 = good '优秀人数End SubPrivate Sub Command2_Click()EndEnd Sub'结束程序运行功能：1.操作项目包括：输入数组，求数组最大值，最小值，平均值，及格人数和优秀人数。