frmvouchercashflow.frm

金算盘软件代码

                            GrdCol.Rows = 2
                            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
                        End If
                        If GrdCol.Row <= 0 Then GrdCol.Row = 1
                        If GrdCol.col <> 2 And GrdCol.col <> 3 Then GrdCol.col = 2
                        EnterCell
                    ElseIf wParam = 38 Then
                        If Me.ActiveControl.Index = 0 Then cmdOk(0).SetFocus
                    ElseIf wParam = 40 Then
                        If Me.ActiveControl.Index = cmdOk.Count - 1 Then cmdOk(cmdOk.Count - 1).SetFocus
                    End If
                Else
                '    cmdOK(0).SetFocus
                End If
                blnBusy = False
        End If
        If wParam = 9 Or wParam = 13 Then        'TAB键处理程序
            If Not blnBusy Then
                blnBusy = True
                If (GetKeyState(16) = -127 Or GetKeyState(16) = -128) Then
                    If Me.ActiveControl.Name = "lstInput" Then
                        lstInput_LostFocus
                        If GrdCol.Row > 1 Then
                            GrdCol.Row = GrdCol.Row - 1
                            GrdCol.col = 3
                            EnterCell
                        Else
                        '    blnNotEntercell = True
                            GrdCol.col = 2
                            If GrdCol.Rows > 1 Then GrdCol.Row = 1
                            DoEvents
                            cmdOk(0).SetFocus
                         '   blnNotEntercell = False
                        End If
                    ElseIf Me.ActiveControl.Name = "txtInput" Then
                        txtInput_LostFocus
                        GrdCol.col = 2
                        EnterCell
                    ElseIf Me.ActiveControl.Name = "cmdOK" Then
                        If wParam = 9 Then
                            If Me.ActiveControl.Index = 0 Then
                                GrdCol.col = 2
                                If GrdCol.Rows = 1 Then
                                    GrdCol.Rows = 2
                                    GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
                                    GrdCol.Row = 1
                                End If
                                EnterCell
                            Else
                                cmdOk(Me.ActiveControl.Index - 1).SetFocus
                            End If
                        End If
                    End If
                Else
                    If Me.ActiveControl.Name = "lstInput" Then
                        lstInput_LostFocus
                        If GrdCol.TextMatrix(GrdCol.Row, 2) = "" Then
                            cmdOk(0).SetFocus
                        Else
                            GrdCol.col = 3
                            EnterCell
                        End If
                    ElseIf Me.ActiveControl.Name = "txtInput" Then
                        If GrdCol.Rows - 1 > GrdCol.Row Then
                            txtInput_LostFocus
                            GrdCol.Row = GrdCol.Row + 1
                            GrdCol.col = 2
                            EnterCell
                        ElseIf C2lng(GrdCol.TextMatrix(GrdCol.Row, 4)) <> 0 Then
                            txtInput_LostFocus
                            GrdCol.Rows = GrdCol.Rows + 1
                            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
                            GrdCol.Row = GrdCol.Rows - 1
                                If GrdCol.Rows > 17 Then
                                    GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - (20) * Screen.TwipsPerPixelX
                                Else
                                    GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - 5 * Screen.TwipsPerPixelX
                                End If
                            GrdCol.col = 2
                            EnterCell
                        Else
                            txtInput_LostFocus
                            GrdCol.col = 2
                            If GrdCol.Rows > 1 Then GrdCol.Row = 1
                            DoEvents
                            cmdOk(0).SetFocus
                        End If
                    ElseIf Me.ActiveControl.Name = "cmdOK" Then
                        If wParam = 9 Then
                            If Me.ActiveControl.Index = cmdOk.Count - 1 Then
                                GrdCol.col = 2
                                If GrdCol.Rows = 1 Then
                                    GrdCol.Rows = 2
                                    GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
                                    GrdCol.Row = 1
                                End If
                                EnterCell
                            Else
                                cmdOk(Me.ActiveControl.Index + 1).SetFocus
                            End If
                        End If
                    Else
                        cmdOk(0).SetFocus
                    End If
                End If
                blnBusy = False
            End If
        End If
    End If

End Sub

Private Sub lstInput_AddNew()
    Dim lngID As Long, lngItemID As Long
        lngID = frmAddCashItem.AddCard(lstInput.Text, vbModal)
        InitPasteLst lngID
    mblnIsChanged = True
End Sub

Private Sub lstInput_Delete()
        Dim lngID As Long
        lngID = lstInput.ID
        If lstInput.ID = 0 Then
            ShowMsg Me.hwnd, "请选择一参照！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示信息"
            Exit Sub
        End If
        If frmAddCashItem.DelCard(lstInput.ID, Me.hwnd) = False Then
            mlngOldLst = lngID
        End If
        InitPasteLst mlngOldLst
        mblnIsChanged = True
