frmvouchercashflow.frm

金算盘软件代码

    ElseIf KeyCode = 40 Then
        lstInput_LostFocus
        If GrdCol.Row < GrdCol.Rows - 1 Then
            GrdCol.Row = GrdCol.Row + 1
        Else
            If GrdCol.TextMatrix(GrdCol.Row, 2) = "" Then
                cmdOk(0).SetFocus
                Exit Sub
            Else
                GrdCol.Rows = GrdCol.Rows + 1
                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
            End If
        End If
        EnterCell
    End If
    
End Sub

Private Sub lstInput_LostFocus()
    Dim i As Long
    
    On Error GoTo TheErr
    If mlngRow >= 1 Then
        With GrdCol
        If mlngRow > .Rows - 1 Then
            mlngRow = .Row
            Exit Sub
        End If
        If lstInput.ID <> 0 Then
            For i = 1 To .Rows - 1
                If i <> mlngRow Then
                    If C2lng(.TextMatrix(i, 4)) = lstInput.ID Then GoTo InvalidExit
                End If
            Next i
        End If
        If Not (.TextMatrix(mlngRow, 2) = lstInput.Text And C2lng(.TextMatrix(mlngRow, 4)) = lstInput.ID) Then
            mblnIsChanged = True
        End If
        .TextMatrix(mlngRow, 2) = lstInput.Text
        .TextMatrix(mlngRow, 4) = lstInput.ID
        
        If lstInput.ID = 0 Then
            .TextMatrix(mlngRow, 3) = ""
            lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
            lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
        ElseIf .TextMatrix(mlngRow, 3) = "" Then
            If .TextMatrix(mlngRow, 1) = lblNote(3).Caption Then
                .TextMatrix(mlngRow, 3) = lblNote(7).Caption
            Else
                .TextMatrix(mlngRow, 3) = Format(-C2Dbl(lblNote(7).Caption), FormatString(gclsBase.NaturalCurDec))
            End If
            lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
            lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
        End If
        End With
    End If
    
    Exit Sub
InvalidExit:
    ShowMsg Me.hwnd, "本现金流量项目已选用！", MB_ICONEXCLAMATION, "修改现金流量明细"
    lstInput.Text = ""
    GrdCol.TextMatrix(mlngRow, 2) = ""
    GrdCol.TextMatrix(mlngRow, 4) = ""
    
TheErr:
End Sub

Private Sub mclsSubClass_WndProc(Msg As Long, wParam As Long, lParam As Long, Result As Long)
    If Msg = WM_PAINT Then
            '取Paint事件矩形区域
           hDC1 = GetDC(GrdCol.hwnd)
           mclsSubClass.CallWndProc Msg, wParam, lParam
           DrawBLine hDC1, GrdCol.ColPos(2) - Screen.TwipsPerPixelX, GrdCol.RowHeight(0), GrdCol.ColPos(2) - Screen.TwipsPerPixelX, GrdCol.Height, RGB(128, 128, 128)
           DrawBLine hDC1, GrdCol.ColPos(3) - Screen.TwipsPerPixelX, GrdCol.RowHeight(0), GrdCol.ColPos(3) - Screen.TwipsPerPixelX, GrdCol.Height, RGB(128, 128, 128)
           ReleaseDC GrdCol.hwnd, hDC1
    Else
        mclsSubClass.CallWndProc Msg, wParam, lParam
    End If
End Sub

Private Sub mnuDel_Click()
        If GrdCol.Rows > 2 Then
           If GrdCol.Row >= 1 Then
                GrdCol.RemoveItem GrdCol.Row
                lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
                lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
                
                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
                mblnIsChanged = True
           End If
        ElseIf GrdCol.Rows = 2 Then
            lblNote(9).Caption = Format(0, FormatString(gclsBase.NaturalCurDec))
            lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
            GrdCol.Rows = 1
            mblnIsChanged = True
        End If
        
        EnterCell
        
End Sub

