frmvouchertypelist.frm

金算盘软件代码

    lngID = TermID
    Me.Enabled = False
    If lngID > 0 Then
        If CheckIDUsed("VoucherType", "lngVoucherTypeID", lngID) Then
'            frmVoucherTypeListCard.EditCard lngID
            frmEntryTypeCard.EditCard lngID, vbModal
        Else
            ShowMsg 0, "当前修改的凭证类型不存在，不能修改！", _
                      vbExclamation + MB_TASKMODAL, "修改凭证类型"
            mclsMainControl_ToolRefresh
        End If
    End If
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
'   frmVoucherTypeListCard.AddCard
    frmEntryTypeCard.AddCard , vbModal
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long
    lngID = TermID
    If mIsShowCard Then
'        If lngID = frmVoucherTypeListCard.VoucherTypeID And lngID > 0 Then
        If lngID = frmEntryTypeCard.VoucherTypeID And lngID > 0 Then
            MsgBox "不能删除当前编辑的凭证类型！", vbExclamation
            frmEntryTypeCard.EditCard lngID, vbModal
'            frmVoucherTypeListCard.Show
'            frmVoucherTypeListCard.ZOrder 0
            Exit Sub
        End If
    End If
'
'    If frmVoucherTypeListCard.DelCard(TermID) Then
    If frmEntryTypeCard.DelCard(TermID) Then
        With msgTerm
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            mclsList.SetFlexRow
        End With
        gclsSys.SendMessage CStr(Me.hwnd), Message.msgVoucherType
    End If
    UpdateMenuStatus
    'If Not frmVoucherTypeListCard.Visible Then
'    Unload frmVoucherTypeListCard
End Sub

'停用/启用记录
Private Sub mclsMainControl_EditInActive()
     If UpdateTermInActive(TermID, Not TermIsInActive) Then
        With msgTerm
            If chkShowAll.Value Then
                If .TextMatrix(.Row, 1) = "" Then
                    .TextMatrix(.Row, 1) = "√"
                Else
                    .TextMatrix(.Row, 1) = ""
                End If
            Else
                .TextMatrix(.Row, 1) = "√"
                .RowHeight(.Row) = 0
                mclsList.SetFlexRow
            End If
        End With
        gclsSys.SendMessage CStr(Me.hwnd), Message.msgVoucherType
    End If
    UpdateMenuStatus
End Sub

'全部显示/显示未停用记录
Private Sub mclsMainControl_EditShowAll()
    frmMain.mnuEditShowAll.Checked = Not frmMain.mnuEditShowAll.Checked
    If chkShowAll.Value = 0 Then
        chkShowAll.Value = 1
    Else
        chkShowAll.Value = 0
    End If
End Sub

'引用编码
Private Sub mclsMainControl_EditUse()
    UseCode Message.msgVoucherType, TermID
    Me.ZOrder 1
End Sub

'筛选
Private Sub mclsMainControl_EditFilter()
    Dim blnFlage As Boolean
    
    If Not mblnIsSaveListset Then
        If Not FindlngViewID(intViewID) Then mclsList.ListSet.SaveList
        mblnIsSaveListset = True
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    msgTerm.Cols = 0
    Set datTerm.Recordset = GetList()
    If Not datTerm.Recordset.EOF Then datTerm.Recordset.MoveLast
    datTerm.Recordset.Close
    'Set datTerm.Recordset = Nothing
    mclsList.SetFlexGrid
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
End Sub

'栏目设置
Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With msgTerm
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            msgTerm.Cols = 0
            Set datTerm.Recordset = GetList()
            If Not datTerm.Recordset.EOF Then datTerm.Recordset.MoveLast
            datTerm.Recordset.Close
            'Set datTerm.Recordset = Nothing
            mclsList.SetFlexGrid
            UpdateMenuStatus
            '初始化查找复合列表框
            mclsList.InitcboFindKind
            For intCount = 0 To cboFindKind.ListCount - 1
                If cboFindKind.list(intCount) = strSort Then
                    txtfind.Text = strFind
                    Exit For
                End If
            Next intCount
            If chkShowAll.Value = 0 Then mclsList.DoShowAll False
            .Redraw = True
        End If
    End With
End Sub

'搜索
Private Sub mclsMainControl_EditSearch()
    frmTreeFind.ShowFind
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldSort As String
    Dim strOldText As String
    
    Me.MousePointer = vbHourglass
    With msgTerm
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        mclsList.SaveListColWidth
        .Redraw = False
        '刷新列表记录
        .Cols = 0
        Set datTerm.Recordset = GetList()
        If Not datTerm.Recordset.EOF Then datTerm.Recordset.MoveLast
        datTerm.Recordset.Close
        'Set datTerm.Recordset = Nothing
        mclsList.SetFlexGrid
        '恢复以前排序列
        cboFindKind.Text = strOldSort
        cboFindKind.Text = strOldSort
        .Redraw = False
        If .Rows > 1 Then
            txtfind.Text = strOldText
        End If
        If chkShowAll.Value = 0 Then mclsList.DoShowAll False
        '更新菜单状态
        UpdateMenuStatus
        .Redraw = True
        '发出付款条件消息
    End With
    Me.MousePointer = vbDefault
