frmmain.frm

针对各种管理系统提供有的VB源代码

End Sub


Private Sub Form_Unload(Cancel As Integer)
    Dim i As Integer


    'close all sub forms
    For i = Forms.Count - 1 To 1 Step -1
        Unload Forms(i)
    Next
    If Me.WindowState <> vbMinimized Then
        SaveSetting App.Title, "Settings", "MainLeft", Me.Left
        SaveSetting App.Title, "Settings", "MainTop", Me.Top
        SaveSetting App.Title, "Settings", "MainWidth", Me.Width
        SaveSetting App.Title, "Settings", "MainHeight", Me.Height
    End If
    SaveSetting App.Title, "Settings", "ViewMode", lvListView.View
End Sub

Private Sub lvListView_ItemClick(ByVal item As MSComctlLib.ListItem)
    Dim temps As String
    temps = Data1.RecordSource
    
    Data1.RecordSource = "select * from 文件表 where 文件编号 = " & item.Tag
    Data1.Refresh
    
    Label1.Caption = Data1.Recordset.Fields("文件说明").Value
    OLE1.DataField = "文件内容"
    OLE1.SizeMode = 1
    OLE1.Update
    Data1.Recordset.Close
    Data1.RecordSource = temps
    cmdShow.Enabled = True
    cmdSaveAs.Enabled = True
    cmdCopy.Enabled = True
End Sub

Private Sub mnuDatafrm向导表_Click()
    Dim f As New frm向导表
    f.Show
End Sub

Private Sub mnuDatafrm我的表_Click()
    Dim f As New frm我的表
    f.Show
End Sub

Private Sub mnuDatafrm文件表_Click()
    Dim f As New frm文件表
    f.Show
End Sub

Private Sub mnuDatafrm类别表_Click()
    Dim f As New frm类别表
    f.Show
End Sub



Private Sub Form_Resize()
    On Error Resume Next
    If Me.Width < 3000 Then Me.Width = 3000
    SizeControls imgSplitter.Left
End Sub


Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 2, .Height - 20
    End With
    picSplitter.Visible = True
    mbMoving = True
End Sub


Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single
    

    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 TreeView1_DragDrop(Source As Control, X As Single, Y As Single)
    If Source = imgSplitter Then
        SizeControls X
    End If
End Sub


Sub SizeControls(X As Single)
    On Error Resume Next
    

    '设置 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


    '设置 Top 属性
  

    If tbToolBar.Visible Then
        tvTreeView.Top = tbToolBar.Height + picTitles.Height
    Else
        tvTreeView.Top = picTitles.Height
    End If

  lvListView.Top = tvTreeView.Top
    

    '设置 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 tbToolBar_ButtonClick(ByVal Button As MSComctlLib.Button)
    On Error Resume Next
    Select Case Button.Key
        Case "返回"
            '应做:添加 '返回' 按钮代码。
            MsgBox "添加 '返回' 按钮代码。"
        Case "向前"
            '应做:添加 '向前' 按钮代码。
            MsgBox "添加 '向前' 按钮代码。"
        Case "剪切"
            mnuEditCut_Click
        Case "复制"
            mnuEditCopy_Click
        Case "粘贴"
            mnuEditPaste_Click
        Case "删除"
            mnuFileDelete_Click
        Case "属性"
            mnuFileProperties_Click
        Case "大图标"
            lvListView.View = lvwIcon
        Case "小图标"
            lvListView.View = lvwSmallIcon
        Case "列表"
            lvListView.View = lvwList
        Case "详细资料"
            lvListView.View = lvwReport
    End Select
End Sub

Private Sub mnuHelpAbout_Click()
    frmAbout.Show vbModal, Me
End Sub

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else

    On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 261, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub

Private Sub mnuHelpContents_Click()
    Dim nRet As Integer


    '如果这个工程没有帮助文件，显示消息给用户
    '可以在“工程属性”对话框中为应用程序设置帮助文件
    If Len(App.HelpFile) = 0 Then
        MsgBox "无法显示帮助目录，该工程没有相关联的帮助。", vbInformation, Me.Caption
    Else
        On Error Resume Next
        nRet = OSWinHelp(Me.hwnd, App.HelpFile, 3, 0)
        If Err Then
            MsgBox Err.Description
        End If
    End If

End Sub


