hcconst.bas

财务信息管理系统,适合做毕业论文的人使用

                            objRefAll.DRGetAttrib 3, vParaA
                        Else
                            objRefAll.DRGetAttrib 4, vParaA
                        End If
                    End If
                End If
                Set objRefAll = Nothing
                ParaRet = vParaA
        End Select
errHandle:
    Resume Next
End Sub
'获取机器名
Public Function ComputerName() As String
    Dim str As String * 128
    Dim strSize As Long
    
    strSize = 127
    GetComputerName str, strSize
    ComputerName = LeftEx(str, IIf(strSize > 30, 30, strSize))
End Function

Public Sub CloseRS(rsl As Variant)
    On Error Resume Next
    If Not rsl Is Nothing Then
        rsl.oClose
        Set rsl = Nothing
    End If
    On Error GoTo 0
End Sub
'初始化工具栏
Public Sub ImageList_Initialize(ImgLst As Object)
    Dim imgX As ListImage
    With ImgLst
        Set imgX = .ListImages.Add(, "Print", LoadResPicture(314, vbResBitmap))
        Set imgX = .ListImages.Add(, "Preview", LoadResPicture(312, vbResBitmap))
        Set imgX = .ListImages.Add(, "Dataout", LoadResPicture(263, vbResBitmap))
        Set imgX = .ListImages.Add(, "Export", LoadResPicture(263, vbResBitmap))
        Set imgX = .ListImages.Add(, "add", LoadResPicture(323, vbResBitmap))
        Set imgX = .ListImages.Add(, "AddNew", LoadResPicture(323, vbResBitmap))
        Set imgX = .ListImages.Add(, "Edit", LoadResPicture(324, vbResBitmap))
        Set imgX = .ListImages.Add(, "del", LoadResPicture(326, vbResBitmap))
        Set imgX = .ListImages.Add(, "Save", LoadResPicture(1145, vbResBitmap))
        Set imgX = .ListImages.Add(, "Cancel", LoadResPicture(316, vbResBitmap))
        Set imgX = .ListImages.Add(, "free", LoadResPicture(353, vbResBitmap))
        Set imgX = .ListImages.Add(, "find", LoadResPicture(309, vbResBitmap))
        Set imgX = .ListImages.Add(, "help", LoadResPicture(396, vbResBitmap))
        Set imgX = .ListImages.Add(, "exit", LoadResPicture(1118, vbResBitmap))
        Set imgX = .ListImages.Add(, "tree", LoadResPicture(1111, vbResBitmap))
        Set imgX = .ListImages.Add(, "seltree", LoadResPicture(1112, vbResBitmap))
        Set imgX = .ListImages.Add(, "leaf", LoadResPicture(1128, vbResBitmap))
        Set imgX = .ListImages.Add(, "leafsel", LoadResPicture(1129, vbResBitmap))
        Set imgX = .ListImages.Add(, "destroy", LoadResPicture(1105, vbResBitmap))
        Set imgX = .ListImages.Add(, "Destroy", LoadResPicture(1105, vbResBitmap))
        Set imgX = .ListImages.Add(, "import", LoadResPicture(364, vbResBitmap))
        Set imgX = .ListImages.Add(, "add1", LoadResPicture(343, vbResBitmap))
        Set imgX = .ListImages.Add(, "del1", LoadResPicture(347, vbResBitmap))
        Set imgX = .ListImages.Add(, "AddCol", LoadResPicture(343, vbResBitmap))
        Set imgX = .ListImages.Add(, "DelCol", LoadResPicture(347, vbResBitmap))
        'Set imgX = .ListImages.Add(, "cut", LoadResPicture(317, vbResBitmap))
        Set imgX = .ListImages.Add(, "copy", LoadResPicture(318, vbResBitmap))
        Set imgX = .ListImages.Add(, "paste", LoadResPicture(319, vbResBitmap))
        Set imgX = .ListImages.Add(, "save", LoadResPicture(1145, vbResBitmap))
        Set imgX = .ListImages.Add(, "calc", LoadResPicture(372, vbResBitmap))
        Set imgX = .ListImages.Add(, "refresh", LoadResPicture(154, vbResBitmap))
        Set imgX = .ListImages.Add(, "Refresh", LoadResPicture(154, vbResBitmap))
        Set imgX = .ListImages.Add(, "switch", LoadResPicture(226, vbResBitmap))
        Set imgX = .ListImages.Add(, "Switch", LoadResPicture(226, vbResBitmap))
        Set imgX = .ListImages.Add(, "bill", LoadResPicture(1102, vbResBitmap))
        Set imgX = .ListImages.Add(, "Pz", LoadResPicture(143, vbResBitmap))
    End With
