Private Sub Command1_Click() Text3 = Val(Text1) + Val(Text2) End Sub
Private Sub Command2_Click() Text1 = \"\" Text2 = \"\" Text3 = \"\"
Text1.SetFocus End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End Sub 02.字幕放大
Private Sub Command1_Click()
If Command1.Caption = \"开始\" Then Command1.Caption = \"停止\" Timer1.Enabled = True Else
Command1.Caption = \"开始\" Timer1.Enabled = False End If
End Sub
Private Sub Form_Load()
Label1.Left = (Form1.ScaleWidth - Label1.Width) \\ 2 Label1.Top = (Form1.ScaleHeight - Label1.Height) \\ 2 End Sub
Private Sub Timer1_Timer()
Label1.FontSize = Label1.FontSize + 2 Form_Load End Sub 03.字幕闪烁
Private Sub Command1_Click()
If Command1.Caption = \"开始\" Then Command1.Caption = \"停止\" Timer1.Enabled = True Else
Command1.Caption = \"开始\" Timer1.Enabled = False End If End Sub
Private Sub Timer1_Timer()
Static at As Boolean If at Then
Label1.ForeColor = RGB(255, 0, 0) at = Not at Else
Label1.ForeColor = RGB(, 0, 0, 255) at = Not at End If End Sub 04.字幕滚动
Private Sub Command1_Click()
If Command1.Caption = \"开始\" Then Command1.Caption = \"停止\" Timer1.Enabled = True Else
Command1.Caption = \"开始\" Timer1.Enabled = False End If End Sub
Private Sub Timer1_Timer()
If Label1.Left >= Form1.ScaleWidth Then Label1.Left = -Label1.Width Else
Label1.Left = Label1.Left + 100 End If End Sub 05.调色板
Private Sub Command1_Click()
Label4.ForeColor = Shape1.FillColor End Sub
Private Sub Form_Load()
Label4.Left = (Form1.ScaleWidth - Label4.Width) \\ 2 End Sub
Private Sub HScroll1_Change()
Shape1.FillColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) End Sub
Private Sub HScroll2_Change()
Shape1.FillColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) End Sub
Private Sub HScroll3_Change()
Shape1.FillColor = RGB(HScroll1.Value, HScroll2.Value, HScroll3.Value) End Sub 06.健康称
Private Sub Command1_Click()
Dim bz As Integer bz = Text1 - 105
If Text2 > bz * 1.1 Then
Label5.Caption = \"偏胖，注意节食\" Else
If Text2 < bz * 0.9 Then
Label5.Caption = \"偏瘦，注意营养\" Else
Label5.Caption = \"正常，继续保持\" End If End If
End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End Sub
Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii < 48 Or KeyAscii > 57 Then KeyAscii = 0 End Sub 07.字体修饰
Private Sub Check1_Click(Index As Integer) If Index = 0 Then
Label1.FontBold = Not Label1.FontBold Else
Label1.FontItalic = Not Label1.FontItalic End If End Sub
Private Sub Option1_Click(Index As Integer) If Index = 0 Then
Label1.FontName = \"宋体\" Else
Label1.FontName = \"楷体_GB2312\" End If End Sub 08.反弹球
Private Sub qd_Click() Timer1.Enabled = True End Sub
Private Sub Timer1_Timer() Static a1 As Boolean Static b1 As Boolean
If Shape1.Left >= Form1.ScaleWidth - Shape1.Width Then a1 = True End If
If Shape1.Left <= 0 Then
a1 = False End If If a1 Then
Shape1.Left = Shape1.Left - 100 Else
Shape1.Left = Shape1.Left + 100
End If
If Shape1.Top >= Form1.ScaleHeight - Shape1.Height Then b1 = True
End If
If Shape1.Top <= 0 Then b1 = False End If
If b1 Then
Shape1.Top = Shape1.Top - 100 Else
Shape1.Top = Shape1.Top + 100 End If End Sub
Private Sub tz_Click() Timer1.Enabled = False End Sub 09.密码检验
Private Sub Form_Load()
Label2.Left = (Form1.ScaleWidth - Label2.Width) \\ 2 End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) Static a
If KeyAscii = 13 Then
If Text1.Text = \"1234567\" Then
Label2.Caption = \"欢迎光临！\" Label2.ForeColor = RGB(255, 0, 0) Text1.Enabled = False
Else
If a = 0 Then
Label2.Caption = \"密码不符，请再输入一遍！\" Text1.Text = \"\" Text1.SetFocus a = a + 1
Else
Label2.Caption = \"非法用户，请退出程序\" Text1.Text = \"\"
Text1.Enabled = False
End If End If End If End Sub
10.添加和删除
Private Sub Command1_Click()
If Text1.Text = \"\" Then
MsgBox \"没有内容，不予添加\" Else
List1.AddItem Text1.Text, 0 End If End Sub
Private Sub Command2_Click() Dim i
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For End If Next i
If i > List1.ListCount - 1 Then
MsgBox \"请选择输出的项目\" Else
List1.RemoveItem i End If End Sub
Private Sub List2_Click()
List2.RemoveItem List2.ListCount - 1 End Sub 11.图片欣赏
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(Dir1.Path + \"\\\" + File1.FileName) End Sub 12.字体设置
Private Sub bjys_Click() Cg1.ShowColor
Text1.BackColor = Cg1.Color End Sub
Private Sub wzys_Click()
Cg1.ShowColor
Text1.ForeColor = Cg1.Color End Sub
Private Sub zt_Click() Cg1.Flags = 257 Cg1.ShowFont
If Cg1.FileName <> \"\" Then
Text1.FontName = Cg1.FileName End If End Sub 13.电子时钟
Private Sub Form_Load() Label1.Caption = Time End Sub
Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Timer2.Enabled = True Text1.Enabled = False End If End Sub
Private Sub Timer1_Timer() Label1.Caption = Time End Sub
Private Sub Timer2_Timer() Static a, b
If DateDiff(\"s\ b = 1
End If
If a = 0 And b Then
Label1.BackColor = RGB(255, 0, 0) a = 1 Else
Label1.BackColor = RGB(255, 255, 255) a = 0 End If End Sub 14.改变大小
Private Sub Form_Load()
Shape1.Left = (Form1.ScaleWidth - Shape1.Width) \\ 2 Shape1.Top = (Form1.ScaleHeight - Shape1.Height) \\ 2 - 800 End Sub
Private Sub HScroll1_Scroll() Shape1.Height = HScroll1.Value Shape1.Width = HScroll1.Value
label2.Caption = HScroll1.Value Form_Load End Sub 15.拨号盘 Dim s1
Private Sub Command1_Click(index As Integer) If index <> 10 Then
Text1.Text = Text1.Text & Command1(index).Caption Else
Timer1.Enabled = True s1 = Text1 Text1 = \"\" End If End Sub
Private Sub Form_Load() Dim i, k
For i = 1 To 10
Load Command1(i) If i Mod 3 = 0 Then
Command1(i).Left = Command1(i - 3).Left Command1(i).Top = Command1(i - 3).Top + 600 Else
Command1(i).Left = Command1(i - 1).Left + 800 Command1(i).Top = Command1(i - 1).Top End If
If i = 9 Then
Command1(i).captin = \"0\" ElseIf i = 10 Then
Command1(i).Caption = \"重拨\" Else
Command1(i).Caption = i + 1 End If
If i = 10 Then
Command1(i).Width = Command1(i).Width + 800 End If
Command1(i).Visible = True Next i
Text1.ForeColor = RGB(0, 0, 255) End Sub
Private Sub Timer1_Timer() Static i
Dim st1 As String
st1 = Mid(s1, i + 1, 1)
i = i + 1
Text1.Text = Text1.Text & st1
If Text1.Text = s1 Then Timer1.Enabled = False: i = 0 End Sub 16.倒计时 Dim a%, b%, c
Private Sub Command1_Click() Frame1.Enabled = False Timer1.Enabled = True Command1.Enabled = False End Sub
Private Sub Option1_Click(index As Integer) If index = 0 Then a = 1
Elself index = 1 Then a = 5 Else a = 10 End If
Command1.Enabled = True End Sub
Private Sub Timer1_Timer() If b = 0 And a <> 0 Then a = a - 1 b = 60 End If
b = b - 1
Label1.Caption = a & \"分\" & b & \"秒\" If a = 0 And b = 0 Then Frame1.Enabled = True Timer1.Enabled = False Label1.Caption = \"时间到!\" End If End Sub 17.画板
Dim flag As Boolean Dim prex As Single Dim prey As Single
Private Sub Command1_Click() Cg1.showcolor
Picture1.ForeColor = Cg1.Color End Sub
Private Sub Command2_Click() Picture1.Cls End Sub
Private Sub Form_Load() Picture1.DrawWidtn = 1 End Sub
Private Sub Option1_Click() Picture1.DrawWidtn = 1 End Sub
Private Sub Option2_Click() Picture1.DrawWidtn = 5 End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then flag = True prex = X prey = Y
End If End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If flag = True Then
Picture1.Line (prex, prey)-(X, Y) prex = X prey = Y End If End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 1 Then flag = False End If
End Sub 18.作图
Private Sub Command1_Click() Picture1.Scale (-10, 10)-(10, -10) Picture1.CurrentX = 0 Picture1.CurrentY = 0 Picture1.Print \"(0,0)\"
Picture1.Line (-10, 0)-(10, 0)
Picture1.Line (0, -10)-(0, 10) End Sub
Private Sub Command2_Click() Picture1.FillStyle = 0
Picture1.FillColor = RGB(0, 255, 0) Picture1.DrawWidth = 2
Picture1.Circle (0, 0), 5, RGB(255, 0, 0), -3.1415 / 6, -3.1415 * 5 / 6 End Sub
Private Sub Command3_Click() End End Sub 19.格式设置
Private Sub Combo1_Click() Select Case Combo1.ListIndex Case 0
Text1.Alignment = 0 Case 1
Text1.Alignment = 2 Case 2
Text1.Alignment = 1 End Select End Sub
Private Sub Combo2_Click() Select Case Combo2.ListIndex Case 0
Text1.FontItalic = False Text1.FontBold = False Case 1
Text1.FontItalic = True Text1.FontBold = False Case 2
Text1.FontBold = True Text1.FontItalic = False Case 3
Text1.FontItalic = True Text1.FontBold = True End Select End Sub 20.偶数迁移
Dim a(10)
Private Sub Command1_Click()
Dim i List1.Clear List2.Clear Randomize For i = 0 To 9
a(i) = Int(Rnd * 9 + 10) List1.AddItem a(i) Next i End Sub
Private Sub Command2_Click() Dim i, k
Do While i <= List1.ListCount - 1 If Val(List1.List(i)) Mod 2 = 0 Then List2.AddItem List1.List(i) List1.RemoveItem i Else
i = i + 1 End If Loop End Sub 21.点餐
Private Sub Check1_Click(index As Integer) Text1(index).Enabled = Check1(index).Value If Check1(index) = 1 Then Text1(index).SetFocus Else
Text1(index).Text = \"\" End If End Sub
Private Sub Command1_Click()
Dim a% a = 13 * Val(Text1(0).Text) + 18 * Val(Text1(1).Text) + 25 * Val(Text1(2).Text) MsgBox \"一共\" & a & \"元\" End Sub 22.替换
Private Sub Command1_Click() Dim st1$, st2$, st3$, len2, len3, i i = 1 st1 = Text1 st2 = Text2 st3 = Text3 len2 = Len(st2)
len3 = Len(st3)
k = InStr(i, st1, st2) Do While k > 0
st1 = Left(st1, k - 1) & st3 & Mid(st1.k + len2) k = InStr(k + len3, st1, st2) Loop
Text1.Text = st1 End Sub 23.编辑
Dim str1 As String
Private Sub Command1_Click() str1 = Text1.SelText End Sub
Private Sub Command2_Click() str1 = Text1.SelText Text1.SelText = \"\" End Sub
Private Sub Command3_Click() Text1.SelText = str1
End Sub
Private Sub Command4_Click() Text1.SelText = \"\" End Sub
第25题。心想事成
Private Sub Form_Load()
Label1.Left = (Form1.ScaleWidth - Label1.Width) \\ 2 End Sub
Private Sub HScroll1_Change() Label1.FontSize = HScroll1.Value Text1.Text = HScroll1.Value Form_Load End Sub
Private Sub hscroll1_scroll() Label1.FontSize = HScroll1.Value Text1.Text = HScroll1.Value
Form_Load
End Sub
Private Sub Text1_Change() Dim a% a = Text1.Text
If a >= 12 And a <= 72 Then Label1.FontSize = a HScroll1.Value = a End If
End Sub
第26题。收款计算
Private Sub Command1_Click() Text1.Text = \"\" Text2.Text = \"\" Text3.Text = \"\" Text1.SetFocus End Sub
Private Sub Command2_Click() Dim a As Single, b As Single a = Text1 b = Text2
Text3.Text = a * b End Sub
第27题 计算机
Private Sub Check1_Click()
Combo1.Enabled = Not Combo1.Enabled Text1.Enabled = Not Text1.Enabled End Sub
Private Sub Check2_Click()
Option1.Enabled = Not Option1.Enabled Option2.Enabled = Not Option2.Enabled End Sub
Private Sub Command1_Click() Dim str1$
Label3.Caption = \"\" If Check1.Value = 1 Then
str1 = Combo1.Text + Chr(13) + Text1.Text
End If
If Check2.Value = 1 Then If Option1 Then
str1 = str1 + Option1.Caption End If
If Option2 Then
str1 = str1 + Option2.Caption End If End If
Label3.Caption = str1 End Sub
28题 简单动画演示
Private Sub Command1_Click() Timer1.Enabled = True End Sub
Private Sub Command2_Click() Timer1.Enabled = False End Sub
Private Sub Form_Load() Dim i
For i = 1 To 5
Load Label2(i)
Label2(i).Left = Label2(i - 1) + Label2(0).Width Next i End Sub
Private Sub Timer1_Timer() Static k Dim i
For i = 1 To 5
Label2(i).Visible = False Next i
Label2(k).Visible = True k = (k + 1) Mod 6 End Sub
29题 文本浏览器 Private Sub dir1_change() file1.Path = dir1.Path End Sub
Private Sub drive1_change() dir1.Path = drive1.Drive End Sub
Private Sub file1_click() Dim st1
sti = Right(dir1.Path, 1)
If st1 = \"\\\" Then
Text1 = dir1.Path + file1.FileName Else
Text1 = dir1.Path + \"\\\" + file1.FileName End If
Open Text1 For Input As #1 Text2.Text = Input(LOF(1), 1) Close #1 End Sub
Private Sub file1_Dblclick() Dim i
i = Shell(\"c:\\windows\\system32\\notepad.exe\" & \"text1.text,1\") End Sub
30题 开始 结束
Private Sub Command1_Click() Dim x, k, i, temp, c() As String x = Text1 k = Len(x)
ReDim c(k) As String For i = 1 To k
c(i) = Mid(x, i, 1) Next i
For i = 1 To k - 1
For j = i + 1 To k
If c(i) > c(j) Then temp = c(i) c(i) = c(j) c(j) = temp End If Next j Next i
For i = 1 To k Print c(i)
Next i
Command1.Enabled = False End Sub
Private Sub Command2_Click() End
End Sub
31题 欢迎您的使用，结束 Private Sub Command1_Click() End End Sub
Private Sub HScroll1_Change() Label1.Left = HScroll1.Value End Sub
Private Sub HScroll1_scroll() Label1.Left = HScroll1.Value End Sub
32题今天是
Private Sub Command1_Click() End End Sub
Private Sub Option1_Click()
Text1.Text = \"今天是星期\" & Weekday(Date) - 1 End Sub
Private Sub Option2_Click()
Text1.Text = \"今天是\" & Year(Date) & \"年\" End Sub
Private Sub Option3_Click()
Text1.Text = \"今天是\" & Month(Date) & \"月\" End Sub
Private Sub Option4_Click()
Text1 , Text = \"今天是\" & Day(Date) & \"号\" End Sub
33题 添加 删除 姓名 地址 邮编 Dim a(1000), b(1000), c(1000), d(1000) Dim i
Private Sub Combo1_Change() i = Combo1.ListIndex Text1(0).Text = a(i) Text1(1).Text = b(i) Text1(2).Text = c(i) Text1(3).Text = d(i) End Sub
Private Sub Command1_Click()
If Text1(0).Text = \"\" Then
MsgBox \"请输入要添加的内容\警告\" Else
Combo1.AddItem Text1(0).Text a(i) = Text1(0).Text b(i) = Text1(1).Text c(i) = Text1(2).Text d(i) = Text1(3).Text i = i + 1
Text1(0).Text = \"\" Text1(1) = \"\" Text1(2) = \"\" Text1(3) = \"\" End If End Sub
Private Sub Command2_Click() If Combo1.Text = \"\" Then
msgox \"请选择要删除的项目\警告\" Else
i = Combo1.ListIndex
Combo1.RemoveItem Combo1.ListIndex Combo1.Text = \"\" Text1(0).Text = \"\" Text1(1).Text = \"\" Text1(2).Text = \"\" Text1(3).Text = \"\" End If
34题 > 》 《 <
Private Sub Command1_Click() Dim i
For i = 0 To List1.ListCount - 1
If List1.Selected(i) = True Then Exit For Next i
If i > List1.ListCount - 1 Then
MsgBox \"请选择一表项\警告\" Else
List2.AddItem List1.Text
List1.RemoveItem List1.ListIndex End If End Sub
Private Sub Command2_Click() Dim i
Do While i <= List1.ListIndex - 1 List2.AddItem List1.List(i) List1.AddItem i Loop End Sub
Private Sub Command3_Click() Dim i
For i = 0 To List2.ListCount - 1
If List2.Selected(i) = True Then Exit For Next i
If i > List2.ListCount - 1 Then
MsgBox \"你没有选择列表框2的选项,请选择！\警告\" Else
List1.AddItem List2.Text List2.RemoveItem List2.ListIndex End If
End Sub
Private Sub Command4_Click() Dim i
For i = 0 To List2.ListCount - 1 List1.AddItem List2.List(i) Next i List2.Clear End Sub
Private Sub Command5_Click() End End Sub
35题 最大化
Private Sub cmdmaxsize_Click()
If cmdmaxsize.Caption = \"最大化(&L)\" Then Form1.WindowState = 2
cmdmaxsize.Caption = \"还原（&B）\" Else
Form1.WindowState = 0
cmdmaxsize.Caption = \"最大化(&L)\" End If Form_Load End Sub
Private Sub Form_Load()
cmdmaxsize.Left = (Form1.ScaleWidth - cmdmaxsize.Width) \\ 2 cmdmaxsize.Top = (Form1.ScaleHeight - cmdmaxsize.Height) \\ 2 End Sub
36题 新密码
Private Sub Command1_Click()
If Text1.Text = \"admin\" And Text2.Text = \"admin\" Then If Text3.Text = Text4.Text Then
MsgBox \"修改密码成功\修改密码\" End
Else
MsgBox \"新密码有误,请重试\修改密码\" End If End Sub
Private Sub Command2_Click() End End Sub
37题 高数英语计算机 平均成绩
Private Sub Text1_Change() Text4 = Trim(Str((Val(Text1) + Val(Text2) + Val(Text3)) / 3)) End Sub
Private Sub Text1_keypress(keyascii As Integer) If keyascii < 48 Or keyascii > 57 Then keyascii = 0 End Sub
Private Sub Text2_Change()
Text4 = Trim(Str((Val(Text1) + Val(Text2) + Val(Text3)) / 3)) End Sub
Private Sub Text2_keypress(keyascii As Integer)
If keyascii < 48 Or keyascii > 57 Then keyascii = 0 End Sub
Private Sub Text3_keypress(keyascii As Integer) If keyascii < 48 Or keyascii > 57 Then keyascii = 0 End Sub
Private Sub Text3_Change()
Text4 = Trim(Str((Val(Text1) + Val(Text2) + Val(Text3)) / 3)) End Sub
38 题判断质数
Private Sub Command1_Click()
Dim a%, i%
If Not isnumberc(Text1) Then
MsgBox \"输入的不是数字，无法计算\" Else
a = Text1
For i = 2 To Int(Sqr(a))
If a Mod 2 = 0 Then Exit For Next i
If i > Int(Sqr(a)) Then
Label3.Caption = a & \"是质数\" Else
Label3.Caption = a & \"不是质数\" End If
End If
If Text1 = \"1\" Then Label3.Caption = a & \"不是质数\" End Sub
因篇幅问题不能全部显示，请点此查看更多更全内容