《2022年VB小程序源代码 .pdf》由会员分享，可在线阅读，更多相关《2022年VB小程序源代码 .pdf（5页珍藏版）》请在taowenge.com淘文阁网|工程机械CAD图纸|机械工程制图|CAD装配图下载|SolidWorks_CaTia_CAD_UG_PROE_设计图分享下载上搜索。
1、VB小程序1 复制粘贴Private Sub Command1_Click() Clipboard.SetText Text1.SelText End Sub Private Sub Command2_Click() Text2.SelText = Clipboard.GetText End Sub 上海问题Private Sub Command1_Click() If Option3.Value = True Then Text1 = You are right Else Text1 = You are wrong End If End Sub 中心问题Private Sub Form_Re
2、size() Command1.Left = (Form1.ScaleWidth - Command1.Width) / 2 Command1.Top = (Form1.ScaleHeight - Command1.Height) / 2 Command1.Width = 0.2 * Form1.ScaleWidth End Sub 曲线问题Private Sub Form_Paint() Scale (0, 0)-(3000, 3000) Form1.DrawWidth = 5 Form1.ForeColor = RGB(255, 0, 0) Line (0, 1500)-(3000, 15
3、00) Line (1500, 0)-(1500, 3000) Circle (1500, 1500), 35 For x = 0 To 3000 y = 1500 - 200 * (Sin(x - 1500) * 3.1415926 / 180) PSet (x, y) Next x End Sub 查找Private Sub Command1_Click() a = InStr(1, Text1, Text2) Text1.SelStart = a - 1 Text1.SelLength = Len(Text2) Text1.SetFocus 名师资料总结 - - -精品资料欢迎下载 -
4、- - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 1 页，共 5 页 - - - - - - - - - VB小程序2 End Sub Private Sub Text1_Change() End Sub 改变字体Private Sub Check1_Click() If Check1.Value = 1 Then Text1.Font.Name = 隶书 Else Text1.Font.Name = 宋体 End If End Sub Private Sub Check2_Click() If Check2.Value = 1
5、Then Text1.Font.Bold = True Else Text1.Font.Bold = False End If End Sub Private Sub Check3_Click() If Check3.Value = 1 Then Text1.Font.Italic = True Else Text1.Font.Italic = False End If End Sub Private Sub Check4_Click() If Check4.Value = 1 Then Text1.ForeColor = vbRed Else Text1.ForeColor = vbBlue
6、 End If End Sub 同步Private Sub Text1_Change() Text2 = Text1.Text End Sub Private Sub Text2_Change() Text1 = Text2.Text End Sub Sin 函数Private Sub Form_Paint() 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 2 页，共 5 页 - - - - - - - - - VB小程序3 Scale (0, 0)-(2000, 2000) PS
7、et (1000, 1000) Line (1000, 0)-(950, 50) Line (1050, 50)-(1000, 0) Line (1950, 950)-(2000, 1000) Line (1950, 1050)-(2000, 1000) Line (0, 1000)-(2000, 1000) Line (1000, 0)-(1000, 2000) Circle (1000, 1000), 50 For x = 0 To 2000 y = 1000 - 300 * (Sin(x - 1000) * 3.1415926 / 180) PSet (x, y) Next x End
8、Sub 考试程序Private Sub Command1_Click() If Option3.Value = True Then Text1 = 正确 Else Text1 = 错误 End If End Sub Private Sub Form_Load() End Sub 复制粘贴查找替换Private Sub Command1_Click() Clipboard.SetText Text1.SelText End Sub Private Sub Command2_Click() Text2.SelText = Clipboard.GetText End Sub Private Sub
9、Command3_Click() a = InStr(1, Text1, Text3) Text1.SelStart = a - 1 Text1.SelLength = Len(Text3) Text1.SetFocus End Sub Private Sub Command4_Click() Text1.SelText = Text4 End Sub 图片路径名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 3 页，共 5 页 - - - - - - - - - VB小程序4 Pri
10、vate Sub Dir1_Change() File1.Path = Dir1.Path End Sub Private Sub Drive1_Change() Dir1.Path = Drive1.Drive End Sub Private Sub File1_Click() Picture1.Picture = LoadPicture(File1.Path + File1.FileName) End Sub Private Sub Form_Load() End Sub 改变字体颜色Private Sub Check1_Click() If Check1.Value = 1 Then T
11、ext1.Font.Name = 隶书 Else Text1.Font.Name = 宋体 End If End Sub Private Sub Check2_Click() If Check2.Value = 1 Then Text1.Font.Bold = True Else Text1.Font.Bold = False End If End Sub Private Sub Check3_Click() If Check3.Value = 1 Then Text1.Font.Italic = True Else Text1.Font.Italic = False End If End S
12、ub Private Sub Check4_Click() If Check4.Value = 1 Then Text1.ForeColor = vbRed Else Text1.ForeColor = vbBlack End If End Sub Private Sub Form_Load() End Sub Private Sub Text1_Change() 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 4 页，共 5 页 - - - - - - - - - VB小程序5 E
13、nd Sub 兴趣选择Private Sub Command1_Click() Text1 = If Check1.Value = 1 Then Text1 = Text1 & Check1.Caption End If If Check2.Value = 1 Then Text1 = Text1 & Check2.Caption End If If Check3.Value = 1 Then Text1 = Text1 & Check3.Caption End If If Check4.Value = 1 Then Text1 = Text1 & Check4.Caption End If
14、End Sub Private Sub Form_Load() End Sub 1. 求三角形的面积代码：Option Explicit Dim a!,b!,c!r,!,s! Private Sub Command1_Click() a = InputBox(a=, 请输入 a 的数值 ) b = InputBox(b=, 请输入 b 的数值 ) c = InputBox(c=, 请输入 c 的数值 ) If a + b c And a + c b And b + c a And a 0 And b 0 And c 0 Then r = 1 / 2 * (a + b + c) s = Sqr(r * (r - a) * (r - b) * (r - c) Label1.Caption = 三角形的面积为 & s Else Label2.Caption = 输入的数据不能构成三角形 End If End Sub 名师资料总结 - - -精品资料欢迎下载 - - - - - - - - - - - - - - - - - - 名师精心整理 - - - - - - - 第 5 页，共 5 页 - - - - - - - - -