frmmain.frm

本人用vb编的一个定单管理系统,用于学习,简单实用!

         Caption         =   "纵向平铺(&V)"
      End
      Begin VB.Menu mnuWindowArrangeIcons 
         Caption         =   "排列图标(&A)"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "帮助(&H)"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "目录(&C)"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "搜索帮助主题(&S)..."
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "关于(&A) "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Const NAME_COLUMN = 0
Const TYPE_COLUMN = 1
Const SIZE_COLUMN = 2
Const DATE_COLUMN = 3
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)
  
Dim mbMoving As Boolean
Const sglSplitLimit = 500


Private Sub Form_Load()
    
    Dim no1 As Node, no2 As Node, no3 As Node
    Dim nox As Node
    Dim rootNode As Node, nd As Node
    
    ' Add the "Publishers" root (expanded).
    Set rootNode = tvTreeView.Nodes.Add(, , "\\root", "销售管理系统")
    rootNode.Expanded = True
    
    Me.Left = GetSetting(App.Title, "Settings", "MainLeft", 1000)
    Me.Top = GetSetting(App.Title, "Settings", "MainTop", 1000)
    Me.Width = GetSetting(App.Title, "Settings", "MainWidth", 6500)
    Me.Height = GetSetting(App.Title, "Settings", "MainHeight", 6500)
    
    Set no1 = tvTreeView.Nodes.Add(, , , "采购管理")
    Set no2 = tvTreeView.Nodes.Add(no1.Index, tvwChild, , "采购订单")
    Set no3 = tvTreeView.Nodes.Add(no1.Index, tvwChild, , "产品输入")
    Set no4 = tvTreeView.Nodes.Add(no1.Index, tvwChild, , "发货订单")
    
    Set no1 = tvTreeView.Nodes.Add(, , , "统计查询")
    Set no2 = tvTreeView.Nodes.Add(no1.Index, tvwChild, , "订单查询")
    Set no3 = tvTreeView.Nodes.Add(no1.Index, tvwChild, , "产品查询")
    
    For Each nox In tvTreeView.Nodes
        nox.Expanded = True
        nox.ExpandedImage = 1
    Next
End Sub
Private Sub tvTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
    Select Case Node.Text
        Case "采购订单"
            LoadDynamicControl ("Trade.uc采购订单")
        Case "订单查询"
            LoadDynamicControl ("Trade.UserControl1")
        Case "产品输入"
            LoadDynamicControl ("Trade.uc产品")
        Case Else
    End Select
End Sub


Private Sub Form_Paint()
    lvListView.View = Val(GetSetting(App.Title, "Settings", "ViewMode", "0"))
    Select Case lvListView.View
        Case lvwIcon
            tbToolBar.Buttons(LISTVIEW_MODE0).Value = tbrPressed
        Case lvwSmallIcon
            tbToolBar.Buttons(LISTVIEW_MODE1).Value = tbrPressed
        Case lvwList
            tbToolBar.Buttons(LISTVIEW_MODE2).Value = tbrPressed
        Case lvwReport
            tbToolBar.Buttons(LISTVIEW_MODE3).Value = tbrPressed
    End Select
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 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
    imgSplitter.Left = X

    '设置 Top 属性
  

    If tbToolBar.Visible Then
        tvTreeView.Top = tbToolBar.Height
    Else
        tvTreeView.Top = 0
    End If


    '设置 height 属性
    If sbStatusBar.Visible Then
        tvTreeView.Height = Me.ScaleHeight - sbStatusBar.Height
    Else
        tvTreeView.Height = Me.ScaleHeight
    End If
    

    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()
    '应做:添加 'mnuViewWebBrowser_Click' 代码。
    MsgBox "添加 'mnuViewWebBrowser_Click' 代码。"
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()
    '应做:添加 'mnuFileNew_Click' 代码。
    MsgBox "添加 'mnuFileNew_Click' 代码。"
End Sub

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

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

Private Sub mnuFileOpen_Click()
    Dim sFile As String


    With dlgCommonDialog
        .DialogTitle = "打开"
        .CancelError = False
        'ToDo: 设置 common dialog 控件的标志和属性
        .Filter = "所有文件 (*.*)|*.*"
        .ShowOpen
        If Len(.FileName) = 0 Then
            Exit Sub
        End If
        sFile = .FileName
    End With
    'ToDo: 添加处理打开的文件的代码

End Sub


Private Function LoadDynamicControl(obj As String)
    
    For i = 0 To Licenses.Count - 1
        If Licenses(i).ProgId = obj Then
            Licenses.Remove obj
            Exit For
        End If
    Next
            
    For i = 0 To Me.Controls.Count - 1
        If Me.Controls(i).Name = "ctl1" Then
            Me.Controls.Remove "ctl1"
            Exit For
        End If
    Next
    
   Licenses.Add obj, "ctl1"
   Set extObj = Me.Controls.Add(obj, "ctl1")
   
   Set extObj.Container = Me.Picture1
   With Me.Controls("ctl1")
      .Visible = True
      '.Container = Picture1
   End With
End Function