VB程序学习代码记录20160724

为工具栏添加事件代码

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "add"
Case "modify"
Case "delete"
Case "save"
Case "cancel"
Case "find"
Case "close"
End Select
End Sub

状态栏设置时间日期

Private Sub Timer1_Timer()
StatusBar1.Panels(1).Text = Format(Date, "YYYY-MM-DD")
StatusBar1.Panels(2).Text = Format(Time, "hh:mm")
End Sub

状态栏实例

Private Sub Command1_Click()
Form2.Hide
Form1.Show
End Sub
Private Sub Text1_Change()
If Text1.Text <> "" Then
StatusBar1.Panels(2).Text = "当前用户为:" & Text1.Text
Else
MsgBox "请输入用户名！", vbCritical, "信息提示"
End If
End Sub
Private Sub Timer1_Timer()
StatusBar1.Panels(3).Text = Format(Date, "YYYY年MM月DD日") & Format(Now, "hh点mm分ss秒")
End Sub

工具栏实例

Private Sub Command1_Click()
Form1.Hide
Form2.Show
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "add"   '添加
MsgBox "单击“添加”按钮！", vbInformation, "信息提示"
Case "modify"    '修改
MsgBox "修改“添加”按钮！", vbInformation, "信息提示"
Case "delete"    '删除
MsgBox "单击“删除”按钮！", vbInformation, "信息提示"
Case "save"   '保存
MsgBox "单击“保存”按钮！", vbInformation, "信息提示"
Case "cancel"  '取消
MsgBox "单击“取消”按钮！", vbInformation, "信息提示"
Case "find"   '找找
MsgBox "单击“查找”按钮！", vbInformation, "信息提示"
Case "dyt"     '移到第一条记录
MsgBox "单击“第一条”按钮！", vbInformation, "信息提示"
Case "syt"     '移到上一条记录
MsgBox "单击“第二条”按钮！", vbInformation, "信息提示"
Case "xyt"    '移到下一条记录
MsgBox "单击“下一条”按钮！", vbInformation, "信息提示"
Case "myt"     '移到最后一条记录
MsgBox "单击“末一条”按钮！", vbInformation, "信息提示"
Case "close"
Unload Me
End Select
End Sub

公用对话框（打开文件）

Private Sub Command1_Click()
CommonDialog1.Filter = "bmp图片(*.BMP)|*.BMP|JPG 图片(*.JPG|*.JPG|GIF 图片(*.GIF(|*.GIF|所有文件(*.*)|*.*"
CommonDialog1.Action = 1
Text1.Text = CommonDialog1.FileTitle
Text2.Text = CommonDialog1.FileName
End Sub

公用对话框（保存文件）

Private Sub Command3_Click()
CommonDialog1.DialogTitle = "保存纯文本文件"
CommonDialog1.Filter = "文本文件|*.txt"
CommonDialog1.InitDir = "E:\"
CommonDialog1.Action = 2
If CommonDialog1.FileName <> "" Then
Open CommonDialog1.FileName For Output As #1
Print #1, Text1.Text
Close #1
End If
End Sub

公用对话框（颜色对话框）

Private Sub Command4_Click()
CommonDialog1.Action = 3
Text1.BackColor = CommonDialog1.Color
End Sub

公共对话框（字体对话框）

Private Sub Command5_Click()
CommonDialog1.Flags = 3
CommonDialog1.Action = 4
If CommonDialog1.FontName <> "" Then
Text1.FontName = CommonDialog1.FontName
End If
Text1.FontSize = CommonDialog1.FontSize
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
End Sub

公用对话框（打印）

Private Sub Command6_Click()
'CommonDialog1.Action = 5
CommonDialog1.ShowPrinter
End Sub

公共对话框实例

Private Sub Command1_Click()
CommonDialog1.Action = 1
CommonDialog1.Filter = "TXT文件(*.txt)|*.txt"
Text1.Text = CommonDialog1.FileTitle
Text2.Text = CommonDialog1.FileName
End Sub
Private Sub Command2_Click()
CommonDialog1.ShowColor
Text1.BackColor = CommonDialog1.Color
End Sub
Private Sub Command3_Click()
CommonDialog1.ShowFont
Text1.FontSize = CommonDialog1.FontSize
Text1.FontBold = CommonDialog1.FontBold
Text1.FontItalic = CommonDialog1.FontItalic
End Sub

编写程序自动注册

Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Const max_path = 260
Private Const max_path1 = 261
Dim sysdir As String

Private Sub form_activate()
On Error GoTo orroelink
Dim retval, retval1, retval2
Dim chrlen As Long
Dim windir As String, mypath As String, a1 As String, a2 As String
sysdir = Space(max_path)
chrlen = GetSystemDirectory(sysdir, max_path)
If chrlen = max_path Then chrlen = GetSystemDirectory(sysdir, max_path)
sysdir = Left(sysdir, chrlen)
Shell ("regsvr32 /s" & sysdir & "\Scrrun.dll 开启")
a1 = Dir(sysdir & "\Flash.ocx")
If a1 = "" Then
FileCopy App.Path & "\link\Flash.ocx", sysdir & "\Flash.ocx"
Shell ("regsvr32 /s" & sysdir & "\flash.ocx")
End If
a2 = Dir(sysdir & "\MCI32.OCX")
If a2 = "" Then
FileCopy App.Path & "\link\MCI32.OCX", sysdir & "\MCI32.OCX"
Shell ("regsvr32 /s " & sysdir & "\MCI32.OCX")
End If
Exit Sub
orroelink:
MsgBox Err.Description, vbOKOnly, "提示信息"
End Sub

图像列表控件

Private Sub Form_Load()
ImageList1.ListImages.Add , "gz", LoadPicture("C:\Users\Qi\Desktop\VB_ICO图标\apply.ico")
Set Form1.Icon = ImageList1.ListImages(1).Picture
End Sub

与listview控件关联

Private Sub Form_Load()
Set TreeView1.ImageList = ImageList1
TreeView1.Nodes.Add , , "a1", "员工1", "yg"
End Sub