frmout.frm

针对农资系统的商品进销存管理系统软件

            ![FAuditer] = ""
        End If
        .Update
    End With
    SetButtons (True)
End Sub

Private Sub cmdKeeper_Click()   '记帐
Dim bSuccess As Boolean
    With adoPrimaryRs
        If Not (IsNull(![FKeeper]) Or ![FKeeper] = "") Then  '已记帐
            Exit Sub
        End If
        '记帐过程
        m_gDBCnn.BeginTrans
        
        bSuccess = Keep_Business_Records(!FYear, !FMonth, !FType, !FNo)
        If Not bSuccess Then GoTo Keep_Record_Err
        m_gDBCnn.CommitTrans
        ![FKeeper] = m_gsOperator
        .Update
    End With
    SetButtons (True)
    Exit Sub
Keep_Record_Err:
    m_gDBCnn.RollbackTrans
    MsgBox "记帐出错!,请与供应商联系。"
End Sub

Private Sub cmdClose_Click()
    Unload Me
End Sub

'////////////////////////////////////////////////
'//
Private Sub cmdFirst_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = 1 Then Exit Sub  '已是首记录
        .MoveFirst
    End With
    SetButtons (True)
End Sub

Private Sub cmdLast_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = .RecordCount Then Exit Sub    '已是尾记录
        .MoveLast
    End With
    SetButtons (True)
End Sub

Private Sub cmdNext_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = .RecordCount Then Exit Sub    '已是尾记录
        .MoveNext
    End With
    SetButtons (True)
End Sub

Private Sub cmdPrevious_Click()
    With adoPrimaryRs
        If .EOF And .BOF Then Exit Sub
        If .AbsolutePosition = 1 Then Exit Sub   '已是首记录
        .MovePrevious
    End With
    SetButtons (True)
End Sub

'///////////////////////////////////////////////////
'//
Private Sub SetButtons(bVal As Boolean)
    Dim bAuditer As Boolean, bKeeper As Boolean, bEmpty As Boolean
    With adoPrimaryRs
        If .EOF Or .BOF Then
            bAuditer = True
            bKeeper = True
            bEmpty = True
        Else
            bAuditer = IIf(IsNull(![FAuditer]) Or ![FAuditer] = "", False, True) '未审核/审核
            bKeeper = IIf(IsNull(![FKeeper]) Or ![FKeeper] = "", False, True)    '未记帐/记帐
            bEmpty = False
        End If
    End With
    
    dacHouse.Enabled = IIf(m_byType = OUT_OTHER, Not bVal, False)
    maskDate.Enabled = IIf(m_byType = OUT_OTHER, Not bVal, False)
    txtNo.Enabled = False
    txtStoreMan.Enabled = Not bVal
  
    txtKeeper.Enabled = False
    txtAuditer.Enabled = False
    txtMaker.Enabled = False
    txtFindNo.Enabled = bVal And Not bEmpty
    
    With grdDataGrid
        .AllowUpdate = IIf(m_byType <> OUT_SELL, Not bVal, False)
        .AllowAddNew = IIf(m_byType = OUT_OTHER, True, False)
        .AllowDelete = IIf(m_byType = OUT_OTHER, True, False)
    End With
    '//出库单不允许增加和删除
    cmdAdd.Enabled = IIf(m_byType = OUT_OTHER, bVal, False) And m_bEdit
    cmdEdit.Enabled = bVal And Not bAuditer And m_bEdit
    cmdUpdate.Visible = Not bVal
    cmdDelete.Enabled = IIf(m_byType = OUT_OTHER, bVal And Not bAuditer, False) 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
        If ColIndex = CodeCol Then
            If m_sWaresCode <> "" Then
                .Columns(YearCol).Text = adoPrimaryRs![FYear]
                .Columns(MonthCol).Text = adoPrimaryRs![FMonth]
                .Columns(TypeCol).Text = adoPrimaryRs![FType]
                .Columns(NoCol).Text = adoPrimaryRs![FNo]
                .Text = m_sWaresCode
                adoSecondaryRs.Update
                .Col = MeasCol
            End If
        
        ElseIf ColIndex = QuantityCol Or ColIndex = PriceCol Then
            .Columns(MoneyCol).Text = Format(Val(.Columns(QuantityCol).Text) * Val(.Columns(PriceCol).Text), MoneyFormat())
            
        ElseIf ColIndex = MoneyCol Then
            If Val(.Columns(QuantityCol).Text) = 0 Then
                .Columns(PriceCol).Text = 0
            Else
                .Columns(PriceCol).Text = Format(Val(.Columns(MoneyCol).Text) / Val(.Columns(QuantityCol).Text), PriceFormat())
            End If
        End If
    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 QuantityCol, PriceCol, MoneyCol
            If Not IsNumeric(.Text) Then
                Cancel = True
            ElseIf ColIndex = PriceCol Then
                If Val(.Text) < 0 Then   '单价不能为负数
                    Cancel = True
                End If
            ElseIf ColIndex = MoneyCol Then
                If Val(.Text) < 0 And Val(.Columns(QuantityCol).Text) > 0 Or Val(.Text) > 0 And Val(.Columns(QuantityCol).Text) < 0 Then
                    Cancel = True
                End If
            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 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 & ": " & Me.dacHouse.Text
    PrintObj.CurrentX = LMargin
    PrintObj.Print sTemp;
    sTemp = lblDate.Caption & ": " & Me.maskDate.Text
    PrintObj.CurrentX = LMargin + T_PWidth / 3#
    PrintObj.Print sTemp;
    sTemp = lblNo.Caption & ": " & Me.txtNo.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 2 / 3#
    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 * Me.RowTailCount()
    sTailText = Me.lblStoreMan.Caption & ": " & Me.txtStoreMan.Text
    PrintObj.CurrentX = LMargin + 5
    PrintObj.Print sTailText;
    sTailText = "记帐: " & Me.txtKeeper.Text
    PrintObj.CurrentX = LMargin + T_PWidth / 4#
    PrintObj.Print sTailText;
    sTailText = "审核: " & Me.txtAuditer.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 2 / 4#
    PrintObj.Print sTailText;
    sTailText = Me.lblMaker.Caption & ": " & Me.txtMaker.Text
    PrintObj.CurrentX = LMargin + T_PWidth * 3 / 4#
    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