frmin.frm

针对农资系统的管理模式而开发的业务部门与财务部门的转账模式和过程

    txtEntryNo.Enabled = Not bVal
    txtStoreMan.Enabled = Not bVal
    txtVerified.Enabled = Not bVal
    txtKeeper.Enabled = False
    txtAuditer.Enabled = False
    txtMaker.Enabled = False
    txtFindNo.Enabled = bVal And Not bEmpty
    
    With grdDataGrid
        .AllowUpdate = Not bVal
        .AllowAddNew = IIf(m_byType = IN_INVOICE Or m_byType = BACK_INVOICE, False, True)
        .AllowDelete = IIf(m_byType = IN_INVOICE Or m_byType = BACK_INVOICE, False, True)
    End With
    '//入库单不允许增加和删除
    cmdAdd.Enabled = IIf(m_byType = IN_INVOICE Or m_byType = BACK_INVOICE, False, bVal) And m_bEdit
    cmdEdit.Enabled = bVal And Not bAuditer And m_bEdit
    cmdUpdate.Visible = Not bVal
    cmdDelete.Enabled = IIf(m_byType = IN_INVOICE Or m_byType = BACK_INVOICE, False, bVal And Not bAuditer) And m_bEdit
    cmdPrint.Enabled = bVal And Not bEmpty And bAuditer
    cmdClose.Enabled = bVal
    
    cmdFirst.Enabled = bVal
    cmdLast.Enabled = bVal
    cmdPrevious.Enabled = bVal
    cmdNext.Enabled = bVal
    
    cmdAuditer.Enabled = bVal And Not bKeeper And m_bAuditer
    cmdKeeper.Enabled = bVal And bAuditer And Not bKeeper And m_bKeeper
    
    cmdAuditer.Caption = IIf(Not bKeeper And bAuditer And m_bAuditer, "弃审", "审核")
End Sub

'////////////////////////////////////////////////////
'//
Private Sub grdDataGrid_AfterColUpdate(ByVal ColIndex As Integer)
    With grdDataGrid
        Select Case ColIndex
        Case CodeCol
            If m_sWaresCode <> "" Then
                .Columns(YearCol).Text = adoPrimaryRs![FYear]
                .Columns(MonthCol).Text = adoPrimaryRs![FMonth]
                .Columns(TypeCol).Text = adoPrimaryRs![FType]
                .Columns(NoCol).Text = adoPrimaryRs![FNo]
                .Columns(IndexCol).Text = GetNewIndex("Select Max(FIndex) From InDetail Where FYear = " & adoPrimaryRs![FYear] & " And FMonth = " & adoPrimaryRs![FMonth] & " And FType = " & adoPrimaryRs![FType] & " And FNo = '" & adoPrimaryRs![FNo] & "'", 0)
                .Text = m_sWaresCode
                adoSecondaryRs.Update
                .Col = MeasCol
            End If
        Case QuantityCol, PriceCol, ShortQuantityCol, WearQuantityCol
            If m_byType = IN_INVOICE Or m_byType = BACK_INVOICE Then
                .Columns(MoneyCol).Text = Val(.Columns(QuantityCol).Text) * Val(.Columns(PriceCol).Text)
            End If
            If m_byType = IN_INVOICE Or m_byType = BACK_INVOICE Then
                .Columns(ShortMoneyCol).Text = Val(.Columns(ShortQuantityCol).Text) * Val(.Columns(PriceCol).Text)
                .Columns(WearMoneyCol).Text = Val(.Columns(WearQuantityCol).Text) * Val(.Columns(PriceCol).Text)
            End If
            If m_byType = WASTAGE_INVOICE Then
                
                .Columns(WearQuantityCol).Text = Val(.Columns(ShortMoneyCol).Text) - Val(.Columns(ShortQuantityCol).Text)
                .Columns(WearMoneyCol).Text = (Val(.Columns(ShortMoneyCol).Text) - Val(.Columns(ShortQuantityCol).Text)) * Val(.Columns(PriceCol).Text)
                adoSecondaryRs.Update
            End If
        Case MoneyCol
            If Val(.Columns(PriceCol).Text) = 0 Then
                .Columns(QuantityCol).Text = 0
            Else
                .Columns(QuantityCol).Text = Val(.Columns(MoneyCol).Text) / Val(.Columns(PriceCol).Text)
            End If
        Case ShortMoneyCol
            If m_byType = WASTAGE_INVOICE Then
                .Columns(WearQuantityCol).Text = Val(.Columns(ShortMoneyCol).Text) - Val(.Columns(ShortQuantityCol).Text)
                .Columns(WearMoneyCol).Text = (Val(.Columns(ShortMoneyCol).Text) - Val(.Columns(ShortQuantityCol).Text)) * Val(.Columns(PriceCol).Text)
                adoSecondaryRs.Update
            
            Else
             
                If Val(.Columns(PriceCol).Text) = 0 Then
                    .Columns(ShortQuantityCol).Text = 0
                Else
                    .Columns(ShortQuantityCol).Text = Val(.Columns(ShortMoneyCol).Text) / Val(.Columns(PriceCol).Text)
                End If
            End If
        Case WearMoneyCol
            If Val(.Columns(PriceCol).Text) = 0 Then
                .Columns(WearQuantityCol).Text = 0
            Else
                .Columns(WearQuantityCol).Text = Val(.Columns(WearMoneyCol).Text) / Val(.Columns(PriceCol).Text)
            End If
        End Select
    End With