End Sub

Private Sub lstInput_Edit()
    If lstInput.ID = 0 Then
        ShowMsg Me.hwnd, "请选择一参照！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示信息"
        Exit Sub
    End If
    Dim lngID As Long
    lngID = lstInput.ID
    frmAddCashItem.EditCard lstInput.ID, vbModal
    
    InitPasteLst lngID
    
    If lstInput.Text = "" Then mlngOldLst = 0
End Sub

Private Sub lstInput_ItemNotExist()
    Dim lngID As Long, lngItemID As Long
    If Not lstInput.Enabled Then Exit Sub
        GrdCol.TextMatrix(GrdCol.Row, 4) = mlngOldLst
        InitPasteLst lngID
    mblnIsChanged = True
End Sub

Private Function PartsIsSelected(strPartsName As String) As Boolean
    Dim i As Integer
    
    PartsIsSelected = False
    For i = 1 To GrdCol.Rows - 1
        If GrdCol.TextMatrix(i, 2) = strPartsName Then
            PartsIsSelected = True
            Exit For
        End If
    Next i
End Function
Private Sub InitGrid(ByVal lngID As Long)
    Dim strSql As String, recItem As rdoResultset, i As Integer, bytDec As Byte
    If lblNote(3).Caption = "流入" Then
        i = 1
    ElseIf lblNote(3).Caption = "流出" Then
        i = 2
    Else
        i = 1
    End If
    GrdCol.Rows = 1
    GrdCol.TextMatrix(0, 1) = "流向"
        strSql = "SELECT VoucherCashFlow.lngCashItemID,Decode(CashItem.lngCashFlowType,1,'流入',2,'流出',3,'净值') 流向," _
            & "CashItem.strCashItemCode ||  ' ' || CashItem.strCashItemName 现金流量表项目," _
            & "DECODE(CashItem.lngCashFlowType," & i & ",1,-1)" & "*VoucherCashFlow.dblAmount 分配金额,VoucherCashFlow.lngCashItemID " _
            & " FROM VoucherCashFlow,CashItem" _
            & " WHERE VoucherCashFlow.lngCashItemID =CashItem.lngCashItemID AND VoucherCashFlow.lngVoucherDetailID=" & lngVoucherDetailID
        Set recItem = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recItem.EOF Then
            GrdCol.Cols = 0
            Set DATA1.Resultset = recItem
            DATA1.Resultset.MoveLast
            DATA1.Resultset.MoveFirst
            DATA1.Resultset.Close
            For i = 1 To GrdCol.Rows - 1
                bytDec = gclsBase.NaturalCurDec
                GrdCol.TextMatrix(i, 3) = Format(GrdCol.TextMatrix(i, 3), FormatString(bytDec))
            Next i
        End If
    GrdCol.ColAlignment(3) = flexAlignRightCenter
    For i = 1 To GrdCol.Cols - 1
        GrdCol.FixedAlignment(i) = flexAlignCenterCenter
    Next i
    GrdCol.ColWidth(0) = 0
    GrdCol.ColWidth(1) = 500
    GrdCol.ColWidth(2) = 4500
    If GrdCol.Rows > 17 Then
        GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - (20) * Screen.TwipsPerPixelX
    Else
        GrdCol.ColWidth(3) = GrdCol.width - GrdCol.ColWidth(1) - GrdCol.ColWidth(2) - 5 * Screen.TwipsPerPixelX
    End If
'    grdCol.ColWidth(4) = 0
'    grdCol.ColWidth(5) = 0
'    grdCol.ColWidth(6) = 0
    If GrdCol.Rows <= 1 Then
        GrdCol.Rows = 2
        GrdCol.TextMatrix(1, 1) = lblNote(3).Caption
    End If
    GrdCol.Row = 1
    GrdCol.col = 2
    mlngRow = 1
    mlngCol = 2
    txtInput.ZOrder 0

    lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
    lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - TotalAmount(), FormatString(gclsBase.NaturalCurDec))
    mblnExit = True
    EnterCell
End Sub
Private Function TotalAmount() As Double
    Dim dblTmp As Double
    Dim i As Long
    dblTmp = 0
    For i = 1 To GrdCol.Rows - 1
        If GrdCol.TextMatrix(i, 1) = lblNote(3).Caption Then
            dblTmp = dblTmp + C2Dbl(GrdCol.TextMatrix(i, 3))
        Else
            dblTmp = dblTmp - C2Dbl(GrdCol.TextMatrix(i, 3))
        End If
    Next
    TotalAmount = dblTmp
End Function

Private Function LstIsValid() As Boolean
    Dim i As Integer
    
    LstIsValid = True
End Function

