form1.frm

100个vb编程实例,什么都有

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   4770
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   6915
   LinkTopic       =   "Form1"
   ScaleHeight     =   4770
   ScaleWidth      =   6915
   StartUpPosition =   2  '屏幕中心
   Begin MSComDlg.CommonDialog CommonDialog1 
      Left            =   3240
      Top             =   2160
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin VB.PictureBox Picture1 
      Height          =   4095
      Left            =   2280
      ScaleHeight     =   4095
      ScaleWidth      =   15
      TabIndex        =   2
      Top             =   720
      Width           =   15
   End
   Begin MSComctlLib.ListView ListView1 
      Height          =   3495
      Left            =   2280
      TabIndex        =   1
      Top             =   1200
      Width           =   4695
      _ExtentX        =   8281
      _ExtentY        =   6165
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   0
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   3495
      Left            =   0
      TabIndex        =   0
      Top             =   1200
      Width           =   2295
      _ExtentX        =   4048
      _ExtentY        =   6165
      _Version        =   393217
      Style           =   7
      Appearance      =   1
   End
   Begin VB.Label Label2 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label2"
      Height          =   255
      Left            =   2280
      TabIndex        =   4
      Top             =   840
      Width           =   4695
   End
   Begin VB.Label Label1 
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Label1"
      Height          =   255
      Left            =   0
      TabIndex        =   3
      Top             =   840
      Width           =   2295
   End
   Begin VB.Menu mnufile 
      Caption         =   "file"
      Begin VB.Menu mnuopen 
         Caption         =   "open"
      End
      Begin VB.Menu mnuexit 
         Caption         =   "exit"
      End
   End
   Begin VB.Menu mnuview 
      Caption         =   "view"
      Begin VB.Menu mnudata 
         Caption         =   "data"
      End
      Begin VB.Menu mnustruct 
         Caption         =   "struct"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim myDB As Database
Dim myRS As Recordset
Dim myTD As tabledef
Dim myFD As field
Dim NodX As Node
Dim ItemX As ListItem

Private Sub Form_Load()
Set myDB = workspace(0).openDatabase("e:\myapp\mdbfiles\one.mdb")
Set myRS = myDB.openrecordset(dbopensnapshot)
End Sub

Private Sub Form_Unload(Cancel As Integer)
If TreeView1.Nodes.Count > 0 Then
     myDB.Close
End If
Unload Me

End Sub

Private Sub mnudata_Click()
Dim sTD As String
mnudata.Checked = True
mnustruct.Checked = False
sTD = GetTvwTD
If sTD <> "" Then
  Call GetTvwData(sTD)
End If

End Sub

Private Sub mnuexit_Click()
Unload Me

End Sub

Private Sub mnuopen_Click()
Dim sMDBFile As String
CommonDialog1.DialogTitle = "选择"
CommonDialog1.Filter = "DataBase(*.mdb)|*.mdb"
CommonDialog1.CancelError = True
On Error Resume Next
CommonDialog1.ShowOpen
If Err = cdlCancel Then
   Exit Sub
End If
If Me.Caption = CommonDialog1.FileName Then
   MsgBox "已经打开"
   Exit Sub
End If
Me.Caption = CommonDialog1.FileName
Call GetTvwMdb(CommonDialog1.FileName)


End Sub

Private Sub mnustruct_Click()
Dim sTD As String
mnudata.Checked = False
mnustruct.Checked = True
sTD = GetTvwTD
If sTD <> "" Then
  Call GetTvwStru(sTD)
End If

End Sub

Private Sub GetLvwStru(ByVal sTable As String)
Dim i As Integer
If ListView1.ListItems.Count > 0 Then
  Call ListView1.ListItems.Clear
  Call ListView1.ColumnHeaders.Clear
End If
ListView1.ColumnHeaders.Add , , "gf"
ListView1.ColumnHeaders.Add , , "kl"
ListView1.ColumnHeaders.Add , , "jhk"
Call showlvwview
Set myTD = myDB.tabledefs(sTable)
For i = 0 To myTD.fields.Count - 1
Set myFD = myTD.fields(i)
Set ItemX = ListView1.ListItems.Add(, , myFD.Name, "note", "note")
Next i
Call showlvwview

End Sub


Private Sub GetTvwMdb(ByVal MdbFile As String)
Dim i As Integer
Dim iIndex As Integer
If TreeView1.Nodes.Count > 0 Then
   TreeView1.Nodes.Clear
   ListView1.ListItems.Clear
   ListView1.ColumnHeaders.Clear
   myDB.ColumnHeaders.Clear
   myDB.Close
End If

Set myDB = workspaces(0).openDatabase(MdbFile)
Set NodX = TreeView1.Nodes.Add()
NodX.Key = "MDB"
NodX.Text = myDB.Name
iIndex = NodX.Index

For i = 0 To myDB.tabledefs.Count - 1
  Set myTD = myDB.tabledefs(i)
  If UCase$(Left(myTD.Name, 4)) <> "MSYS" Then
    Set NodX = TreeView1.Nodes.Add(iIndex, tvwChild) 'klhl
    NodX.Key = myTD.Name
    NodX.Text = myTD.Name
  End If
Next i

TreeView1.Style = tvwTreelinesPictureText
TreeView1.Nodes(iIndex).Expanded = True

End Sub


Private Sub TvwMdb_Collapse(ByVal Node As ComctlLib.Node)
ListView1.ListItems.Clear
ListView1.ColumnHeaders.Clear

End Sub

Private Sub TvwMdb_Expand(ByVal Node As ComctlLib.Node)
Dim i As Integer
If Node.Key = "MDB" Then
  Exit Sub
End If
If Node.Expanded = True Then
  Exit Sub
End If

For i = 1 To TreeView1.Nodes.Count

End Sub