End Sub
'初始化工具栏
Public Sub ToolBar_Initialize(tlb As ToolBar, key As String, ToolBut As ButType)

    With tlb
        Select Case ToolBut
            Case TB_PRINT
                .Buttons(key).Caption = "打印"
                .Buttons(key).Image = "Print"
                .Buttons(key).ToolTipText = "Ctrl+P"
            Case TB_PREVIEW
                .Buttons(key).Caption = "预览"
                .Buttons(key).Image = "Preview"
'                .Buttons(key).ToolTipText = "Ctrl+S" 'cuidong 2001.01.15
                .Buttons(key).ToolTipText = ""        'cuidong 2001.01.15
            Case TB_HELP
                .Buttons(key).Caption = "帮助"
                .Buttons(key).Image = "help"
                .Buttons(key).ToolTipText = "F1"
            Case TB_Freeze
                .Buttons(key).Caption = "冻结"
                .Buttons(key).Image = "free"
                .Buttons(key).ToolTipText = "Ctrl+Z"
            Case TB_FIND
                .Buttons(key).Caption = "查找"
                .Buttons(key).Image = "find"
                .Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_EXIT
                .Buttons(key).Caption = "退出"
                .Buttons(key).Image = "exit"
                .Buttons(key).ToolTipText = "Ctrl+F4"
            Case TB_Destroy
                .Buttons(key).Caption = "销户"
                .Buttons(key).Image = "destroy"
                .Buttons(key).ToolTipText = "Ctrl+O"
            Case TB_Del
                .Buttons(key).Caption = "删除"
                .Buttons(key).Image = "del"
                .Buttons(key).ToolTipText = "Ctrl+Y"
            Case TB_DATAOUT
                .Buttons(key).Caption = "输出"
                .Buttons(key).Image = "Dataout"
                .Buttons(key).ToolTipText = "Ctrl+W"
            Case TB_ADD
                .Buttons(key).Caption = "增加"
                .Buttons(key).Image = "add"
                .Buttons(key).ToolTipText = "F5"
            Case TB_IMPORT
                .Buttons(key).Caption = "引入"
                .Buttons(key).Image = "import"
                .Buttons(key).ToolTipText = "Ctrl+I"
            Case TB_ADD1
                .Buttons(key).Caption = "增加"
                .Buttons(key).Image = "add1"
                .Buttons(key).ToolTipText = "F3"
            Case TB_DEL1
                .Buttons(key).Caption = "删除"
                .Buttons(key).Image = "del1"
                .Buttons(key).ToolTipText = "Alt+Y"
            Case TB_COPY
                .Buttons(key).Caption = "复制"
                .Buttons(key).Image = "copy"
                .Buttons(key).ToolTipText = "Ctrl+C"
            Case TB_PASTE
                .Buttons(key).Caption = "粘贴"
                .Buttons(key).Image = "paste"
                .Buttons(key).ToolTipText = "Ctrl+V"
            Case TB_Save
                .Buttons(key).Caption = "保存"
                .Buttons(key).Image = "save"
                .Buttons(key).ToolTipText = "F6"
            Case TB_CALC
                .Buttons(key).Caption = "计算"
                .Buttons(key).Image = "calc"
                .Buttons(key).ToolTipText = "Ctrl+R"
            Case TB_SWITCH
                .Buttons(key).Caption = "切换"
                .Buttons(key).Image = "switch"
                .Buttons(key).ToolTipText = "F8"
            Case TB_Refresh
                .Buttons(key).Caption = "刷新"
                .Buttons(key).Image = "refresh"
                .Buttons(key).ToolTipText = "Ctrl+R"
            Case TB_BILL
                .Buttons(key).Caption = "单据"
                .Buttons(key).Image = "bill"
                .Buttons(key).ToolTipText = "F4"
        End Select
    End With
    
