VB常用代码（一）

    - VB常用代码
    单击选中文本框中所有内容
    Private Sub text1_Click()
    text1.SelStart = 0
    text1.SelLength = 65000
    End Sub
    -------------------------------------------------------------------------
    打开一个超连接
    Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
    Private Const SW_SHOWNORMAL = 1
    Private Const SW_SHOWMINIMIZED = 2
    -------------------------------------------------------------------------
    Private Sub Command1_Click()
    Call ShellExecute(Me.hwnd, "open", "http://www.o2space.com", vbNullString, vbNullString, SW_SHOWNORMAL)
    End Sub

    --------------------------------------------------------------------------
    用相对路径打开程序
    Private Sub Command1_Click()
    Shell "Calc.exe", vbNormalFocus
    End Sub


    最简单登陆窗口及密码更改
    用记事本编辑一名为config.txt的文本文件，里面输入初始密码，将其放入程序目录中
    登陆窗口：

    Dim passwordstr As String\'用户登录程序

    Private Sub Command1_Click()
    Open "config.txt" For Input As #1
    Do While Not EOF(1)
    Input #1, passwordstr
    Loop
    Close #1
    If Text1.Text = passwordstr Then
    \'输入正确
    Unload Me
    index.Show
    \'index为输入正确后显示的正常窗口
    Else \'输入错误
    x = MsgBox("用户密码输入错误!请再输一次!", 17, "警告")
    Text1.SetFocus
    End If
    Else
    Unload Me
    End If
    End Sub
    -----------------------------
    Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Show
    Text1.SetFocus
    End Sub


    ------------***********************-----------------
    密码更改窗口：
    Private Sub Command1_Click() \'密码设置程序
    If Text1.Text = Text2.Text Then
    \'确认两次输入密码是否一致
    passwordstr = "text2.text"
    Open "config.txt" For Output As #1
    Print #1, Text1.Text
    Close #1
    Unload Me
    Else
    x = MsgBox("密码输入错误!请重新输入!";, 17, "警告")
    Text2.SetFocus
    End If
    End Sub
    ---------------------------------------------
    Private Sub Form_Load()
    Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2
    Show
    Text1.SetFocus
    End Sub

    ----------------------------------------------------------------

    窗口退出相关
    Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    QuitMessage
    End Sub
    ---------
    Private Sub QuitMessage()
    QExit = MsgBox( _
    "真的要退出吗?", _
    vbYesNo vbQuestion, _
    "提示...")

    Select Case QExit
    Case vbYes
    End
    Case vbNo
    Cancel = Not ReadyToQuit
    End Select
    End Sub



    提示窗口：
    MsgBox "提示内容", vbOKOnly, "提示..."


    窗体卸载时相关
    Private Sub Form_Unload(Cancel As Integer) ‘窗口卸载
    Set Form1 = Nothing ‘完全卸载,如果用end或unload语句不能完全释放内存占用
    End
    End Sub

    -----------------------------------------------

    Msgbox强制换行(& vbCrLf & _语句)
    MsgBox("换行吗？" & vbCrLf & _
    "是的，换行")

    让标题栏上的关闭按钮失效
    声明段：
    Private Declare Function GetSystemMenu Lib "User32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
    Private Declare Function DeleteMenu Lib "User32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long) As Long
    Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
    Private Declare Function GetMenuString Lib "User32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
    Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
    Const WM_NCLBUTTONDBLCLK = &HA3
    Const WM_NCLBUTTONDOWN = &HA1
    Const HTCAPTION = 2
    Const MF_STRING = &H0&
    Const MF_BYCOMMAND = &H0&
    Const SC_CLOSE = &HF060
    Private hMenu As Long
    Private CloseStr As String
    Private Sub Form_Load()
    hMenu = GetSystemMenu(Me.hwnd, 0)
    CloseStr = String(255, 0)
    \'SC_CLOSE指的便是"关闭"的那一个MenuItem ID
    Call GetMenuString(hMenu, SC_CLOSE, CloseStr, 256, MF_BYCOMMAND)
    CloseStr = Left(CloseStr, InStr(1, CloseStr, Chr(0)) - 1)
    Call DeleteMenu(hMenu, SC_CLOSE, MF_BYCOMMAND)
    End Sub

    打开/关闭光驱门
    声明段
    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
    Dim Ret As Long
    Dim RetStr As String
    \'控制段（可用命令按钮等）
    \'打开代码
    Ret = mciSendString("set CDAudio door open", RetStr, 0, 0)
    \'关闭代码
    Ret = mciSendString("set CDAudio door closed", RetStr, 0, 0)

    避免多用户同时打开同一个程序
    Private Sub Form_Load()
    If App.PrevInstance Then
    MsgBox "程序已经运行，不能再次装载", vbExclamation
    Unload Me
    End If
    End Sub

    利用代码启动/关闭中文输入法
    IMEMode属性。例如Text1.IMEMode = 1

    ---------------------------------------------------------

    简单时间格式
    Private Sub Timer1_Timer()
    Text1.text=Format(Now, "hh:mm:ss")
    End Sub

    窗口标题栏更改
    me.caption=”我的窗口”

    打开控制面板里的”添加/删除程序”
    Call ControlPanels("rundll32.exe shell32.dll,Control_RunDLL appwiz.cpl,,1")

附加题目