frmmutiaccount.frm

金算盘软件代码

                        If .RowHeight(lngRow1) > 100 And GetValue(lngRow1, mlngColAccount, "String") = strAcc And lngRow1 <> lngRow Then
                            DataIsVoid = False
                            Msg = "折旧费用科目不能重复！"
                            Exit For
                        End If
                    Next lngRow1
                End If
            End If
            If Msg = "" Then
                If blnCheckAfterSave And strAcc <> "" Then
                    strSql = "SELECT lngAccountID,blnIsDetail FROM Account WHERE lngAccountID=" & C2lng(.TextMatrix(lngCnt, mlngColAccountID))
                    Set recAccount = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If Not recAccount.EOF Then
                        If recAccount!blnIsDetail = 0 Then
                            Msg = "折旧费用科目必须是明细科目！"
                        End If
                    Else
                        Msg = "折旧费用科目不存在或已作废或已被删除！"
                    End If
                    recAccount.Close
                End If
            End If
            If Msg <> "" Then Exit For
        Next lngRow
        Set recAccount = Nothing
    End With
    
    If DataIsVoid Then
        If lngCnt = 0 Then
            DataIsVoid = False
            Msg = "科目不能为空！"
        End If
    End If
    
    If DataIsVoid Then
        If dblTotalRate <> 100 Then
            DataIsVoid = False
            Msg = "各科目分摊比例之和必须为100%！"
        End If
    End If
End Function

'按钮数组的Click事件处理
Private Sub cmdOK_Click(Index As Integer)
    Dim strMsg As String
    Select Case Index
        Case 0 '确定
            mclsList.Save
            If Not mblnLocked Then
                If DataIsVoid(strMsg) Then
                    Save -1
                    Hide
                Else
                    ShowMsg hwnd, strMsg, vbInformation, Caption
                End If
            Else
                Hide
            End If
        Case 1 '取消
            mclsList.CancelSave
            Hide
            RefreshGrid
    End Select
End Sub

Private Sub Form_Activate()
    On Error Resume Next
    SetHelpID HelpContextID
    frmMain.SetEditUnEnabled
    msgMutiAcc.SetFocus
End Sub

Private Sub Form_Load()
    mlngAlterID = -1
    mblnLocked = True
    mblnChanged = False
    RefreshLtxtAcc
    
    Set mclsList = New Grid
    Set mclsList.Grid = msgMutiAcc
    mclsList.SetupStyle
    
    Me.HelpContextID = 60133
    Utility.LoadFormResPicture Me
End Sub


Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If UnloadMode = 0 Then
        Cancel = True
        cmdOK_Click 1
    End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Dim strSql As String
    On Error Resume Next
    strSql = "DELETE FROM FixedAccount WHERE lngFixedAlterID=-1"
    gclsBase.ExecSQL strSql
    Utility.UnLoadFormResPicture Me
    If Not ltxtAcc.Recordset Is Nothing Then
        Set ltxtAcc.Recordset = Nothing
    End If
End Sub

'刷新科目参照
Private Sub RefreshLtxtAcc(Optional lngID As Long)
    Dim strSql As String
    Dim lngRow As Long
    Dim i As Byte
    
    On Error Resume Next
    
    strSql = "SELECT lngAccountID,strAccountCode,strAccountName " _
        & "FROM Account WHERE blnIsInActive = 0 ORDER BY strAccountCode"
    With ltxtAcc
        .ClearRefer
        Set .Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        .AddRefer "<新增>"
        .AddRefer "<修改>"
        .AddRefer "<删除>"
        .CodeSort = True
    End With
    If lngID > 0 Then
        ltxtAcc.SeekId lngID
        If ltxtAcc.ID <> lngID Then
            lngRow = 1
            Do While lngRow <= msgMutiAcc.Rows - 1
                If C2lng(msgMutiAcc.TextMatrix(lngRow, mlngColAccountID)) = lngID Then
                    If mlngAlterID = 0 Then
                        strSql = "DELETE FROM FixedAccount WHERE lngFixedAlterID=-1 AND lngAccountID=" & lngID
                    Else
                        strSql = "DELETE FROM FixedAccount WHERE lngFixedAlterID=" & mlngAlterID & " AND lngAccountID=" & lngID
                    End If
                    gclsBase.ExecSQL strSql
                    With msgMutiAcc
                        If .Rows = 2 Then
                            For i = 0 To .Cols - 1
                                .TextMatrix(lngRow, i) = ""
                            Next i
                        Else
                            .RemoveItem lngRow
                            lngRow = lngRow - 1
                        End If
                    End With
                End If
                lngRow = lngRow + 1
            Loop
        End If
    End If