Private Function SaveCard() As Boolean
    Dim i As Integer
    Dim strTmp As String
    Dim strSql As String
    Dim strDetailID As String
    Dim strCodeAndName As String
    If mblnIsChanged = False Then
        SaveCard = True
        Exit Function
    End If
    SaveCard = False
    If C2Dbl(lblNote(7).Caption) <> 0 And C2Dbl(lblNote(9).Caption) <> 0 Then
'        If C2Dbl(lblNote(5).Caption) > 0 And C2Dbl(lblNote(7).Caption) < 0 Or C2Dbl(lblNote(5).Caption) < 0 And C2Dbl(lblNote(7).Caption) > 0 Then
'            ShowMsg Me.hWnd, "现金流量分配不应该超过凭证分录金额。", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, "提示信息"
'            Exit Function
'        End If
        If ShowMsg(Me.hwnd, "分配金额不等于明细金额。是否确认？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    End If
    With GrdCol
    strDetailID = "(-1"
    strCodeAndName = ""
    For i = 1 To .Rows - 1
        If C2lng(.TextMatrix(i, 0)) <> 0 And C2lng(.TextMatrix(i, 4)) <> 0 Then
            strDetailID = strDetailID & "," & .TextMatrix(i, 0)
        End If
        If C2Dbl(.TextMatrix(i, 3)) <> 0 And C2lng(.TextMatrix(i, 4)) <> 0 Then
            If strCodeAndName = "" Then
                strCodeAndName = .TextMatrix(i, 2) & " " & .TextMatrix(i, 3)
            Else
                strCodeAndName = strCodeAndName & "/" & .TextMatrix(i, 2) & " " & .TextMatrix(i, 3)
            End If
        End If
    Next i
    strDetailID = strDetailID & ")"
    strCodeAndName = SubStr(strCodeAndName & " ", 1, 255)
    
    gclsBase.BaseWorkSpace.BeginTrans
    strSql = " DELETE FROM VoucherCashFlow WHERE (NOT (lngCashItemID IN " & strDetailID & ")) AND lngVoucherDetailID=" & lngVoucherDetailID
    If gclsBase.ExecSQL(strSql) = False Then GoTo TheError
    
    strSql = " Update VoucherDetail SET strCashFlowCode='" & strCodeAndName & "' WHERE lngVoucherDetailID=" & lngVoucherDetailID
    If gclsBase.ExecSQL(strSql) = False Then GoTo TheError
    
    For i = 1 To .Rows - 1
        If C2lng(.TextMatrix(i, 4)) <> 0 And C2Dbl(.TextMatrix(i, 3)) <> 0 Then
            If C2lng(.TextMatrix(i, 0)) <> 0 Then
                strSql = " UPDATE  VoucherCashFlow SET lngCashItemID=" & C2lng(.TextMatrix(i, 4)) & ",dblAmount=" & IIf(GrdCol.TextMatrix(i, 1) = lblNote(3).Caption, 1, -1) * C2Dbl(.TextMatrix(i, 3)) & ",blnIsNotComputer=1 WHERE lngVoucherDetailID= " & lngVoucherDetailID & " AND lngCashItemID=" & C2lng(.TextMatrix(i, 0))
            Else
                strSql = " INSERT INTO VoucherCashFlow " & _
                        " ( lngVoucherDetailID,lngCashItemID,dblAmount,blnIsNotComputer) VALUES ( " & _
                        lngVoucherDetailID & "," & C2lng(.TextMatrix(i, 4)) & "," & IIf(GrdCol.TextMatrix(i, 1) = lblNote(3).Caption, 1, -1) * C2Dbl(.TextMatrix(i, 3)) & ",1)"
            End If
            If gclsBase.ExecSQL(strSql) = False Then GoTo TheError
        End If
    Next i
    End With
    SaveCard = True
    gclsBase.BaseWorkSpace.CommitTrans
    mstrCodeAndName = strCodeAndName
    Exit Function
TheError:
    gclsBase.BaseWorkSpace.RollBacktrans
    SaveCard = False
End Function

Private Sub lstInput_KeyPress(KeyAscii As Integer)
'    If KeyAscii = 13 Then
'        If grdCol.col = 2 Then grdCol.col = 3
'        grdCol.SetFocus
'        EnterCell
'    End If
End Sub

Private Sub lstInput_KeyUp(KeyCode As Integer, Shift As Integer)
    If Shift <> 0 Then Exit Sub
    If mblnExit Then Exit Sub
    If lstInput.ReferVisible Then Exit Sub
    Debug.Print KeyCode
    If KeyCode = 39 Then
        If lstInput.SelStart = Len(lstInput.Text) Then
            lstInput_LostFocus
            GrdCol.col = 3
            EnterCell
        End If
    ElseIf KeyCode = 38 Then
        lstInput_LostFocus
        If GrdCol.Row > 1 Then
            GrdCol.Row = GrdCol.Row - 1
            EnterCell
        Else
            cmdOk(0).SetFocus
        End If