End Sub

'打印
Private Sub mclsMainControl_FilePrint()
    Dim myPrintclass As PrintClass
    Set myPrintclass = New PrintClass
    mclsList.ReGetColCaption
    myPrintclass.PrintList gclsBase.BaseDB, mclsList.FlexGrid, 30, Me.Caption & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
End Sub

'响应“编辑”菜单
Private Sub mclsMainControl_ListEditMenu(ByVal intIndex As Integer)
    Select Case intIndex
        Case 0:
            mclsMainControl_EditEdit
        Case 1:
            mclsMainControl_EditNew
        Case 2:
            mclsMainControl_EditDel
        Case 4:
            mclsMainControl_EditInActive
        Case 5:
            mclsMainControl_EditShowAll
        Case 7:
            mclsMainControl_EditUse
        Case 8
            mclsMainControl_EditSearch
        Case 10:
            mclsMainControl_EditFilter
        Case 11:
            mclsMainControl_EditColumn
        Case 13:
            mclsMainControl_ToolRefresh
        Case 14:
            mclsMainControl_FilePrint
        
        End Select
End Sub
'
' 编辑菜单
'
Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        
        Utility.CloneMenu .mnuEditEdit, .mnuListEditMenu(0)
        
        Load .mnuListEditMenu(1)
        Utility.CloneMenu .mnuEditNew, .mnuListEditMenu(1)
        
        Load .mnuListEditMenu(2)
        Utility.CloneMenu .mnuEditDel, .mnuListEditMenu(2)
        .mnuListEditMenu(2).Caption = "删除(&D)"
        Load .mnuListEditMenu(3)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(3)
        
        Load .mnuListEditMenu(4)
        Utility.CloneMenu .mnuEditInActive, .mnuListEditMenu(4)
        .mnuListEditMenu(4).Caption = "停用(&H)"
        Load .mnuListEditMenu(5)
        Utility.CloneMenu .mnuEditShowAll, .mnuListEditMenu(5)
        .mnuListEditMenu(5).Caption = "全部显示(&W)"
        
        Load .mnuListEditMenu(6)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(6)
        .mnuListEditMenu(6).Visible = False
        
        Load .mnuListEditMenu(7)
        Utility.CloneMenu .mnuEditUse, .mnuListEditMenu(7)
        
        Load .mnuListEditMenu(8)
        Utility.CloneMenu .mnuEditSearch, .mnuListEditMenu(8)
        
        Load .mnuListEditMenu(9)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(9)
        
        Load .mnuListEditMenu(10)
        Utility.CloneMenu .mnuEditFilter, .mnuListEditMenu(10)
        
        Load .mnuListEditMenu(11)
        Utility.CloneMenu .mnuEditColumn, .mnuListEditMenu(11)
        
        Load .mnuListEditMenu(12)
        Utility.CloneMenu .mnuEditBar2, .mnuListEditMenu(12)
        
        Load .mnuListEditMenu(13)
        Utility.CloneMenu .mnuToolRefresh, .mnuListEditMenu(13)
        
        Load .mnuListEditMenu(14)
        Utility.CloneMenu .mnuFilePrint, .mnuListEditMenu(14)
    End With
End Sub
'
' 报表菜单
'
Private Sub MakeListReportMenu()
    Dim intCnt As Integer
    
    With frmMain
        For intCnt = .mnuListReportMenu.Count - 1 To 1 Step -1
            Unload .mnuListReportMenu(intCnt)
        Next
'        .mnuListReportMenu(0).Caption = "凭证类别一览表"
'        .mnuListReportMenu(0).Enabled = True
'        .mnuListReportMenu(0).Visible = True
        
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'
'        Load .mnuListReportMenu(1)
'        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
'        Load .mnuListReportMenu(2)
        .mnuListReportMenu(0).Caption = "凭证类型一览表(&D)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
    End With
End Sub

'“钩子”事件
Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    '“钩子”事件处理
    mclsList.HookProc Msg, wParam, lParam, mclsSubClass
End Sub




'凭证类别一览表
Private Sub VoucherTable()
    Report.ShowListReport 318, 358
End Sub
'凭证汇总表
Private Sub VoucherTotail()
   ' Report.ShowListReport 353, 395
End Sub
Private Function CurrCodeName() As String
    Dim strCode As String
    Dim strName As String
    Dim i As Integer
    With mclsList.FlexGrid
        If .Row > 0 Then
            For i = 0 To mclsList.ListSet.FixColumns - 1
                If .TextMatrix(0, 2 + i) = "凭证类型编码" Or .TextMatrix(0, 2 + i) = "凭证类型编码↑" Or .TextMatrix(0, 2 + i) = "凭证类型编码↓" Then
                    strCode = .TextMatrix(.Row, 2 + i)
                ElseIf .TextMatrix(0, i + 2) = "凭证类型名称" Or .TextMatrix(0, i + 2) = "凭证类型名称↑" Or .TextMatrix(0, i + 2) = "凭证类型名称↓" Then
                    strName = .TextMatrix(.Row, 2 + i)
                End If
            Next
        End If
    End With
    CurrCodeName = Trim(strCode) & " " & Trim(strName)
End Function