VB小程序源代码

VB小程序源代码 VB小程序 复制粘贴 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_Resize() 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, 1500) 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 1 VB小程序 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 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 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 VB小程序 Scale (0, 0)-(2000, 2000) PSet (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 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 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 VB小程序 Private 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 Text1.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 Sub 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 VB小程序 End 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 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