VB编程基础教程-优快云博客

本文链接：https://blog.youkuaiyun.com/sxhexin/article/details/79435153

总结的再多，比不上拉出来溜溜。
——–20180505留

类似main函数的感觉

Private Sub Form_Load()

End Sub

强制显式声明模块中的所有变量，变量必须预先声明之后才能使用

Option Explicit

定义变量，数组（预/后定义数组成员数量）

option string variant object
integer single double long const

Dim i As Integer
Dim x&
Dim i(10) As Double
Dim i() As Const

赋值与计算

i = 1
sum = 1 + 1
i = i +1
i = sum + i

随机数

a = Int(Rnd * 6) 'Rnd生成0~1的数 Int()取整

If语句与循环语句

For n = 1 To 100
    If n Mod 5 = 0 Then
        Print n
    Else 
        End
    End If
Next n

选择语句

Select Case Index
    Case 0
         lblshow.FontSize = 12
    Case 1
         lblshow.FontSize = 14
    Case 2
         lblshow.FontSize = 16
    Case 3
         lblshow.FontSize = 18
End Select

屏幕输入与输出

x = Val(InputBox("请输入横坐标x的值："))  'Val强制转换为数字
Print "该点在第一象限。"
MsgBox "无效密码，请重试！", , "登录失败"

Text1.Text = UCase(Text1.Text) '全部小写
Text1.Text = LCase(Text1.Text) '全部大写

信息框类型

Private Sub Form_Click()
    Dim x As Integer
    x = MsgBox("你单击的是窗体，是吗？", 35, "询问框")
    If x = 6 Then
        MsgBox "你选择了“是”按钮", vbInformation, "信息框"
    ElseIf x = 7 Then
        MsgBox "你选择了“否”按钮", vbInformation, "信息框"
    ElseIf x = 2 Then
        MsgBox "你选择了“取消”按钮", vbInformation, "信息框"
    End If
End Sub

居中显示

Label1.Top = (Form1.ScaleHeight - Label1.Height) / 2
Label1.Left = (Form1.ScaleWidth - Label1.Width) / 2

随机移动

cmdno.Move Rnd * 2000 + 500, Rnd * 2000 + 500

滚动文字或图片

If x = 8 Then x = 1
    x = x + 1
    img.Left = img.Left + 100
If img.Left > Me.ScaleWidth Then
    img.Left = -700

伪flash

Select Case x
    Case 1
        img2.Picture = img1(0).Picture
    Case 2
        img2.Picture = img1(1).Picture
    Case 3
        img2.Picture = img1(2).Picture
    Case 4
        img2.Picture = img1(3).Picture
    Case 5
        img2.Picture = img1(4).Picture
    Case 6
        img2.Picture = img1(5).Picture
    Case 7
        img2.Picture = img1(6).Picture
    Case 8
        img2.Picture = img1(7).Picture
End Select

随光标移动

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    lbl1.Move X, Y
End Sub

键盘控制移动
KeyAscii代表键位对应的ASCII码

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 37 Then
        Shape1.Left = Shape1.Left - 100
    ElseIf KeyCode = 38 Then
        Shape1.Top = Shape1.Top - 100
    ElseIf KeyCode = 39 Then
        Shape1.Left = Shape1.Left + 100
    ElseIf KeyCode = 40 Then
        Shape1.Top = Shape1.Top + 100
    End If
End Sub

隐藏、显示与卸载窗体

Form1.Hide
Form2.Show
Unload Me

显示或隐藏控件

cmdyes.Visible = False
cmdno.Visible = False

定位光标

txt1.SetFocus

改变放置光标时文字的颜色

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label2.ForeColor = QBColor(13)
End Sub

Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Label2.ForeColor = vbBlue
End Sub

定时器Timer

Private Sub Form_Load()
    delaytime = 0
    Timer1.Enabled = True
End Sub

Private Sub Timer1_Timer()
    If delaytime >= 100 Then
        Timer1.Enabled = False
        End
    Else
        delaytime = delaytime + 1
    End If
End Sub

获得当前时间

lbl3.Caption = Year(Date)
lbl5.Caption = Month(Date)
lbl7.Caption = Day(Date)

txt1.Text = Date
txt2.Text = Time
endtime = Now

Label1.Caption = Format(Now, "hh:mm:ss  AM/PM") '12小时制
Label1.Caption = Time '24小时制

画太极图

Option Explicit
Dim x%, y%, r%
Const pi = 3.1415926