Private Sub mnuNew_Click()
        With GrdCol
            If .Rows = 1 Then
                .Rows = .Rows + 1
                GrdCol.TextMatrix(.Rows - 1, 1) = lblNote(3).Caption
                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
            ElseIf C2lng(.TextMatrix(.Rows - 1, 4)) <> 0 And C2Dbl(.TextMatrix(.Rows - 1, 3)) <> 0 Then
                .Rows = .Rows + 1
                GrdCol.TextMatrix(.Rows - 1, 1) = lblNote(3).Caption
                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
            End If
            .Row = .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
            .col = 2
            EnterCell
        End With
        mblnIsChanged = True
End Sub

Private Sub EnterCell()
    Dim lngUnitID As Long
    If GrdCol.Row < 1 Then
        If GrdCol.Rows = 1 Then
            GrdCol.Rows = 2
            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = lblNote(3).Caption
        End If
        GrdCol.Row = 1
    End If
'    If GrdCol.col <= 1 Then GrdCol.col = 2
    If GrdCol.col >= 3 Then
        If C2lng(GrdCol.TextMatrix(GrdCol.Row, 4)) > 0 Then
            GrdCol.col = 3
        Else
            GrdCol.col = 2
        End If
    End If
    
    mlngCol = GrdCol.col
    mlngRow = GrdCol.Row
    Paste mlngCol
End Sub

Private Sub GrdCol_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
    If Button = vbRightButton Then
        mnuDel.Caption = "删除明细(&D)"
        mnuNew.Caption = "新增明细(&A)"
        mnuNew.Enabled = (GrdCol.Rows > 1)
        If GrdCol.Rows > 2 Then
            mnuDel.Enabled = True
        ElseIf GrdCol.Rows = 2 Then
            If GrdCol.TextMatrix(1, 2) = "" Then
                mnuDel.Enabled = False
            Else
                mnuDel.Enabled = True
            End If
        Else
            mnuDel.Enabled = False
        End If
        PopupMenu mnuEdit
    Else
        With GrdCol
        If y > .RowPos(.Rows - 1) + .RowHeight(0) Then
            If C2lng(.TextMatrix(.Rows - 1, 4)) <> 0 And C2Dbl(.TextMatrix(.Rows - 1, 3)) <> 0 Then
                .Rows = .Rows + 1
                .TextMatrix(.Rows - 1, 1) = lblNote(3).Caption
                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
                .Row = .Rows - 1
                lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
                lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
            End If
        End If
        End With
        EnterCell
    End If
End Sub
Private Function NextVisibleRow(FGrid As MSFlexGrid) As Integer
    Dim i As Integer
    
    For i = FGrid.Row + 1 To FGrid.Rows - 1
        If FGrid.RowHeight(i) > 0 Then Exit For
    Next i
    If i = FGrid.Rows Then
        NextVisibleRow = FGrid.Rows - 1
    Else
        NextVisibleRow = i
    End If
End Function


Private Sub Paste(ByVal lCol As Long)
    Dim conX As Control
    
    On Error Resume Next
    With GrdCol
    lstInput.ZOrder 1
    lstInput.Move .Left + .ColPos(2) + 6 * Screen.TwipsPerPixelX, .top + .CellTop + 2 * Screen.TwipsPerPixelY, .ColWidth(2) - 5 * Screen.TwipsPerPixelX
    lstInput.Text = .TextMatrix(.Row, 2)
    lstInput.SeekId C2lng(.TextMatrix(.Row, 4))
    lstInput.ZOrder 0
    txtInput.ZOrder 1
    txtInput.Move .Left + .ColPos(3) + 5 * Screen.TwipsPerPixelX, .top + .CellTop - 0 * Screen.TwipsPerPixelY, .ColWidth(3) - 2 * Screen.TwipsPerPixelX
    txtInput.Text = .TextMatrix(.Row, 3)
    txtInput.ZOrder 0
    If lCol = 2 Then
        If lstInput.Visible = False Then lstInput.Visible = True
        Set conX = lstInput
    ElseIf lCol = 3 Then
        Set conX = txtInput
        If txtInput.Visible = False Then txtInput.Visible = True
    Else
        Set conX = txtInput
    End If
    conX.SetFocus
    If lCol = 2 Then
        InitPasteLst C2lng(GrdCol.TextMatrix(GrdCol.Row, 4))
        If txtInput.Visible = True Then txtInput.Visible = False
        If lstInput.Visible = False Then lstInput.Visible = True
    ElseIf lCol = 3 Then
        If lstInput.Visible = True Then lstInput.Visible = False
        If txtInput.Visible = False Then txtInput.Visible = True
    Else
        If lstInput.Visible = True Then lstInput.Visible = False
        If txtInput.Visible = True Then txtInput.Visible = False
    End If
    End With
    Set conX = Nothing
