frmlistcostprice.frm

金算盘软件代码

    Case 7: '筛选
        mclsMainControl_EditFilter
    Case 8: '栏目设置
        mclsMainControl_EditColumn
    Case 10: '打印
        mclsMainControl_ToolRefresh
    Case 11: '打印
        mclsMainControl_FilePrintReceipt
    Case 12
        mclsMainControl_FilePrint
    End Select
    mblnEnable = False
End Sub
     
'///////////////////响应主控对象事件////////////////////////////////////////////
'编辑
Private Sub mclsMainControl_EditEdit()
    Dim lngCostPriceID As Long
    
    lngCostPriceID = GetlngCostPriceID()
    If lngCostPriceID = -1 Then Exit Sub
    If mIsShowEdit Then
        theEditForm.ShowAOldBill (lngCostPriceID) '调用接口
    Else
        theEditForm.ShowAOldBill (lngCostPriceID) '调用接口
        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 lngCostPriceID As Long
    
    lngCostPriceID = GetlngCostPriceID()
    If lngCostPriceID = -1 Then Exit Sub
    If mIsShowEdit Then
        If lngCostPriceID = theEditForm.getID Then
            cMsgBox "不能删除当前编辑的单据！"
            Exit Sub
        End If
    End If
    If blnBillIsClosed(32, lngCostPriceID) Then
        cMsgBox "本张单据已经结帐,不能删除！"
    End If
    If Not DeleteCostPrice(lngCostPriceID) 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 lngCostPriceID As Long
On Error GoTo TheErr
    
    If grdList.TextMatrix(grdList.Row, 1) = "√" Then Exit Sub
    lngCostPriceID = GetlngCostPriceID()
    
    If blnBillIsClosed(32, lngCostPriceID) Then
        cMsgBox "本张单据已经结帐,不能作废！"
    End If
    
    If Not DeleteCostPrice(lngCostPriceID, 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
    
    Exit Sub
TheErr:
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, 10007
    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_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
'        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, 44, Me.Caption & Chr(1) & 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
               
    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.ShowStandardReport 249, 207
           Case 1:  '入库成本单一览表
               Report.ShowStandardReport 250, 208
    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 DeleteCostPrice(lngCostPriceID As Long, Optional blnByVoid As Boolean, Optional hwnd As Long = 0) As Boolean
    Dim strSql As String
    Dim strDelOrVoid As String
    Dim recTmp As rdoResultset
    If hwnd = 0 Then hwnd = Me.hwnd

On Error GoTo TheErr
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    
    If GetItemStatus(lngCostPriceID, hwnd) = False Then Exit Function
    If Not blnChange Then
        cMsgBox "不能" & Left(strDelOrVoid, 2) & "由他人制作的单据！", , hwnd
        Exit Function
    End If
        
    If blnByVoid Then
        If blnIsVoid Then Exit Function
        If ShowMsg(hwnd, "本张入库成本单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If blnIsVoid Then
            If ShowMsg(hwnd, "您确实要删除本张已作废的入库成本单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        Else
            If ShowMsg(hwnd, "您确实要删除本张入库成本单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
    End If
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    '1）单据是作废单据，不执行
    If Not blnIsVoid Then
        strSql = "DELETE CostPriceToPurchase.* From CostPriceToPurchase WHERE (((CostPriceToPurchase.lngCostPriceID)=" & lngCostPriceID & "));"
        gclsBase.ExecSQL strSql
    
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        strSql = "DELETE CostPriceDetail.* From CostPriceDetail WHERE (((CostPriceDetail.lngCostPriceID)=" & lngCostPriceID & "));"
        gclsBase.ExecSQL strSql
        strSql = "DELETE CostPrice.* From CostPrice WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "));"
        gclsBase.ExecSQL strSql
    Else
         strSql = "UPDATE CostPrice SET CostPrice.blnIsVoid = 1 WHERE (((CostPrice.lngCostPriceID)=" & lngCostPriceID & "));"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If
    strSql = "SELECT ItemActivityDetail.lngOrderDetailID FROM ItemActivityDetail , ItemActivity WHERE ItemActivity.lngActivityID=ItemActivityDetail.lngActivityID " & _
            " and (ItemActivity.lngReceiptTypeID=9 AND ItemActivityDetail.lngOrderDetailID=" & lngCostPriceID & ");"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    
    If recTmp.RowCount <> 0 Then
        Do While Not recTmp.EOF
            recTmp.Edit
            recTmp(0) = 0
            recTmp.Update
            recTmp.MoveNext
        Loop
    End If
    recTmp.Close
    Set recTmp = Nothing
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteCostPrice = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    cMsgBox Left(strDelOrVoid, 2) & "入库成本表失败！", , hwnd
End Function

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
    UpdateMenuStatus
    Me.Show
    Me.ZOrder 0
End Function