Private Sub mnuWindowArrangeIcons_Click()
    '应做:添加 'mnuWindowArrangeIcons_Click' 代码。
    MsgBox "添加 'mnuWindowArrangeIcons_Click' 代码。"
End Sub

Private Sub mnuWindowTileVertical_Click()
    '应做:添加 'mnuWindowTileVertical_Click' 代码。
    MsgBox "添加 'mnuWindowTileVertical_Click' 代码。"
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    '应做:添加 'mnuWindowTileHorizontal_Click' 代码。
    MsgBox "添加 'mnuWindowTileHorizontal_Click' 代码。"
End Sub

Private Sub mnuWindowCascade_Click()
    '应做:添加 'mnuWindowCascade_Click' 代码。
    MsgBox "添加 'mnuWindowCascade_Click' 代码。"
End Sub

Private Sub mnuWindowNewWindow_Click()
    '应做:添加 'mnuWindowNewWindow_Click' 代码。
    MsgBox "添加 'mnuWindowNewWindow_Click' 代码。"
End Sub

Private Sub mnuToolsOptions_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewWebBrowser_Click()
    Dim frmB As New frmBrowser
    frmB.StartingAddress = "http://www.microsoft.com"
    frmB.Show
End Sub

Private Sub mnuViewOptions_Click()
    frmOptions.Show vbModal, Me
End Sub

Private Sub mnuViewRefresh_Click()
    '应做:添加 'mnuViewRefresh_Click' 代码。
    MsgBox "添加 'mnuViewRefresh_Click' 代码。"
End Sub



Private Sub mnuVAIByDate_Click()
    'ToDo: 添加 'mnuVAIByDate_Click' 代码
'  lvListView.SortKey = DATE_COLUMN
End Sub


Private Sub mnuVAIByName_Click()
    'ToDo: 添加 'mnuVAIByName_Click' 代码
'  lvListView.SortKey = NAME_COLUMN
End Sub


Private Sub mnuVAIBySize_Click()
    'ToDo: 添加 'mnuVAIBySize_Click' 代码
'  lvListView.SortKey = SIZE_COLUMN
End Sub


Private Sub mnuVAIByType_Click()
    'ToDo: 添加 'mnuVAIByType_Click' 代码
'  lvListView.SortKey = TYPE_COLUMN
End Sub

Private Sub mnuViewStatusBar_Click()
    mnuViewStatusBar.Checked = Not mnuViewStatusBar.Checked
    sbStatusBar.Visible = mnuViewStatusBar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuViewToolbar_Click()
    mnuViewToolbar.Checked = Not mnuViewToolbar.Checked
    tbToolBar.Visible = mnuViewToolbar.Checked
    SizeControls imgSplitter.Left
End Sub

Private Sub mnuEditInvertSelection_Click()
    '应做:添加 'mnuEditInvertSelection_Click' 代码。
    MsgBox "添加 'mnuEditInvertSelection_Click' 代码。"
End Sub

Private Sub mnuEditSelectAll_Click()
    '应做:添加 'mnuEditSelectAll_Click' 代码。
    MsgBox "添加 'mnuEditSelectAll_Click' 代码。"
End Sub

Private Sub mnuEditPasteSpecial_Click()
    '应做:添加 'mnuEditPasteSpecial_Click' 代码。
    MsgBox "添加 'mnuEditPasteSpecial_Click' 代码。"
End Sub

Private Sub mnuEditPaste_Click()
    '应做:添加 'mnuEditPaste_Click' 代码。
    MsgBox "添加 'mnuEditPaste_Click' 代码。"
End Sub

Private Sub mnuEditCopy_Click()
    '应做:添加 'mnuEditCopy_Click' 代码。
    MsgBox "添加 'mnuEditCopy_Click' 代码。"
End Sub

Private Sub mnuEditCut_Click()
    '应做:添加 'mnuEditCut_Click' 代码。
    MsgBox "添加 'mnuEditCut_Click' 代码。"
End Sub

Private Sub mnuEditUndo_Click()
    '应做:添加 'mnuEditUndo_Click' 代码。
    MsgBox "添加 'mnuEditUndo_Click' 代码。"
End Sub

Private Sub mnuFileClose_Click()
    '卸载窗体
    Unload Me

End Sub

Private Sub mnuFileProperties_Click()
    '应做:添加 'mnuFileProperties_Click' 代码。
    MsgBox "添加 'mnuFileProperties_Click' 代码。"
End Sub