End Sub

Private Function LastVisibleRow(FGrid As MSFlexGrid) As Integer
    Dim i As Integer
    
    With FGrid
    For i = .Rows - 1 To 1 Step -1
        If .RowHeight(i) > 0 Then Exit For
    Next i
    End With
    LastVisibleRow = i
End Function


Private Sub InitCard(ByVal lngID As Long, Optional strName As String = "")
    Dim i As Integer
    Dim recItem As rdoResultset
    
    lstInput.Height = GrdCol.RowHeight(0)
    txtInput.Height = GrdCol.RowHeight(0)
    InitPasteLst
    mblnIsChanged = False
    InitGrid lngID
    If GrdCol.Rows > 1 Then
        If GrdCol.TextMatrix(1, 3) <> "" Then
            lstInput.Text = GrdCol.TextMatrix(1, 2)
        End If
        mlngRow = 1
    End If
    
End Sub

Private Sub txtInput_KeyUp(ByVal KeyCode As Integer, ByVal Shift As Integer)
'    If KeyCode = 13 Then
'        If mlngRow >= 1 Then
'            grdCol.TextMatrix(mlngRow, 3) = txtInput.Text
'            lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
'            lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
'            If C2lng(grdCol.TextMatrix(mlngRow, 4)) = 0 And C2Dbl(grdCol.TextMatrix(mlngRow, 3)) <> 0 Then
'                ShowMsg Me.hwnd, "请输入现金流量项目说明！", MB_ICONEXCLAMATION, "修改现金流量明细"
'                grdCol.Row = mlngRow
'                grdCol.col = 2
'                EnterCell
'            End If
'        End If
'        If C2lng(grdCol.TextMatrix(grdCol.Row, 4)) = 0 Then
'            If C2Dbl(txtInput.Text) = 0 Then
'                cmdOK(0).SetFocus
'            Else
'                grdCol.Row = grdCol.Row
'                grdCol.col = 1
'                EnterCell
'            End If
'        Else
'            If C2Dbl(txtInput.Text) <> 0 Then
'                If grdCol.Row = grdCol.Rows - 1 Then grdCol.Rows = grdCol.Rows + 1
'                grdCol.Row = grdCol.Row + 1
'                grdCol.col = 2
'                EnterCell
'            End If
'        End If
'    End If
End Sub

Private Sub txtInput_LostFocus()
    If mlngRow >= 1 Then
        If Not GrdCol.TextMatrix(mlngRow, 3) = txtInput.Text Then
            mblnIsChanged = True
        End If
        GrdCol.TextMatrix(mlngRow, 3) = Format(txtInput.Text, FormatString(gclsBase.NaturalCurDec))
        lblNote(9).Caption = Format(TotalAmount(), FormatString(gclsBase.NaturalCurDec))
        lblNote(7).Caption = Format(C2Dbl(lblNote(5).Caption) - C2Dbl(lblNote(9).Caption), FormatString(gclsBase.NaturalCurDec))
        If C2lng(GrdCol.TextMatrix(mlngRow, 4)) = 0 And C2Dbl(GrdCol.TextMatrix(mlngRow, 3)) <> 0 Then
            
            ShowMsg Me.hwnd, "请输入现金流量项目说明！", MB_ICONEXCLAMATION, "修改现金流量明细"
            GrdCol.Row = mlngRow
            GrdCol.col = 2
            EnterCell
        End If
    End If
End Sub