frmpayablelist.frm

金算盘软件代码

    MakeListEditMenu
    UpdateMenuStatus
    PopupMenu frmMain.mnuListEdit, , cmdEdit.Left, cmdEdit.top + cmdEdit.Height
End Sub

Private Sub cmdReport_Click()
    MakeListReportMenu
    PopupMenu frmMain.mnuListReport, , cmdReport.Left, cmdReport.top + cmdReport.Height
End Sub

'/////////////////////////////////////////////////////////////////////////////////
'////////
'////////
'////////                            按纽菜单
'////////
'////////
'/////////////////////////////////////////////////////////////////////////////////

Private Sub MakeListEditMenu()
    Dim intCnt As Integer
    Dim i As Integer
    
    With frmMain
        For intCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(intCnt)
        Next
        For i = 1 To 14
            Load .mnuListEditMenu(i)
        Next i
    End With
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: '冲销
        Dim lngActivityID As Long
        
        lngActivityID = GetlngActivityID()
        If lngActivityID = -1 Then lngActivityID = 0
        lngActivityID = frmWriteOffBill.WriteOffBill(34, lngActivityID, Me.hwnd)
        If lngActivityID > 0 Then theEditForm.ShowAOldBill lngActivityID, True
    Case 6 '作废
        mclsMainControl_EditInActive
    Case 7: '全部显示
        mclsMainControl_EditShowAll
    Case 9: '筛选
        mclsMainControl_EditFilter
    Case 10: '栏目设置
        mclsMainControl_EditColumn
    Case 12: '刷新
        mclsMainControl_ToolRefresh
    Case 13: '打印
        mclsMainControl_FilePrintReceipt
    Case 14
        mclsMainControl_FilePrint
    End Select
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑
Private Sub mclsMainControl_EditEdit()
    Dim lngActivityID As Long
    
    lngActivityID = GetlngActivityID()
    If lngActivityID = -1 Then Exit Sub
    If mIsShowEdit Then
        theEditForm.ShowAOldBill (lngActivityID) '调用接口
    Else
        theEditForm.ShowAOldBill (lngActivityID) '调用接口
        mIsShowEdit = True
    End If
End Sub

'新增
Private Sub mclsMainControl_EditNew()
    If mIsShowEdit Then
        theEditForm.ShowANewBill
    Else
        theEditForm.ShowANewBill
        mIsShowEdit = True
    End If
End Sub

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngActivityID As Long
    
    lngActivityID = GetlngActivityID()
    If lngActivityID = -1 Then Exit Sub
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    
    If mIsShowEdit Then
        If lngActivityID = theEditForm.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    
    If Not mclsListMethod.DeleteRow(lngActivityID) Then Exit Sub
    
    '从Grid中删除本行
    With grdList
'        If .Rows = 2 Then '要删除的行是GRID 的最后一行
            mclsMainControl_ToolRefresh
'        Else
'            .RemoveItem (.Row)
'        End If
    End With
End Sub

'作废
Private Sub mclsMainControl_EditInActive()
    Dim lngActivityID As Long
    Dim theRow As Long
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    lngActivityID = GetlngActivityID()
    If Not GetItemStatus(lngActivityID) Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
    
    If Not mclsListMethod.ChangeVoid(lngActivityID) Then Exit Sub
        
    With grdList
        If chkShowAll.Value = 1 Then
            If .TextMatrix(.Row, 1) = "" Then
                .TextMatrix(.Row, 1) = "√"
            Else
                .TextMatrix(.Row, 1) = ""
            End If
        Else
            .TextMatrix(.Row, 1) = "√"
            .RowHeight(.Row) = 0
            mclsList.SetFlexRow
            chkShowAll.Enabled = True
            frmMain.mnuEditShowAll.Enabled = True
        End If
    End With
    mclsMainControl_ToolRefresh
'    UpdateMenuStatus
End Sub

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