End Sub


Private Sub ltxtAcc_AddNew()
    Dim lngID As Long
    
    lngID = Card.AddCard(1) '调用卡片
    RefreshLtxtAcc lngID
    ltxtAcc.Visible = True
End Sub

'科目参照
Private Sub ltxtAcc_Choose()
    Dim strSql As String
    Dim lngAttribute As Long
    Dim lngNature As Long
    
    With ltxtAcc
        mlngAccID = C2lng(.TextMatrix(.ReferRow, 1))
        lngAttribute = AccountAttribute(mlngAccID, , lngNature)
        If lngAttribute > 0 Then
            If lngNature <> 0 Then
                If Visible Then ShowMsg hwnd, "不能选择现金银行、应收应付、存货科目!", vbInformation, Me.Caption
                ltxtAcc.Text = ""
                mlngAccID = 0
            ElseIf (lngAttribute And aaDetail) <> aaDetail Then
                If Visible Then ShowMsg hwnd, "科目必须是明细科目!", vbInformation, Me.Caption
                ltxtAcc.Text = ""
                mlngAccID = 0
            ElseIf (lngAttribute And aaCustomer) = aaCustomer _
                Or (lngAttribute And aaClass1) = aaClass1 Or (lngAttribute And aaClass2) = aaClass2 _
                Or (lngAttribute And aaEmployee) = aaEmployee Then
                If Visible Then ShowMsg hwnd, "不能选择有辅助核算科目(但可进行部门核算),请重新选择", vbExclamation, Me.Caption
'                If Visible Then ShowMsg hwnd, "不能选择有辅助核算的科目,请重新选择", vbExclamation, Me.Caption
                ltxtAcc.Text = ""
                mlngAccID = 0
            End If
        Else
            If Visible Then ShowMsg hwnd, "科目不存在!", vbInformation, Me.Caption
            msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColAccount) = ""
            ltxtAcc.Text = ""
            mlngAccID = 0
        End If
    End With
End Sub

Private Sub ltxtAcc_Delete()
    If mlngAccID = 0 Then
        If Visible Then ShowMsg hwnd, "没有可供删除的项目", vbExclamation, Me.Caption
    Else
        Card.DelCard 1, mlngAccID, Me.hwnd
        RefreshLtxtAcc
    End If
End Sub

Private Sub ltxtAcc_Edit()
    If mlngAccID = 0 Then
        If Visible Then ShowMsg hwnd, "没有可供修改的项目", vbExclamation, Me.Caption
    Else
        Card.EditCard 1, mlngAccID
        RefreshLtxtAcc mlngAccID
        If ltxtAcc.ID = 0 Then
            msgMutiAcc.Text = ""
        End If
        mclsList.BeginEdit
    End If
End Sub

Private Sub ltxtAccItemNotExist()
    Dim lngID As Long
    
    If ltxtAcc.Visible And frmMsgAdd.MsgAddShow(Me.Caption, "科目“" & ltxtAcc.Text & "”不存在或不可用，是否新增?") = vbOK Then
        lngID = Card.AddCard(1) '调用卡片
        RefreshLtxtAcc
        ltxtAcc.SeekId lngID
    Else
        ltxtAcc.Text = ""
    End If
End Sub

Private Sub RefreshGrid()
    msgMutiAcc.FixedCols = 0
    Set datAcc.Resultset = GetAccount()
    If Not mblnCopyMode Then
        mclsList.SetupStyle
        With msgMutiAcc
            .Rows = .Rows + 1
            .ColWidth(1) = 0
            .ColWidth(2) = 0.6 * .width
            .ColWidth(3) = 0.3 * .width
            .ColAlignment(3) = flexAlignRightCenter
             mclsList.SetEditText "科目", , , , ltxtAcc
             mclsList.SetEditText "分摊比例(%)", , , , txtEdit
            .Row = 1
            .col = mlngColAccount
        End With
    End If
    datAcc.Resultset.Close
    Set datAcc.Resultset = Nothing
