frmlistpurchaseorder.frm

金算盘软件代码

Private Sub cmdEdit_Click()
    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 12
            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: '作废
        mclsMainControl_EditInActive
    Case 5: '全部显示
        mclsMainControl_EditShowAll
    Case 7: '筛选
        mclsMainControl_EditFilter
    Case 8: '栏目设置
        mclsMainControl_EditColumn
    Case 10: '打印
        mclsMainControl_ToolRefresh
    Case 11: '打印
        mclsMainControl_FilePrintReceipt
    Case 12
        mclsMainControl_FilePrint
    End Select
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑（修改）
Private Sub mclsMainControl_EditEdit()
    Dim lngPurchaseOrderID As Long
    Me.Enabled = False
    lngPurchaseOrderID = GetlngPurchaseOrderID()
    
    If lngPurchaseOrderID = -1 Then Exit Sub
    If mIsShowEdit Then
        theEditForm.ShowAOldBill (lngPurchaseOrderID) '调用接口
    Else
        theEditForm.ShowAOldBill (lngPurchaseOrderID) '调用接口
        mIsShowEdit = True
    End If
    Me.Enabled = True
End Sub

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

'删除记录
Private Sub mclsMainControl_EditDel()
    Dim lngPurchaseOrderID As Long
    
    lngPurchaseOrderID = GetlngPurchaseOrderID()
      
    If lngPurchaseOrderID = -1 Then Exit Sub
    If Not GetItemStatus(lngPurchaseOrderID) Then Exit Sub
    
    If mIsShowEdit Then
        If lngPurchaseOrderID = theEditForm.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    
    If Not blnChange Then
        cMsgBox "不能删除由他人制作的单据！"
        Exit Sub
    End If
    
    If Not mclsPurchaseOrder.DeletePurchaseOrder(lngPurchaseOrderID) 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 lngPurchaseOrderID As Long
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    lngPurchaseOrderID = GetlngPurchaseOrderID()
    If GetItemStatus(lngPurchaseOrderID) = False Then Exit Sub
    If Not blnChange Then
        cMsgBox "不能作废由他人制作的单据！"
        Exit Sub
    End If
            
    If Not mclsPurchaseOrder.DeletePurchaseOrder(lngPurchaseOrderID, True) 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
    
    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
'            FormatGrid Me
            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, 10539
    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
'    FormatGrid Me
    UpdateMenuStatus
    '初始化查找复合列表框
    mclsList.InitcboFindKind
    If chkShowAll.Value = 0 Then mclsList.DoShowAll False
    grdList.Redraw = True
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
'        FormatGrid Me
        '恢复以前排序列
        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, 35, Me.Caption & Chr(1) & Trim(gclsBase.BaseName) & Chr(1) & gclsBase.OperatorName '采购订单
    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 = "采购订单汇总表"
        .mnuListReportMenu(0).Enabled = True
        .mnuListReportMenu(0).Visible = True
        .mnuListReportMenu(0).Checked = False
        
        Load .mnuListReportMenu(1)
        .mnuListReportMenu(1).Caption = "采购订单明细表"
        .mnuListReportMenu(1).Enabled = True
        .mnuListReportMenu(1).Visible = True
        .mnuListReportMenu(1).Checked = False
        
         Load .mnuListReportMenu(2)
        .mnuListReportMenu(2).Caption = "采购订单执行情况表"
        .mnuListReportMenu(2).Enabled = True
        .mnuListReportMenu(2).Visible = True
        .mnuListReportMenu(2).Checked = False
        
'         Load .mnuListReportMenu(3)
'        .mnuListReportMenu(3).Caption = "未关闭采购订单表"
'        .mnuListReportMenu(3).Enabled = True
'        .mnuListReportMenu(3).Visible = True
'        .mnuListReportMenu(3).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
    Case 2:
        mclsMainControl_Report 2
'    Case 3:
'        mclsMainControl_Report 3
   
    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.ShowSumReport 1562, 687
    Case 1:
         Report.ShowStandardReport 1561, 686
    Case 2:
         Report.ShowSumReport 1563, 688
'    Case 3:
'         Report.ShowStandardReport 1560, 685
    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
'    FormatGrid Me
    '初始化查找复合列表框
    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
    
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function