文本实例
Private Sub Command1_Click()
For i = 0 To 2
If Option1(i).Value = True Then
Text1.FontName = Option1(i).Caption
End If
Next i
If Option4(0).Value = True Then Text1.ForeColor = vbRed
If Option4(1).Value = True Then Text1.ForeColor = vbYellow
If Option4(2).Value = True Then Text1.ForeColor = vbBlue
For i = 0 To 2
If Option7(i).Value = True Then
Text1.FontSize = Val(Option7(i).Caption)
End If
Next i
Text1.FontBold = Check1.Value
Text1.FontItalic = Check2.Value
Text1.FontUnderline = Check3.Value
Text1.FontStrikethru = Check4.Value
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
列表操作1
Private Sub Command1_Click()
Dim x As String
x = InputBox("请输入城市名称", , 0)
List1.AddItem x
Label3.Caption = "新添加的项目为" & List1.List(List1.ListCount - 1)
Label1.Caption = "列表中项目数为:" & List1.ListCount & "个"
End Sub
Private Sub Form_Load()
Command1.Caption = "添加城市"
Label1.Caption = "列表中项目数为:" & List1.ListCount & "个"
End Sub
Private Sub List1_Click()
Label2.Caption = "您选择的城市为:" & List1.List(List1.ListIndex)
End Sub
列表操作2
Dim i As Integer
Private Sub Command1_Click()
If List1.ListIndex = -1 Then
MsgBox "请选择项目"
Exit Sub
End If
For i = 1 To 20
If List1.List(List1.ListIndex) = List2.List(i) Then
MsgBox "该项目已添加"
Exit Sub
End If
Next i
List2.AddItem List1.ListIndex
End Sub
Private Sub Command2_Click()
If List2.ListIndex = -1 Then
MsgBox "请选择要移除的项目"
Exit Sub
End If
List2.RemoveItem Index
End Sub
Private Sub Command3_Click()
If MsgBox("确定清空?", 4) = vbYes Then List2.Clear
End Sub
Private Sub Command4_Click()
List1.AddItem "Item" & i
i = i + 1
End Sub
组合框
Private Sub Command1_Click()
s = InputBox("输入添加项,单击确定按钮", "添加项目")
If s <> "" Then
Combo1.AddItem s
Label1.Caption = "添加了新项目:" & Combo1.List(Combo1.ListCount - 1)
Combo1.ListIndex = 0
End If
End Sub
Private Sub Command2_Click()
If Combo1.ListIndex = -1 Then
MsgBox "请选择需要删除的数据!"
Exit Sub
End If
Combo1.RemoveItem Combo1.ListIndex
Label1.Caption = "移除了项目"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
滚动条
Private Sub Form_Load()
HScroll1.Max = 200: HScroll1.Min = 0
HScroll1.LargeChange = 40: HScroll1.SmallChange = 40
HScroll1.Value = 0
Picture1.BackColor = RGB(255, 255, 255)
End Sub
Private Sub HScroll1_Change()
Picture1.BackColor = RGB(255 - HScroll1.Value, 255, 255 - HScroll1.Value)
End Sub
滚动条实例
Option Explicit
Dim w
Dim h
Private Sub Form_Resize()
On Error Resume Next
w = Form1.ScaleWidth - VScroll1.Width: h = Form1.ScaleHeight - HScroll1.Height
VScroll1.Move w, 0, VScroll1.Width, h: HScroll1.Move 0, h, w
Picture1.Move 0, 0, w, h
VScroll1.Min = 0: VScroll1.Max = Image1.Height - Picture1.Height
HScroll1.Min = 0: HScroll1.Max = Image1.Width - Picture1.Width
HScroll1.LargeChange = (Image1.Width - Picture1.Width) / 10
HScroll1.SmallChange = (Image1.Width - Picture1.Width) / 10
VScroll1.LargeChange = (Image1.Height - Picture1.Height) / 10
VScroll1.SmallChange = (Image1.Height - Picture1.Height) / 10
End Sub
Private Sub HScroll1_Scroll()
Image1.Left = -HScroll1.Value
End Sub
Private Sub VScroll1_Scroll()
Image1.Top = -VScroll1.Value
End Sub
打砖块游戏
Dim n, s As Integer
Private Sub Command1_Click()
Timer1.Interval = 1000
Command4.Enabled = True
End Sub
Private Sub Command2_Click()
Timer1.Interval = 800
Command4.Enabled = True
End Sub
Private Sub Command3_Click()
Timer1.Interval = 600
Command4.Enabled = True
End Sub
Private Sub Command4_Click()
n = 0: s = 0
Label3.Caption = ""
Text2.Text = 0
Command7.Enabled = True
Command7.Visible = True
Command7.Left = 2600
Command7.Top = 2000
Command7.Caption = 0
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Timer1.Enabled = True
Timer2.Enabled = True
Timer3.Enabled = True
End Sub
Private Sub Command5_Click()
Unload Me
End Sub
Private Sub Command7_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
n = n + 1
Text2.Text = n
Command7.Caption = True
End Sub
Private Sub Timer1_Timer()
Randomize
r = Int(Rnd * 256 + 0)
g = Int(Rnd * 256 + 0)
b = Int(Rnd * 256 + 0)
l = Int(Rnd * 6500 + 0)
t = Int(Rnd * 2800 + 0)
Command7.BackColor = RGB(r, g, b)
Command7.Left = l
Command7.Top = t
End Sub
Private Sub Timer2_Timer()
Timer1.Enabled = False
Timer3.Enabled = False
Command7.Visible = False
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
End Sub
Private Sub Timer3_Timer()
s = s + 1
Label3.Caption = 30 - s
End Sub
控件数组
Private Declare Function GetCursorPos Lib "user32" (IpPoint As POINTAPI) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Sub Command1_MouseUp(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
lbl_edg(0).BorderStyle = 0
End Sub
Private Sub Form_Load()
Text1(0).Locked = True
End Sub
Private Sub Label1_Click(index As Integer)
Text4.Text = 3
End Sub
Private Sub Label1_MouseDown(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
If button = 2 And index > 0 Then
Unload Label1(index)
End If
If index = 0 Then
lbl_edg(1).BorderStyle = 0
End If
End Sub
Private Sub label1_MouseUp(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
If index = 0 Then
lbl_edg(1).BorderStyle = 0
End If
End Sub
Private Sub Text1_Click(index As Integer)
Text4.Text = 2
End Sub
Private Sub Text1_MouseDown(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
If button = 2 And index > 0 Then
Unload Text1(index)
End If
If index = 0 Then
lbl_edg(2).BorderStyle = 1
End If
End Sub
Private Sub Form_MouseDown(button As Integer, shift As Integer, x As Single, y As Single)
Dim mouse As POINTAPI
GetCursorPos mouse
Text2.Text = Val(mouse.x) * 15 - Me.Left - 50
Text3.Text = Val(mouse.y) * 15 - Me.Top - 300
If Text2.Text > 1000 Then
If Text4.Text = 1 Then
If button = 1 Then
i = Command1.UBound + 1
Load Command1(i)
Command1(i).Left = Text2.Text
Command1(i).Top = Text3.Text
Command1(i).Caption = Str(i)
Command1(i).Visible = True
End If
End If
If Text4.Text = 2 Then
If button = 1 Then
i = Text1.UBound + 1
Load Text1(i)
Text1(i).Left = Text2.Text
Text1(i).Top = Text3.Text
Text1(i).Visible = True
End If
End If
If Text4.Text = 3 Then
If button = 1 Then
i = Label1.UBound + 1
Load Label1(i)
Label1(i).Left = Text2.Text
Label1(i).Top = Text3.Text
Label1(i).Caption = Str(i)
Label1(i).Visible = True
End If
End If
End If
End Sub
Private Sub command1_Click(index As Integer)
Text4.Text = 1
End Sub
Private Sub Command1_MouseDown(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
If button = 2 And index > 0 Then
Unload Command1(index)
End If
If index = 0 Then
lbl_edg(0).BorderStyle = 1
End If
End Sub
Private Sub command2_click()
End
End Sub
Private Sub text1_mousemove(index As Integer, button As Integer, shift As Integer, x As Single, y As Single)
If index = 0 Then
lbl_edg(2).BackColor = 0
End If
End Sub
调色板
Dim a As Integer, b As Integer, c As Integer
Private Sub Form_Load()
Label1.Caption = "R值为:"
Label2.Caption = "G值为:"
Label3.Caption = "B值为:"
End Sub
Private Sub HScroll1_Change()
a = HScroll1.Value
HScroll1.Max = 255
HScroll1.Min = 0
HScroll1.LargeChange = 5
HScroll1.SmallChange = 5
Picture1.BackColor = RGB(a, b, c)
Label1.Caption = "R值为:" & a
Label4.ForeColor = RGB(a, b, c)
End Sub
Private Sub HScroll2_Change()
b = HScroll2.Value
HScroll2.Max = 255
HScroll2.Min = 0
HScroll2.LargeChange = 5
HScroll2.SmallChange = 5
Picture1.BackColor = RGB(a, b, c)
Label2.Caption = "G值为:" & b
Label4.ForeColor = RGB(a, b, c)
End Sub
Private Sub HScroll3_Change()
c = HScroll3.Value
HScroll3.Max = 255
HScroll3.Min = 0
HScroll3.LargeChange = 5
HScroll3.SmallChange = 5
Picture1.BackColor = RGB(a, b, c)
Label3.Caption = "B值为:" & c
Label4.ForeColor = RGB(a, b, c)
End Sub