End Sub

Private Sub grdDataGrid_ButtonClick(ByVal ColIndex As Integer)
    If Not grdDataGrid.AllowUpdate Or ColIndex <> CodeCol Or m_bIsSelectWares Then
        Exit Sub
    End If
    Dim sOldCode As String
    
    m_sWaresCode = GetSelectWaresCode("Left(FWaresCode, " & m_gSeriesLen(0) & ") <> '" & CHARGE_CODE & "'", m_bIsSelectWares)
    If m_sWaresCode = "" Then Exit Sub
    
    sOldCode = IIf(IsNull(adoSecondaryRs![FWaresCode]), "", adoSecondaryRs![FWaresCode])
    If m_sWaresCode <> sOldCode Then
        If FieldIsRepeat(adoSecondaryRs.Clone, "FWaresCode = '" & m_sWaresCode & "'") Then
            MsgBox "本单据该商品重复录入!", vbOKOnly + vbExclamation, "提示："
            m_sWaresCode = ""
            Me.SetFocus
        Else
            grdDataGrid_AfterColUpdate (CodeCol)
            SendKeys "{Tab}"
        End If
    End If
End Sub

Private Sub grdDataGrid_BeforeColUpdate(ByVal ColIndex As Integer, OldValue As Variant, Cancel As Integer)
    With grdDataGrid
        Select Case ColIndex
        Case CodeCol
            If .Text <> OldValue Then     '代码改变, 检查代码合法性
                If m_bIsSelectWares Then
                    Cancel = True
                    m_sWaresCode = ""
                    Exit Sub
                End If
                
                m_sWaresCode = .Text
                If RsIsEmpty("Select * From WaresList Where FWaresCode = '" & m_sWaresCode & "' And Not FMaster") Then
                    m_sWaresCode = GetSelectWaresCode("Left(FWaresCode, " & m_gSeriesLen(0) & ") <> '" & CHARGE_CODE & "'", m_bIsSelectWares)
                    If m_sWaresCode = "" Then
                        Cancel = True
                        Me.SetFocus
                        Exit Sub
                    End If
                End If
                
                If m_sWaresCode <> OldValue Then
                    If FieldIsRepeat(adoSecondaryRs.Clone, "FWaresCode = '" & m_sWaresCode & "'") Then
                        MsgBox "本单据该商品重复录入!", vbOKOnly + vbExclamation, "提示："
                        m_sWaresCode = ""
                        Cancel = True
                        Me.SetFocus
                        Exit Sub
                    End If
                End If
            End If
            
        Case PriceCol
            If Not IsNumeric(.Text) Then
                Cancel = True
            ElseIf Val(.Text) < 0 Then   '单价不能为负数
                Cancel = True
            End If
            
        Case QuantityCol, MoneyCol
            If Not IsNumeric(.Text) Then
                Cancel = True
            ElseIf m_byType = IN_INVOICE And Val(.Text) < 0 Then
                Cancel = True
            ElseIf m_byType = BACK_INVOICE And Val(.Text) > 0 Then
                Cancel = True
            End If
            
        Case ShortQuantityCol, ShortMoneyCol, WearQuantityCol, WearMoneyCol
            If Not IsNumeric(.Text) Then
                Cancel = True
            End If
            
        End Select
    End With