Private Sub mnuFileRename_Click()
    '应做:添加 'mnuFileRename_Click' 代码。
    MsgBox "添加 'mnuFileRename_Click' 代码。"
End Sub

Private Sub mnuFileDelete_Click()
    '应做:添加 'mnuFileDelete_Click' 代码。
    MsgBox "添加 'mnuFileDelete_Click' 代码。"
End Sub

Private Sub mnuFileNew_Click()
    Manager.frm我的表.Show
End Sub

Private Sub mnuFileSendTo_Click()
    With dlgSendTo
        .DialogTitle = "保存为"
        .DefaultExt = "*.*"
        .ShowSave
    End With
    
    If dlgSendTo.FileName <> "" Then
        OLE1.SaveToFile dlgSendTo.FileName
        MsgBox "文件保存完毕！", vbCritical, "完成"
    End If
End Sub

Private Sub mnuFileFind_Click()
    '应做:添加 'mnuFileFind_Click' 代码。
    MsgBox "添加 'mnuFileFind_Click' 代码。"
End Sub

Private Sub mnuFileOpen_Click()
    Manager.frmOpen.Show
End Sub

Private Sub tvwCRefresh()
    Dim rootNode As Node, nd As Node
    
    On Error Resume Next
    
    Data1.RecordSource = "select DISTINCT 适合职位 from 类别表"
    Data1.Refresh
    ' Open the Authors recordset.
    
    If Err Then
        MsgBox "Unable to open aaa table" & Err.Description, vbCritical
        End
    End If
    
    ' Add the "Publishers" root (expanded).
    Set rootNode = tvwC.Nodes.Add(, , "\\Type", "职位文件", 1)
    rootNode.Expanded = True
    
    ' Add all the publishers, with a plus sign.
    Do Until Data1.Recordset.EOF
        Set nd = tvwC.Nodes.Add(rootNode.Key, tvwChild, , Data1.Recordset.Fields("适合职位").Value, 1)
        ' We can't use PubID as the Key, because it is a number.
        nd.Tag = Data1.Recordset.Fields("适合职位").Value
        
        AddDummyChild nd
        Data1.Recordset.MoveNext
    Loop
    Data1.Recordset.Close
    
End Sub

Sub AddDummyChild(nd As Node)
    ' add a dummy child node, if necessary
    If nd.Children = 0 Then
        ' dummy nodes' Text property is "***"
        tvwC.Nodes.Add nd.Index, tvwChild, , "***"
    End If
End Sub

Private Sub tvwC_Expand(ByVal Node As MSComctlLib.Node)
    ' a node if being expanded
    Dim nd As Node
    
    ' exit if the node had been already expanded in the past
    If Node.Children = 0 Or Node.Children > 1 Then Exit Sub
    ' also exit if it doesn't have a dummy child node
    If Node.Child.Text <> "***" Then Exit Sub
    ' remove the dummy child item
    tvwC.Nodes.Remove Node.Child.Index
    ' add all the titles for this Node object
    AddTitles Node
End Sub

Private Sub AddTitles(ByVal Node As MSComctlLib.Node)
    Dim nd As Node
    On Error Resume Next
    
    Data1.RecordSource = "select * from 类别表 where trim(适合职位) = '" & Trim(Node.Tag) & "'"
    
    Data1.Refresh
    
    Do Until Data1.Recordset.EOF
        Set nd = tvwC.Nodes.Add(Node, tvwChild, , Data1.Recordset.Fields("文件类别").Value, 1)
        
        nd.Tag = Data1.Recordset.Fields("文件类别").Value
        Data1.Recordset.MoveNext
    Loop
    Data1.Recordset.Close
End Sub


Private Sub tvwC_NodeClick(ByVal Node As MSComctlLib.Node)
    Dim temps As String
    Dim item As ListItem
    
    
    temps = Data1.RecordSource
    
    Data1.RecordSource = "select * from 文件表 " & " where 文件类别 = '" & Node.Tag & " '"
    Data1.Refresh
    
    lvListView.ListItems.Clear
    
    Do Until Data1.Recordset.EOF
        Set item = lvListView.ListItems.Add(, , Data1.Recordset.Fields("文件主题").Value, 2)
        item.Tag = Data1.Recordset.Fields("文件编号").Value
        Data1.Recordset.MoveNext
    Loop
    Data1.Recordset.Close
    Data1.RecordSource = temps
End Sub