frmmain.frm

《VB6数据库开发指南》所有的例程的源码

  If mbMoving Then
    sglPos = X + imgSplitter.Left
    If sglPos < sglSplitLimit Then
      picSplitter.Left = sglSplitLimit
    ElseIf sglPos > Me.Width - sglSplitLimit Then
      picSplitter.Left = Me.Width - sglSplitLimit
    Else
      picSplitter.Left = sglPos
    End If
  End If
    
End Sub

Private Sub imgSplitter_MouseUp( _
  Button As Integer, _
  Shift As Integer, _
  X As Single, _
  Y As Single)
    
  SizeControls picSplitter.Left
  picSplitter.Visible = False
  mbMoving = False

End Sub

Private Sub SizeControls(X As Single)
On Error Resume Next
    
  'set the width
  If X < 1500 Then X = 1500
  If X > (Me.Width - 1500) Then X = Me.Width - 1500
  tvTreeView.Width = X
  imgSplitter.Left = X
  lvListView.Left = X + 40
  lvListView.Width = Me.Width - (tvTreeView.Width + 140)
  lblTitle(0).Width = tvTreeView.Width
  lblTitle(1).Left = lvListView.Left + 20
  lblTitle(1).Width = lvListView.Width - 40
  
  'set the top
  If tbToolBar.Visible Then
    tvTreeView.Top = tbToolBar.Height + picTitles.Height
  Else
    tvTreeView.Top = picTitles.Height
  End If
  lvListView.Top = tvTreeView.Top
  
  'set the height
  If sbStatusBar.Visible Then
    tvTreeView.Height = _
      Me.ScaleHeight - _
      (picTitles.Top + picTitles.Height + sbStatusBar.Height)
  Else
    tvTreeView.Height = _
      Me.ScaleHeight - _
      (picTitles.Top + picTitles.Height)
  End If
  
  lvListView.Height = tvTreeView.Height
  imgSplitter.Top = tvTreeView.Top
  imgSplitter.Height = tvTreeView.Height

End Sub

Private Sub tvTreeView_Expand(ByVal Node As ComctlLib.Node)
' Expand the node
On Error GoTo ProcError

  Screen.MousePointer = vbHourglass

  ' the class does the work
  mcdbExp.ExpandNode Node
  
ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As ComctlLib.Node)
' Display the properties of the selected node in the listview
On Error GoTo ProcError

  Screen.MousePointer = vbHourglass

  ' the class does the work
  mcdbExp.ListProperties Node

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuFileOpen_Click()
' open a database
On Error GoTo ProcError

  Dim strDBName As String
  
  Screen.MousePointer = vbHourglass

  strDBName = GetOpenDBName(dlgCommonDialog)
  If Len(strDBName) Then
    Set mcdbExp = Nothing
    Set mcdbExp = New CDBExplorer
    mcdbExp.ExploreDatabase strDBName, tvTreeView, lvListView
  End If

  SelectRootNode

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

ProcError:
  MsgBox Err.Description
  Resume ProcExit

End Sub

Private Sub mnuFileNew_Click()
' create a new database
On Error GoTo ProcError

  Dim strDBName As String

  Screen.MousePointer = vbHourglass

  ' get the file name
  strDBName = GetNewDBName(dlgCommonDialog)
  ' kill it if it exists
  ' note that GetDBName prompts to confirm overwrite
  On Error Resume Next
  Kill strDBName
  ' create the database
  CreateDB strDBName

  ' explore it
  Set mcdbExp = New CDBExplorer
  mcdbExp.ExploreDatabase strDBName, tvTreeView, lvListView

  SelectRootNode

ProcExit:
  Screen.MousePointer = vbDefault
  Exit Sub

ProcError:
  MsgBox Err.Description
  Resume ProcExit

End Sub

Private Sub mnuFileClose_Click()
  'unload the form
  Unload Me
End Sub

Private Sub mnuTable_Click()
' enable/disable controls
On Error GoTo ProcError

  If mcdbExp Is Nothing Then
    ' no database open
    mnuTableAdd.Enabled = False
    mnuTableDelete.Enabled = False
  Else
    ' enable add
    mnuTableAdd.Enabled = True
    ' only enable delete if a tabledef is selected
    If mcdbExp.NodeType(tvTreeView.SelectedItem) = _
      "TableDef" Then
      mnuTableDelete.Enabled = True
    Else
      mnuTableDelete.Enabled = False
    End If
  End If

ProcExit:
  Exit Sub

ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub
Private Sub mnuTableAdd_Click()
On Error GoTo ProcError

  mcdbExp.AddTable

ProcExit:
  Exit Sub

ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuTableDelete_Click()
On Error GoTo ProcError

  mcdbExp.DeleteTable tvTreeView.SelectedItem.Text

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuIndex_Click()
On Error GoTo ProcError

  If mcdbExp Is Nothing Then
    ' no database open
    mnuIndexAdd.Enabled = False
    mnuIndexDelete.Enabled = False
  Else
    ' enable add
    mnuIndexAdd.Enabled = True
    ' only enable delete if a Index is selected
    If mcdbExp.NodeType(tvTreeView.SelectedItem) = _
      "Index" Then
      mnuIndexDelete.Enabled = True
    Else
      mnuIndexDelete.Enabled = False
    End If
  End If

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuIndexAdd_Click()
On Error GoTo ProcError

  mcdbExp.AddIndex

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuIndexDelete_Click()
' Note: mnuIndex_Click already determined
' that an index is selected in the tree
On Error GoTo ProcError

  Dim strTableDefName As String
  Dim strIndexName As String

  ' get the index name
  strIndexName = tvTreeView.SelectedItem.Text
  ' get it's parent table name
  strTableDefName = tvTreeView.SelectedItem.Parent.Parent.Text
  
  mcdbExp.DeleteIndex strTableDefName, strIndexName

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuRelation_Click()
On Error GoTo ProcError

  If mcdbExp Is Nothing Then
    ' no database open
    mnuRelationAdd.Enabled = False
    mnuRelationDelete.Enabled = False
  Else
    ' enable add
    mnuRelationAdd.Enabled = True
    ' only enable delete if a Index is selected
    If mcdbExp.NodeType(tvTreeView.SelectedItem) = _
      "Relation" Then
      mnuRelationDelete.Enabled = True
    Else
      mnuRelationDelete.Enabled = False
    End If
  End If

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub
Private Sub mnuRelationAdd_Click()
On Error GoTo ProcError
  
  mcdbExp.AddRelation

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit

End Sub

Private Sub mnuRelationDelete_Click()
On Error GoTo ProcError

  Dim strRelationName As String
  
  ' get the name
  strRelationName = tvTreeView.SelectedItem.Text

  mcdbExp.DeleteRelation strRelationName

ProcExit:
  Exit Sub
  
ProcError:
  MsgBox "Error: " & Err.Number & vbCrLf & Err.Description
  Resume ProcExit
End Sub