Private Sub mclsMainControl_EditColumn()
    Dim strFind As String
    Dim strSort As String
    Dim intCount As Integer
    
    With grdList
        strFind = .TextMatrix(.Row, mclsList.SortCol)
        strSort = cboFindKind.Text
        If mclsList.ListSet.ShowListSet(intViewID) Then
            .Redraw = False
            grdList.Cols = 0
            Set datGrid.Resultset = GetList()
            datGrid.Resultset.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_EditFilter()
    Dim blnFlage As Boolean
   
   '执行过滤
    If mclsList.ListSet.ListID < 1 Then
       mclsList.ListSet.SaveList
       DefaultCurrentDate mclsList.ListSet.ListID, 9914
    End If
    Filter.ShowFilter mclsList.ListSet.ListID, 1, , , , , blnFlage
    If Not blnFlage Then Exit Sub
    grdList.Redraw = False
    mclsList.SaveListSet
    mclsList.ListSet.ViewId = intViewID
    'grdList.Cols = 0
    grdList.FixedCols = 0
    Set datGrid.Resultset = GetList()
    If Not datGrid.Resultset.EOF Then datGrid.Resultset.MoveLast
    datGrid.Resultset.Close
    mclsList.SetFlexGrid

    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    grdList.Redraw = True
End Sub
'搜索
Private Sub mclsMainControl_EditSearch()
On Error GoTo TheErr
    frmTreeFind.ShowFind
TheErr:
End Sub

'刷新
Private Sub mclsMainControl_ToolRefresh()
    Dim strOldText As String
    Dim strOldSort As String
    
    Me.MousePointer = vbHourglass
    
    With grdList
        '保存当前排序列
        strOldSort = cboFindKind.Text
        strOldText = .TextMatrix(.Row, mclsList.SortCol)
        .Redraw = False
        '刷新列表记录
        '.Cols = 0
        .FixedCols = 0
        Set datGrid.Resultset = GetList()
        datGrid.Resultset.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
    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, 47, Me.Caption & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName '应付款项               47
    mclsList.AddReGetColCaption
    Set myPrintclass = Nothing
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 = "应付余额表(&Y)"                   '"应付单汇总表"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        .mnuListReportMenu(0).Checked = False
        
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "应付明细表(&B)"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = True
        .mnuListReportMenu(1).Checked = False
        
    End With
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0:
        mclsMainControl_Report 0
    Case 1:
        mclsMainControl_Report 1
    End Select
End Sub

Private Sub mclsMainControl_Report(intReportType As Integer)
    Dim mclsPrintclass As PrintClass
    Set mclsPrintclass = New PrintClass
    Select Case intReportType
    Case 0:
         Report.ShowBalance 1421, 639
    Case 1:
         If gclsBase.ControlAccount Then
            Report.ShowStandardReport 256, 214
         Else
            Report.ShowStandardReport 1699, 1012
         End If
    End Select
    Set mclsPrintclass = Nothing
End Sub

Public Sub RefreshList(theCurrentID As Long)
    Dim i As Long
    mclsMainControl_ToolRefresh
    
   '将当前行设置到刷新后的ID=theCurrentID的行
    With grdList
        For i = 1 To .Rows - 1
            If CLng(.TextMatrix(i, 0)) = theCurrentID Then
                theEditRow = i
                GotoRow (i)
                Exit For
            End If
        Next i
    End With
End Sub

'告诉列表：编辑窗口已关闭
Public Sub IAmCLosed()
    mIsShowEdit = False
End Sub

Public Function BindingResultSet()
    Me.Hide
    '得到付款条件列表记录集
    Set datGrid.Resultset = GetList()
    datGrid.Resultset.Close
    
    mclsList.SetFlexGrid

    '初始化查找复合列表框
    mclsList.InitcboFindKind
    mclsList.FlexNoChange = False
    mclsList.FindNoChange = False
    '设置第一行为选定行
    With grdList
        If .Rows > 1 Then grdList.Row = 1
        .col = 0
        .ColSel = .Cols - 1
    End With
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    
    MakeListEditMenu
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function