Private Sub Form_Activate()
    x = ScaleWidth / 2
    y = ScaleHeight / 2
    Circle (x, y), ScaleHeight / 2
    Circle (ScaleWidth / 2, ScaleHeight / 4), ScaleHeight / 4, , pi / 2, 3 * pi / 2
    Circle (ScaleWidth / 2, 3 * ScaleHeight / 4), ScaleHeight / 4, , 3 * pi / 2, pi / 2
    FillStyle = 0 '填充方式
    Circle (ScaleWidth / 2, ScaleHeight / 4), 150
    FillStyle = 0
    Circle (ScaleWidth / 2, 3 * ScaleHeight / 4), 150
End Sub

画矩形

pic1.Cls
    pic1.Line (pic1.ScaleLeft + 100, pic1.ScaleTop + 100)-(pic1.ScaleWidth - 100, pic1.ScaleHeight - 100), , BF

选择颜色

Private Sub Command1_Click()
    cdl1.ShowColor
    Shape1.BorderColor = cdl1.Color
End Sub

显示特定类型文件

Select Case Index
    Case 0
        File1.Pattern = "*.*"
    Case 1
        File1.Pattern = "*.txt"
    Case 2
        File1.Pattern = "*.jpg;*.bmp;*.tif"
    Case 3
        File1.Pattern = "*.mp3;*.wav;*.avi;*.dat"
End Select

定位目录

Dir1.Path = "C:\WINDOWS"
File1.Path = Dir1.Path
Dir1.Path = Drive1.Drive

打开exe文件

Dim x
    Select Case Index
        Case 0
            x = Shell("C:\WINDOWS\NOTEPAD.EXE", 1)
        Case 1
            MsgBox ("自己找")
            'x = Shell("C:\Program Files\Microsoft Office\Office\WINWORD.EXE", 3)
        Case 2
            MsgBox ("自己找")
            'x = Shell("C:\Program Files\Microsoft Visual Studio\VB98\VB6.EXE", 3)
        Case 3
            x = Shell("C:\WINDOWS\explorer.exe", 1)
End Select

打开图片

cdl1.Filter = "图片文件(*.bmp;*.jpg;*.tif)|*.bmp;*.jpg;*.tif"
cdl1.ShowOpen
img1.Picture = LoadPicture(cdl1.FileName)

播放音乐

Private Sub Command1_Click()
    mci1.Command = "close"
    mci1.Notify = False
    mci1.Wait = True
    mci1.FileName = App.Path & "\UNIT.mp3" 'Oder .MID Dokument?
    mci1.Command = "open"
    mci1.Notify = True
    mci1.Wait = False
    mci1.Command = "play"
    Label1.Caption = mci1.FileName
End Sub

播放视频

Private Sub Command1_Click()
    mci1.Command = "close"
    mci1.Notify = False
    mci1.Wait = True
    mci1.FileName = App.Path & "\clock.avi"
    mci1.Command = "open"
    mci1.Notify = True
    mci1.Wait = False
    mci1.Command = "play"
End Sub

嵌入或链接EXCEL

Private Sub Command1_Click()
    OLE1.Class = "excel.sheet.8"
    OLE1.SourceDoc = App.Path & "\新建 Microsoft Excel 工作表.xlsx"
    OLE1.Action = 0
End Sub

Private Sub Command2_Click()
    OLE2.Class = "excel.sheet.8"
    OLE2.SourceDoc = App.Path & "\新建 Microsoft Excel 工作表.xlsx"
    OLE2.Action = 1
End Sub

删除文件

Dim killedfile As String, choicedfile As String
Dim x
    If Right(Dir1.Path, 1) = "\" Then
        choicedfile = Dir1.Path + File1.FileName
    Else
        choicedfile = Dir1.Path + "\" + File1.FileName
    End If
killedfile = choicedfile
x = MsgBox("你确实要删除文件吗？", 35, "确认框")
If x = 6 Then
    Kill killedfile
    MsgBox "文件已删除！请查看计算机上该文件所在的路径。", , "信息提示"
End If

复制文件

Dim sourfile As String
Dim destfile As String
If Right(Dir1.Path, 1) = "\" Then
    sourfile = Dir1.Path + File1.FileName
Else
    sourfile = Dir1.Path + "\" + File1.FileName
End If
    destfile = InputBox("请输入要复制的目的文件", "输入框")
If destfile <> "" Then
    FileCopy sourfile, destfile
    MsgBox "文件已被复制，请查看计算机上该文件的路径。", , "提示框"
End If

修改文件名

Dim oldname As String
Dim newname As String
If Right(Dir1.Path, 1) = "\" Then
    oldname = Dir1.Path & File1.FileName
Else
    oldname = Dir1.Path & "\" & File1.FileName
End If
newname = InputBox("请输入新文件名", "输入框")
If newname <> "" Then
    Name oldname As newname
    MsgBox "文件名已被更改，请查看该文件所在的路径。", , "提示框"
End If

vb代码片总结