End Sub

Private Sub grdDataGrid_BeforeDelete(Cancel As Integer)
    Dim nRet As Integer
    nRet = MsgBox("您真的要删除当前商品吗？", vbQuestion + vbYesNo + vbDefaultButton2, "提示：")
    If nRet = vbNo Then Cancel = True
End Sub

Private Sub grdDataGrid_BeforeUpdate(Cancel As Integer)
    If adoSecondaryRs.EditMode = adEditDelete Then Exit Sub
    With grdDataGrid
        If .Columns(CodeCol).Text = "" Then
            .DataChanged = False
            Cancel = True
        End If
    End With
End Sub

Private Sub grdDataGrid_Error(ByVal DataError As Integer, Response As Integer)
    Response = 0
End Sub

Private Sub grdDataGrid_GotFocus()
    If grdDataGrid.AllowUpdate Then
        UpdateInvoice
    ElseIf cmdEdit.Enabled Then
        cmdEdit.SetFocus
    ElseIf cmdAdd.Enabled Then
        cmdAdd.SetFocus
    ElseIf cmdPrint.Enabled Then
        cmdPrint.SetFocus
    ElseIf cmdClose.Enabled Then
        cmdClose.SetFocus
    Else
        Me.SetFocus
    End If
End Sub

Private Sub grdDataGrid_LostFocus()
    If m_bIsSelectWares Then Exit Sub
    On Error GoTo Error_Handler

    If Not grdDataGrid.AddNewMode = dbgAddNewCurrent Then
        adoSecondaryRs.Update
    End If
    If Not grdDataGrid.AddNewMode = dbgNoAddNew Then
        adoSecondaryRs.MoveLast
    End If

Error_Handler:
End Sub

Private Sub grdDataGrid_RowResize(Cancel As Integer)
    If grdDataGrid.RowHeight < 200 Then
        grdDataGrid.RowHeight = 200
    ElseIf grdDataGrid.RowHeight > grdDataGrid.Height / 2 Then
        grdDataGrid.RowHeight = grdDataGrid.Height / 2
    End If
    SavePrivateSetting Me.Caption, "GrdHeight", grdDataGrid.RowHeight
End Sub

Private Sub grdDataGrid_ColResize(ByVal ColIndex As Integer, Cancel As Integer)
    If grdDataGrid.VisibleCols = 0 Then
        Cancel = True
    Else
        SaveGridColWidth Me.Caption, grdDataGrid
    End If
End Sub

'//////////////////////////////////////////////////
'//
Private Sub DACHouse_Validate(Cancel As Boolean)
    If Not DACHouse.MatchedWithList Then
        MsgBox "请重新选择库房!", vbOKOnly + vbExclamation, "提示："
        Cancel = True
        DACHouse.SetFocus
    End If
End Sub

Private Sub MaskDate_Validate(Cancel As Boolean)
    If Not IsDate(maskDate.Text) Then
        MsgBox "日期输入有误!", vbOKOnly + vbExclamation, "提示："
        Cancel = True
        maskDate.SetFocus
    End If
End Sub

'////////////////////////////////////////////////
'//
Private Sub txtFindNo_LostFocus()
    txtFindNo.Text = ""
End Sub

Private Sub txtFindNo_KeyPress(KeyAscii As Integer)
    If KeyAscii <> 13 Then
        Exit Sub
    ElseIf Trim(txtFindNo.Text) = "" Then
        Exit Sub
    End If
    
    FindRecord adoPrimaryRs, Trim(txtFindNo.Text)
End Sub

