⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmmain.frm

📁 This a full 3-tier dababase application which includes a activex dll project(business objects) and a
💻 FRM
📖 第 1 页 / 共 2 页
字号:
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpContents 
         Caption         =   "&Contents"
      End
      Begin VB.Menu mnuHelpSearchForHelpOn 
         Caption         =   "&Search For Help On..."
      End
      Begin VB.Menu mnuHelpBar0 
         Caption         =   "-"
      End
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "&About "
      End
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Implements iForm
Private m_EnableAttr As ToolBarItems
Private Const mcstrMod$ = "frmMain"
Private Declare Function OSWinHelp% Lib "user32" Alias "WinHelpA" (ByVal hwnd&, ByVal HelpFile$, ByVal wCommand%, dwData As Any)

Public Sub SetStatus(Optional ByVal StatusText As String = vbNullString)
    On Error Resume Next
    If StatusText = vbNullString Then
        Me.sbStatusBar.Panels(1).Text = "Ready"
    Else
        Me.sbStatusBar.Panels(1).Text = StatusText
    End If
End Sub

Private Sub iForm_AddNew()
    'n.a
End Sub

Private Property Get iForm_Attributes() As ToolBarItems
    m_EnableAttr = tbCloseMe + tbOpen + tbHelp + tbMainMenu
    iForm_Attributes = m_EnableAttr
End Property

Private Sub iForm_Cancel()
    'n.a
End Sub

Private Sub iForm_CloseMe()
    End
End Sub

Private Sub iForm_delete()
    'n.a
End Sub

Private Sub iForm_DeleteRow()
    'n/a
End Sub

Private Property Get iForm_EnableAttributes() As ToolBarItems
    iForm_EnableAttributes = m_EnableAttr
End Property

Private Sub iForm_Find(ByVal Key As String)
    'n.a
End Sub

Private Property Get iForm_FindSubTools() As cFindSubTools
    'n.a
End Property

Private Sub iForm_HelpAbout()
    mnuHelpAbout_Click
End Sub

Private Sub iForm_MainMenu()
    mtMenus.Visible = Not mtMenus.Visible
End Sub

Private Function iForm_OpenDB() As Boolean
    'n/a
End Function

Private Sub iForm_PrintOut()
    'n/a
End Sub

Private Sub iForm_Refresh()
    'n.a
End Sub

Private Function iForm_Save() As Boolean
    'n.a
End Function

Private Sub iForm_ShowFormView()
    'n.a
End Sub

Private Sub MDIForm_Load()
    On Error GoTo Err_MDIForm_Load
    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)
    
    LoadMenus
    Exit Sub
Err_MDIForm_Load:
        ErrorMsg Err.Number, Err.Description, "MDIForm_Load", mcstrMod
    Exit Sub
End Sub


Private Sub MDIForm_Unload(Cancel As Integer)
        On Error Resume 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
End Sub

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

Private Sub mnuHelpSearchForHelpOn_Click()
    Dim nRet As Integer


    'if there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable To display Help Contents. There is no Help associated With this project.", 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 there is no helpfile for this project display a message to the user
    'you can set the HelpFile for your application in the
    'Project Properties dialog
    If Len(App.HelpFile) = 0 Then
        MsgBox "Unable To display Help Contents. There is no Help associated With this project.", 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()
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()
    Me.Arrange vbCascade
End Sub

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

Private Sub mnuFileExit_Click()
    'unload the form
    Unload Me

End Sub

Private Sub LoadMenus()
    With mtMenus.MenuTreeView
        Set .ImageList = ImageList1
        With .Nodes
            With .Add(, , "a0", "TimeBilling Shouts!", "Menus")
                .Bold = True
                .Expanded = True
            End With
            .Add "a0", 4, "WorkCode", "Work Code", "Menu"
            .Add "a0", 4, "PaymentMethod", "Payment Method", "Menu"
            .Add "a0", 4, "ExpenseCode", "Expense Code", "Menu"
            .Add "a0", 4, "Client", "Client", "Menu"
            .Add "a0", 4, "Employee", "Employee", "Menu"
            .Add "a0", 4, "ClientProject", "Project", "Menu"
            .Add "a0", 4, "TimeCard", "Time Card", "Menu"
            .Add "a0", 4, "ProjTimeCardExpense", "Project Time Card Expense", "Menu"
            .Add "a0", 4, "ProjTimeCardHour", "Project Time Card Hour", "Menu"
            .Add "a0", 4, "Payment", "Payment", "Menu"
            .Add "a0", 4, "TimeCardExpense", "Time Card Expense", "Menu"
            .Add "a0", 4, "TimeCardHour", "Time Card Hour", "Menu"
        End With
    End With
End Sub

Private Sub mtMenus_CloseMe()
    mtMenus.Visible = False
    With Me.tlBar.Buttons("Main")
        .Value = tbrUnpressed
    End With
End Sub

Private Sub mtMenus_NodeClick(ByVal Node As MSComctlLib.Node)
        On Error Resume Next
    Screen.MousePointer = vbHourglass
    If Not (Node Is Nothing) Then
        Select Case Node.Key
            Case "WorkCode"
                If Not IsLoaded(frmWorkCodeList) Then
                    frmWorkCodeList.Show
                Else
                    frmWorkCodeList.ZOrder 0
                End If
            Case "PaymentMethod"
                If Not IsLoaded(frmPaymentMethodList) Then
                    frmPaymentMethodList.Show
                Else
                    frmPaymentMethodList.ZOrder 0
                End If
            Case "ExpenseCode"
                If Not IsLoaded(frmExpenseCodeList) Then
                    frmExpenseCodeList.Show
                Else
                    frmExpenseCodeList.ZOrder 0
                End If
            Case "Client"
                If Not IsLoaded(frmClientList) Then
                    frmClientList.Show
                Else
                    frmClientList.ZOrder 0
                End If
            Case "Employee"
                If Not IsLoaded(frmEmployeeList) Then
                    frmEmployeeList.Show
                Else
                    frmEmployeeList.ZOrder 0
                End If
            Case "ClientProject"
                If Not IsLoaded(frmClientProjectList) Then
                    frmClientProjectList.Show
                Else
                    frmClientProjectList.ZOrder 0
                End If
            Case "TimeCard"
                If Not IsLoaded(frmTimeCardList) Then
                    frmTimeCardList.Show
                Else
                    frmTimeCardList.ZOrder 0
                End If
            Case "ProjTimeCardExpense"
                If Not IsLoaded(frmProjTimeCardExpenseList) Then
                    frmProjTimeCardExpenseList.Show
                Else
                    frmProjTimeCardExpenseList.ZOrder 0
                End If
            Case "ProjTimeCardHour"
                If Not IsLoaded(frmProjTimeCardHourList) Then
                    frmProjTimeCardHourList.Show
                Else
                    frmProjTimeCardHourList.ZOrder 0
                End If
            Case "Payment"
                If Not IsLoaded(frmPaymentList) Then
                    frmPaymentList.Show
                Else
                    frmPaymentList.ZOrder 0
                End If
            Case "TimeCardExpense"
                If Not IsLoaded(frmTimeCardExpenseList) Then
                    frmTimeCardExpenseList.Show
                Else
                    frmTimeCardExpenseList.ZOrder 0
                End If
            Case "TimeCardHour"
                If Not IsLoaded(frmTimeCardHourList) Then
                    frmTimeCardHourList.Show
                Else
                    frmTimeCardHourList.ZOrder 0
                End If
        End Select
    End If
    Screen.MousePointer = vbDefault
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -