VB程序学习代码记录20160723

VB编程学习:20160723代码实践
这篇博客详细记录了VB编程的学习过程,包括文本实例、列表操作的实战、使用组合框和滚动条的技巧,特别提到了一个滚动条实例的应用,还介绍了打砖块游戏的实现以及控件数组和调色板的运用。

文本实例

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
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值