'////////////////////////////////////////////////
'//
Private Function CheckDataValidity() As Boolean
    Dim sPrompt As String
    sPrompt = ""
    If DACHouse.BoundText = "" Then
        sPrompt = "请选择库房!" & Chr(13)
    End If
    
    If Not IsDate(maskDate.Text) Then
        sPrompt = sPrompt & "日期输入有误!" & Chr(13)
    End If
    If Me.txtEntryNo.Text = "" Or (Not IsNumeric(txtEntryNo.Text)) Then
        sPrompt = sPrompt & "没有输入有效的凭证号!" & Chr(13)
    End If
    If Me.DacEntryType.BoundText = "" Then
        sPrompt = sPrompt & "没有输入有效的凭证类!" & Chr(13)
    End If

    If sPrompt = "" Then
        CheckDataValidity = True
    Else
        MsgBox sPrompt, vbInformation + vbOKOnly, "提示："
        DACHouse.SetFocus
        CheckDataValidity = False
    End If
End Function

'////////////////////////////////////////////////
'//
Private Sub cmdPrint_Click()
    Let frmPrint.Initial(Me.Caption, Me.GrdColumns) = Me
    frmPrint.Show vbModal
End Sub

Property Get GrdColumns() As Object
    Set GrdColumns = grdDataGrid.Columns
End Property

Property Get DataType() As String
    DataType = "Grid"
End Property

Property Get PrintCaption() As String
    PrintCaption = lblTitle(0).Caption
End Property

Public Sub PrintMe(ByRef PrintObj As Object, Optional sRangeInfo As String)
    If sRangeInfo = "" Then
        PrintTable grdDataGrid, adoSecondaryRs, Me, True, PrintObj, False
    Else
        Dim nFromPage As Integer, nEndPage As Integer
        Do While Len(sRangeInfo) > 0
            GetFromToEndPageNo sRangeInfo, nFromPage, nEndPage  '三个参数均传址调用
            PrintTable grdDataGrid, adoSecondaryRs, Me, False, PrintObj, False, nFromPage, nEndPage
        Loop
    End If
End Sub

Public Sub PrintHeader(PrintObj As Object, LMargin As Integer, T_PWidth As Integer)
    Dim sTemp As String
    
    PrintObj.Print
    sTemp = lblHouse.Caption & ": " & DACHouse.Text
    PrintObj.CurrentX = LMargin
    PrintObj.Print sTemp;
    sTemp = lblDate.Caption & ": " & maskDate.Text
    PrintObj.CurrentX = LMargin + T_PWidth / 4#
    PrintObj.Print sTemp;
    sTemp = lblNo.Caption & ": " & txtNo.Text
    PrintObj.CurrentX = LMargin + T_PWidth / 2#
    PrintObj.Print sTemp
     sTemp = "凭证编号 " & Me.DacEntryType.Text & " " & txtEntryNo.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 3 / 4#
    PrintObj.Print sTemp;

End Sub

Public Sub PrintTail(PrintObj As Object, LMargin As Integer, T_PWidth As Integer, T_PHeight As Integer, Row_Height As Integer, nCurPage As Integer, nTotalPage As Integer)
    Dim sTailText As String
    
    PrintObj.CurrentY = T_PHeight - Row_Height * RowTailCount()
    sTailText = lblStoreMan.Caption & ": " & txtStoreMan.Text
    PrintObj.CurrentX = LMargin + 5
    PrintObj.Print sTailText;
    sTailText = lblVerified.Caption & ": " & txtVerified.Text
    PrintObj.CurrentX = LMargin + T_PWidth / 5#
    PrintObj.Print sTailText;
    sTailText = "记帐: " & txtKeeper.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 2 / 5#
    PrintObj.Print sTailText;
    sTailText = "审核: " & txtAuditer.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 3 / 5#
    PrintObj.Print sTailText;
    sTailText = lblMaker.Caption & ": " & txtMaker.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 4 / 5#
    PrintObj.Print sTailText
    PrintObj.Print
    
    sTailText = "<高特软件>"
    PrintObj.CurrentX = LMargin + 5
    PrintObj.Print sTailText;
    sTailText = Format(m_gLoginDate, "打印日期：YYYY年MM月DD日") & "  第" & nCurPage & "/" & nTotalPage & "页"
    PrintObj.CurrentX = LMargin + T_PWidth - PrintObj.TextWidth(sTailText) - 5
    PrintObj.Print sTailText
End Sub

Property Get RowTailCount() As Integer
    RowTailCount = 3
End Property