termlist.frm

金算盘软件代码

        If Button = vbRightButton Then
            Form_MouseDown Button, Shift, X, y
        End If
    End With
End Sub

'鼠标左键弹起时，更新菜单
Private Sub msgTerm_MouseUp(Button As Integer, Shift As Integer, X As Single, y As Single)
    With msgTerm
        If Button = vbLeftButton Then
            If chkShowall.Value = 1 And .ColSel > 0 And .MouseRow > 0 And .Row > 0 Then
                If X > .ColPos(1) And X < .ColPos(2) Then
                    mclsMainControl_EditInActive
                End If
            End If
            UpdateMenuStatus
        End If
    End With
End Sub

'
'响应主控对象事件
'

'编辑卡片
Private Sub mclsMainControl_EditEdit()
    Dim lngID As Long
    lngID = TermID
    Me.Enabled = False
    If lngID > 0 Then
        If CheckIDUsed("Term", "lngTermID", lngID) Then
'            frmtermlistcard.EditCard lngID
            frmTermCard.EditCard lngID, vbModal
        Else
            ShowMsg 0, "付款条件不存在，不能修改！", vbExclamation + MB_TASKMODAL, "修改付款条件"
            mclsMainControl_ToolRefresh
        End If
    End If
    Me.Enabled = True
End Sub

'新增卡片
Private Sub mclsMainControl_EditNew()
'    frmtermlistcard.AddCard
    frmTermCard.AddCard , vbModal
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngID As Long

    lngID = TermID
    If mIsShowCard Then
'        If lngID = frmtermlistcard.TermID And lngID > 0 Then
        If lngID = frmTermCard.TermID And lngID > 0 Then
            MsgBox "不能删除当前编辑的付款条件！", vbExclamation
'            frmtermlistcard.Show
'            frmtermlistcard.ZOrder 0
            frmTermCard.EditCard lngID, vbModal
            Exit Sub
        End If
    End If
'    If frmtermlistcard.DelCard(TermID) Then
    If frmTermCard.DelCard(TermID) Then
        With msgTerm
            .RowHeight(.Row) = 0
            .RowData(.Row) = 1
            mclsList.SetFlexRow
        End With
        gclsSys.SendMessage CStr(Me.hwnd), Message.msgTerm
    End If
    UpdateMenuStatus
'    Unload frmtermlistcard
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
    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.msgTerm, 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
    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
            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 strOldText As String
    Dim strOldSort 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
        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
'        '发出付款条件消息
'        gclsSys.SendMessage CStr(Me.hWnd), Message.msgTerm
    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, 32, 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
        
'        Utility.CloneMenu .mnuReportQuick, .mnuListReportMenu(0)
'
'        Load .mnuListReportMenu(1)
'        Utility.CloneMenu .mnuEditBar2, .mnuListReportMenu(1)
'
'        Load .mnuListReportMenu(2)
        .mnuListReportMenu(0).Caption = "付款条件一览表(&T)"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
    End With
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