End Sub
'初始化工具栏
Public Sub MSToolBar_Initialize(tlb As MsComctlLib.ToolBar, key As String, ToolBut As ButType)
    With tlb
        Select Case ToolBut
            Case TB_PRINT
                .Buttons(key).Caption = "打印"
                .Buttons(key).Image = "Print"
                .Buttons(key).ToolTipText = "Ctrl+P"
            Case TB_PREVIEW
                .Buttons(key).Caption = "预览"
                .Buttons(key).Image = "Preview"
'                .Buttons(key).ToolTipText = "Ctrl+S" 'cuidong 2001.01.15
                .Buttons(key).ToolTipText = ""        'cuidong 2001.01.15
            Case TB_Export
                .Buttons(key).Caption = "输出"
                .Buttons(key).Image = "Export"
                '.Buttons(key).ToolTipText = "Ctrl+W"
            Case TB_HELP
                .Buttons(key).Caption = "帮助"
                .Buttons(key).Image = "help"
                .Buttons(key).ToolTipText = "F1"
            Case TB_AddNew
                .Buttons(key).Caption = "增加"
                .Buttons(key).Image = "AddNew"
                .Buttons(key).ToolTipText = "F5"
            Case TB_Edit
                .Buttons(key).Caption = "修改"
                .Buttons(key).Image = "Edit"
                .Buttons(key).ToolTipText = "F12"
            Case TB_Freeze
                .Buttons(key).Caption = "冻结"
                .Buttons(key).Image = "free"
                '.Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_FIND
                .Buttons(key).Caption = "查询"
                .Buttons(key).Image = "Find"
                .Buttons(key).ToolTipText = "F3"
            Case TB_EXIT
                .Buttons(key).Caption = "退出"
                .Buttons(key).Image = "exit"
                .Buttons(key).ToolTipText = "Ctrl+F4"
            Case TB_Destroy
                .Buttons(key).Caption = "销户"
                .Buttons(key).Image = "destroy"
                '.Buttons(key).ToolTipText = "Ctrl+O"
            Case TB_Del
                .Buttons(key).Caption = "删除"
                .Buttons(key).Image = "del"
                .Buttons(key).ToolTipText = "Del"
            Case TB_Delete
                .Buttons(key).Caption = "删除"
                .Buttons(key).Image = "Delete"
                .Buttons(key).ToolTipText = "Del"
            Case TB_DATAOUT
                .Buttons(key).Caption = "输出"
                .Buttons(key).Image = "Dataout"
                '.Buttons(key).ToolTipText = "Ctrl+W"
            Case TB_ADD
                .Buttons(key).Caption = "增加"
                .Buttons(key).Image = "add"
                .Buttons(key).ToolTipText = "F5"
            Case TB_IMPORT
                .Buttons(key).Caption = "引入"
                .Buttons(key).Image = "Import"
                '.Buttons(key).ToolTipText = "Ctrl+I"
            Case TB_AddCol
                .Buttons(key).Caption = "增行"
                .Buttons(key).Image = "add1"
                .Buttons(key).ToolTipText = "Ctrl+I"
            Case TB_ADD1
                .Buttons(key).Caption = "增加"
                .Buttons(key).Image = "add1"
                .Buttons(key).ToolTipText = "Ctrl+I"
            Case TB_DelCol
                .Buttons(key).Caption = "删行"
                .Buttons(key).Image = "del1"
                .Buttons(key).ToolTipText = "Ctrl+D"
            Case TB_DEL1
                .Buttons(key).Caption = "删除"
                .Buttons(key).Image = "del1"
                .Buttons(key).ToolTipText = "Ctrl+D"
            Case TB_COPY
                .Buttons(key).Caption = "复制"
                .Buttons(key).Image = "copy"
                .Buttons(key).ToolTipText = "Ctrl+C"
            Case TB_PASTE
                .Buttons(key).Caption = "粘贴"
                .Buttons(key).Image = "paste"
                .Buttons(key).ToolTipText = "Ctrl+V"
            Case TB_Save
                .Buttons(key).Caption = "保存"
                .Buttons(key).Image = "save"
                .Buttons(key).ToolTipText = "F6"
            Case TB_Cancel
                .Buttons(key).Caption = "放弃"
                .Buttons(key).Image = "Cancel"
                .Buttons(key).ToolTipText = "Ctrl+Z"
            Case TB_CALC
                .Buttons(key).Caption = "计算"
                .Buttons(key).Image = "calc"
                .Buttons(key).ToolTipText = "F9"
            Case TB_SWITCH
                .Buttons(key).Caption = "切换"
                .Buttons(key).Image = "switch"
                .Buttons(key).ToolTipText = "F8"
            Case TB_Refresh
                .Buttons(key).Caption = "刷新"
                .Buttons(key).Image = "refresh"
                '.Buttons(key).ToolTipText = "Ctrl+R"
            Case TB_BILL
                .Buttons(key).Caption = "单据"
                .Buttons(key).Image = "bill"
                '.Buttons(key).ToolTipText = "F4"
            Case TB_ColumnSet
                .Buttons(key).Caption = "栏目"
                .Buttons(key).Image = "ColumnSet"
                '.Buttons(key).ToolTipText = "F11"
            Case TB_Pz
                .Buttons(key).Caption = "凭证"
                .Buttons(key).Image = "Pz"
                '.Buttons(key).ToolTipText = "Ctrl+B"
            Case TB_Check
                .Buttons(key).Caption = "审核"
                .Buttons(key).Image = "Check"
                '.Buttons(key).ToolTipText = "Ctrl+C"
            Case TB_CancelCheck
                .Buttons(key).Caption = "弃审"
                .Buttons(key).Image = "CancelCheck"
                '.Buttons(key).ToolTipText = "Ctrl+U"
            Case TB_BatchCheck
                .Buttons(key).Caption = "批审"
                .Buttons(key).Image = "BatchCheck"
                '.Buttons(key).ToolTipText = "Ctrl+C"
            Case TB_BatchCancel
                .Buttons(key).Caption = "批弃"
                .Buttons(key).Image = "BatchCancel"
                '.Buttons(key).ToolTipText = "Ctrl+C"
            Case TB_First
                .Buttons(key).Caption = "首页"
                .Buttons(key).Image = "First"
                .Buttons(key).ToolTipText = "Alt+PageUp"
            Case TB_Previous
                .Buttons(key).Caption = "上页"
                .Buttons(key).Image = "Previous"
                .Buttons(key).ToolTipText = "PageUp"
            Case TB_Next
                .Buttons(key).Caption = "下页"
                .Buttons(key).Image = "Next"
                .Buttons(key).ToolTipText = "PageDown"
            Case TB_Last
                .Buttons(key).Caption = "末页"
                .Buttons(key).Image = "Last"
                .Buttons(key).ToolTipText = "Alt+PageDown"
            Case TB_ShowDestroy
                .Buttons(key).Caption = "未销"
                .Buttons(key).Image = "ShowDestroy"
                '.Buttons(key).ToolTipText = "Ctrl+H"
            Case TB_Grouping
                .Buttons(key).Caption = "分组"
                .Buttons(key).Image = "Grouping"
                '.Buttons(key).ToolTipText = "Ctrl+N"
            Case TB_Freeze
                .Buttons(key).Caption = "冻结"
                .Buttons(key).Image = "Freeze"
                '.Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_Approve
                .Buttons(key).Caption = "审批"
                .Buttons(key).Image = "Approve"
                '.Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_SelAll
                .Buttons(key).Caption = "全选"
                .Buttons(key).Image = "SelAll"
                '.Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_UnSelAll
                .Buttons(key).Caption = "全消"
                .Buttons(key).Image = "UnSelAll"
                '.Buttons(key).ToolTipText = "Ctrl+F"
            Case TB_Ratio
                .Buttons(key).Caption = "比例"
                .Buttons(key).Image = "Ratio"
                '.Buttons(key).ToolTipText = "Ctrl+F"
        End Select
    End With
    
End Sub

Public Function TreeNodeGrade(NodePath As String) As Integer

    TreeNodeGrade = CharNumInStr(NodePath, "\")