End Sub

Private Sub mclsList_BeforeSave(blnCancel As Boolean)
    If msgMutiAcc.Row = msgMutiAcc.Rows - 1 Then
        If msgMutiAcc.col = mlngColRate Then
            If msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColAccount) <> "" Then
                msgMutiAcc.Rows = msgMutiAcc.Rows + 1
            End If
        ElseIf msgMutiAcc.col = mlngColAccount Then
            If C2Dbl(msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColRate)) > 0 Then
                msgMutiAcc.Rows = msgMutiAcc.Rows + 1
            End If
        End If
    End If
    If ltxtAcc.Visible Then
        msgMutiAcc.TextMatrix(msgMutiAcc.Row, 1) = ltxtAcc.ID
    End If
    mblnChanged = True
End Sub

Private Sub mclsList_DataValid(blnCancel As Boolean)
    Dim lngRow As Long
    
    If ltxtAcc.Visible Then
        ltxtAcc.Text = ltxtAcc.Text
        If ltxtAcc.ID <= 0 Then
            blnCancel = True
            If Trim$(ltxtAcc.Text) <> "" Then
                ltxtAccItemNotExist
            End If
'            If Visible Then ShowMsg hwnd, "科目不存在！", vbExclamation, Me.Caption
        End If
    ElseIf txtEdit.Visible Then
        If txtEdit.Value < 0 Or txtEdit.Value > 100 Then
            blnCancel = True
            If Visible Then ShowMsg hwnd, "科目分摊比例必须大于0，小于100！", vbExclamation, Me.Caption
        End If
    Else
        For lngRow = 1 To msgMutiAcc.Rows - 1
            If lngRow <> msgMutiAcc.Row And GetValue(lngRow, mlngColAccount, "String") = Trim(ltxtAcc.Text) Then
                blnCancel = True
                If Visible Then ShowMsg hwnd, "科目重复,请重新输入！", vbExclamation, Me.Caption
                Exit For
            End If
        Next lngRow
    End If
End Sub

Private Function GetValue(lngRow As Long, intCol As Integer, Optional strType As String = "Double") As Variant
    GetValue = GetGridValue(lngRow, intCol, strType, msgMutiAcc)
End Function

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And (Not mblnLocked) Then
        If msgMutiAcc.Row >= 1 And Trim(msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColAccount)) <> "" Then
            mnuDelete.Enabled = True
        Else
            mnuDelete.Enabled = False
        End If
        PopupMenu MenuPopup, , x, y
    End If
End Sub

Private Sub msgMutiAcc_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton And (Not mblnLocked) Then
        If msgMutiAcc.Row >= 1 And Trim(msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColAccount)) <> "" Then
            mnuDelete.Enabled = True
        Else
            mnuDelete.Enabled = False
        End If
        PopupMenu MenuPopup, , x, y
    End If
End Sub

Private Sub mnuNew_Click()
    mblnChanged = True
    With msgMutiAcc
        If .TextMatrix(.Rows - 1, mlngColAccount) <> "" And C2Dbl(.TextMatrix(.Rows - 1, mlngColRate)) > 0 Or .RowHeight(.Rows - 1) < 100 Then
            .AddItem .Row
        Else
            .Row = .Rows - 1
        End If
        .col = mlngColAccount
        mclsList.BeginEdit
    End With
End Sub

Private Sub mnuDelete_Click()
    If msgMutiAcc.Rows > msgMutiAcc.FixedRows Then
        mblnChanged = True
        msgMutiAcc.TextMatrix(msgMutiAcc.Row, mlngColRate) = 0
        msgMutiAcc.RowHeight(msgMutiAcc.Row) = 0
        If msgMutiAcc.Row > msgMutiAcc.FixedRows Then
            msgMutiAcc.Row = msgMutiAcc.Row - 1
        End If
    End If
End Sub