frmvouchervolume.frm

金算盘软件代码

        If GrdCol.Rows = 1 Then InsertARow
        GrdCol.Row = 1
    End If
    If (Not (mlngCol = GrdCol.col And mlngRow = GrdCol.Row)) Then
        SaveInput2Form
        If DoValid Then
            If DataValid1(GrdCol.Row, GrdCol.col) = False Then Exit Sub
        End If
    End If
    If GrdCol.col < 1 Then GrdCol.col = 1
    If GrdCol.col > 3 Then GrdCol.col = 3
    If GrdCol.col = 2 Then GrdCol.col = 3
    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
    Else
        With GrdCol
        If y > .RowPos(.Rows - 1) + .RowHeight(0) Then
            If C2lng(.TextMatrix(.Rows - 1, 1)) <> 0 And C2Dbl(.TextMatrix(.Rows - 1, 3)) <> 0 Then
                InsertARow
                .Row = .Rows - 1
            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)
    On Error Resume Next
    With GrdCol
    txtInput.ZOrder 1
    txtInput.Move .Left + .ColPos(lCol) + 5 * Screen.TwipsPerPixelX, .top + .CellTop + 1 * Screen.TwipsPerPixelY, .ColWidth(lCol) - 3 * Screen.TwipsPerPixelX
    If lCol = 1 Then
        txtInput.MaxLength = 2
    Else
        txtInput.MaxLength = 4
    End If
    txtInput.Text = .TextMatrix(.Row, lCol)
    txtInput.SelStart = 0
    txtInput.SelLength = Len(txtInput.Text)
    txtInput.ZOrder 0
    If txtInput.Visible = False Then txtInput.Visible = True
    txtInput.SetFocus
    End With
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 intYear As Long, ByVal bytPeriod As Long, ByVal lngVoucherTypeID As Long)
    Dim i As Integer
    Dim recItem As rdoResultset
    
    txtInput.Height = GrdCol.RowHeight(0)
    InitLst1
    InitLst0
    mblnIsChanged = False
    InitGrid intYear, bytPeriod, lngVoucherTypeID
    If GrdCol.Rows > 1 Then
        mlngRow = 1
    End If
    
End Sub

Private Function SaveInput2Form() As Boolean
    If Me.Visible = False Then Exit Function
    If mlngRow >= 1 And mlngRow <= GrdCol.Rows - 1 And mlngCol >= 1 And mlngCol <= 4 Then
        If mlngCol = 1 Then
            If Not GrdCol.TextMatrix(mlngRow, mlngCol) = Format(txtInput.Text, "00") Then
                GrdCol.TextMatrix(mlngRow, mlngCol) = Format(txtInput.Text, "00")
                GrdCol.TextMatrix(mlngRow, 0) = "1"
                mblnIsChanged = True
            End If
        ElseIf mlngCol = 3 Then
            If Not GrdCol.TextMatrix(mlngRow, mlngCol) = Format(txtInput.Text, "0000") Then
                GrdCol.TextMatrix(mlngRow, mlngCol) = Format(txtInput.Text, "0000")
                GrdCol.TextMatrix(mlngRow, 0) = "1"
                If mlngRow < GrdCol.Rows - 1 Then
                    GrdCol.TextMatrix(mlngRow + 1, 2) = Format(C2lng(txtInput.Text) + 1, "0000")
                    GrdCol.TextMatrix(mlngRow + 1, 0) = "1"
                End If
                mblnIsChanged = True
            End If
        End If
    End If
End Function
Private Function DataValid1(Optional ByVal Row As Long = 0, Optional ByVal col As Long = 0) As Boolean
    If Me.Visible = False Then
        DataValid1 = True
        Exit Function
    End If
    If mlngRow >= 1 And mlngRow <= GrdCol.Rows - 1 And mlngCol >= 1 And mlngCol <= 4 Then
        If (Not (mlngRow = Row And col = 1)) And mlngCol = 1 Then
            If Trim(GrdCol.TextMatrix(mlngRow, 1)) = "" And (C2lng(GrdCol.TextMatrix(mlngRow, 2)) <> 0 Or C2lng(GrdCol.TextMatrix(mlngRow, 3))) <> 0 Then
                mblnExit = True
                ShowMsg Me.hwnd, "请输入凭证册号！", MB_ICONEXCLAMATION, Me.Caption
                DataValid1 = False
                GrdCol.Row = mlngRow
                GrdCol.col = 1
                EnterCell False
                Exit Function
            End If
        End If
        If (Not (mlngRow = Row And col = 3)) And mlngCol = 3 Then
            If Trim(GrdCol.TextMatrix(mlngRow, 1)) <> "" And C2lng(GrdCol.TextMatrix(mlngRow, 3)) = 0 Then
                mblnExit = True
                ShowMsg Me.hwnd, "请输入凭证结束编号！", MB_ICONEXCLAMATION, Me.Caption
                DataValid1 = False
                GrdCol.Row = mlngRow
                GrdCol.col = 3
                EnterCell False
                Exit Function
            End If
        End If
        If (Not (mlngRow = Row And col = 3)) And mlngCol = 3 Then
            If (C2lng(GrdCol.TextMatrix(mlngRow, 2)) > C2lng(GrdCol.TextMatrix(mlngRow, 3))) Then
                mblnExit = True
                ShowMsg Me.hwnd, "凭证结束编号应大于凭证起始编号！", MB_ICONEXCLAMATION, Me.Caption
                DataValid1 = False
                GrdCol.Row = mlngRow
                GrdCol.col = 3
                EnterCell False
                Exit Function
            End If
        End If
        GrdCol.TextMatrix(mlngRow, 4) = SumVoucher(mlngRow)
        If mlngRow < GrdCol.Rows - 1 Then
            GrdCol.TextMatrix(mlngRow + 1, 4) = SumVoucher(mlngRow + 1)
        Else
            lblNote(3).Caption = SumOtherVoucher()
        End If
    End If
EndProc:
    DataValid1 = True
End Function
Private Function DataValid() As Boolean
    Dim i As Long
    Dim j As Long
    If GrdCol.Rows <= 1 Then
        DataValid = True
        Exit Function
    ElseIf GrdCol.Rows - 1 = 1 And C2lng(GrdCol.TextMatrix(1, 3)) = 0 Then
        DataValid = True
        Exit Function
    ElseIf GrdCol.Rows - 1 > 1 And C2lng(GrdCol.TextMatrix(GrdCol.Rows - 1, 3)) = 0 Then
        GrdCol.Rows = GrdCol.Rows - 1
    End If
    With GrdCol
    For i = 1 To .Rows - 1
        If Trim(.TextMatrix(i, 1)) = "" Then
            mblnExit = True
            ShowMsg Me.hwnd, "请输入凭证册号！", MB_ICONEXCLAMATION, Me.Caption
            GrdCol.Row = i
            GrdCol.col = 1
            EnterCell False
            Exit Function
        End If
        If C2lng(.TextMatrix(i, 3)) = 0 Then
            mblnExit = True
            ShowMsg Me.hwnd, "请输入凭证结束编号！", MB_ICONEXCLAMATION, Me.Caption
            GrdCol.Row = i
            GrdCol.col = 3
            EnterCell False
            Exit Function
        End If
        If (C2lng(.TextMatrix(i, 2)) > C2lng(.TextMatrix(i, 3))) Then
            mblnExit = True
            ShowMsg Me.hwnd, "凭证结束编号应大于凭证起始编号！", MB_ICONEXCLAMATION, Me.Caption
            GrdCol.Row = i
            GrdCol.col = 3
            EnterCell False
            Exit Function
        End If
        For j = 1 To i - 1
            If Trim(.TextMatrix(j, 1)) = Trim(.TextMatrix(i, 1)) Then
                mblnExit = True
                ShowMsg Me.hwnd, "凭证册号重复！", MB_ICONEXCLAMATION, Me.Caption
                GrdCol.Row = i
                GrdCol.col = 1
                EnterCell False
                Exit Function
            End If
        Next j
    Next i
    End With
EndProc:
    DataValid = True
End Function

Private Sub txtInput_KeyPress(KeyAscii As Integer)
    If mlngCol > 1 Then
KeyFilter:
        If KeyAscii = 8 Then Exit Sub '删左
        If KeyAscii = 13 Then Exit Sub 'ENTER
        If KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Then
        Else
            KeyAscii = 0
        End If
    Else
        FilterSpecialChar KeyAscii
    End If
End Sub
Private Sub InsertARow()
    If GrdCol.Rows = 1 Then
        GrdCol.Rows = GrdCol.Rows + 1
    ElseIf C2lng(GrdCol.TextMatrix(GrdCol.Rows - 1, 3)) > 0 Then
        GrdCol.Rows = GrdCol.Rows + 1
    Else
        Exit Sub
    End If
    If GrdCol.Rows - 1 = 1 Then
        GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = "01"
        GrdCol.TextMatrix(GrdCol.Rows - 1, 2) = "0001"
    Else
        If C2lng(GrdCol.TextMatrix(GrdCol.Rows - 2, 1)) > 0 Then
            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = Format(C2lng(GrdCol.TextMatrix(GrdCol.Rows - 2, 1)) + 1, "00")
        Else
            Dim strT As String
            strT = GrdCol.TextMatrix(GrdCol.Rows - 2, 1)
            GrdCol.TextMatrix(GrdCol.Rows - 1, 1) = Format((Left(strT, 1) & Chr(Asc(Right(strT, 1)) + 1)), "00")
        End If
        GrdCol.TextMatrix(GrdCol.Rows - 1, 2) = Format(C2lng(GrdCol.TextMatrix(GrdCol.Rows - 2, 3)) + 1, "0000")
    End If
End Sub

Private Function Change() As Boolean
    Dim intYear As Long
    Dim bytPeriod As Long
    Dim lngVoucherTypeID As Long
    intYear = C2lng(Left(Trim(lstInput(0).Text), 4))
    bytPeriod = C2lng(Right(Trim(lstInput(0).Text), 2))
    lngVoucherTypeID = lstInput(1).ID
    If intYear = 0 Or bytPeriod = 0 Or lngVoucherTypeID = 0 Then Exit Function
    If Not (mintYear = intYear And mbytPeriod = bytPeriod And mlngVoucherTypeID = lngVoucherTypeID) Then
        If SaveCard() Then
            mintYear = intYear
            mbytPeriod = bytPeriod
            mlngVoucherTypeID = lngVoucherTypeID
            InitGrid mintYear, mbytPeriod, mlngVoucherTypeID
        Else
            lstInput(0).Text = Format(mintYear, "0000") & "." & Format(mbytPeriod, "00")
            lstInput(1).SeekId mlngVoucherTypeID
            Change = False
            Exit Function
        End If
    End If
    Change = True
End Function


Private Function SumVoucher(ByVal lngRow As Long) As String
    Dim recTmp As rdoResultset
    Dim strSql  As String
    Dim lngTmp As Long
    Dim lngStart As Long
    Dim lngEnd As Long
    On Error GoTo EndProc
    lngStart = C2lng(GrdCol.TextMatrix(lngRow, 2))
    lngEnd = C2lng(GrdCol.TextMatrix(lngRow, 3))
    
    strSql = "SELECT count(*) FROM Voucher" & _
            " WHERE intyear=" & mintYear & " AND bytPeriod=" & mbytPeriod & _
            " AND lngVoucherTypeID=" & mlngVoucherTypeID & " AND (intVoucherNo>=" & lngStart & " AND intVoucherNo<=" & lngEnd & ")"
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If Not recTmp.EOF Then
        lngTmp = IIf(IsNull(recTmp(0)), 0, recTmp(0))
    End If
    recTmp.Close
EndProc:
    Set recTmp = Nothing
    If lngTmp = 0 Then
        SumVoucher = ""
    Else
        SumVoucher = Format(lngTmp, "#,###")
    End If
End Function
Private Function SumOtherVoucher() As String
    Dim recTmp As rdoResultset
    Dim strSql  As String
    Dim lngTmp As Long
    Dim lngEnd As Long
    Dim lngMin As Long
    Dim lngMax As Long
    Dim i As Long
    For i = GrdCol.Rows - 1 To 1 Step -1
        lngEnd = C2lng(GrdCol.TextMatrix(i, 3))
        If lngEnd > 0 Then Exit For
    Next
    On Error GoTo EndProc
        strSql = "SELECT count(*),MIN(intVoucherNo),MAX(intVoucherNo) FROM Voucher" & _
                " WHERE intyear=" & mintYear & " AND bytPeriod=" & mbytPeriod & _
                " AND lngVoucherTypeID=" & mlngVoucherTypeID & " AND intVoucherNo>" & lngEnd
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTmp.EOF Then
            lngTmp = IIf(IsNull(recTmp(0)), 0, recTmp(0))
            lngMin = IIf(IsNull(recTmp(1)), 0, recTmp(1))
            lngMax = IIf(IsNull(recTmp(2)), 0, recTmp(2))
        End If
    recTmp.Close
EndProc:
    Set recTmp = Nothing
    If lngTmp = 0 Then
        SumOtherVoucher = "共0张"
    Else
'        SumOtherVoucher = Format(lngEnd + 1, "0000") & "--" & Format(lngEnd + lngTmp, "0000") & " 共" & Format$(lngTmp, "0000") & "张。"
        SumOtherVoucher = Format(lngMin, "0000") & "--" & Format(lngMax, "0000") & " 共" & lngTmp & "张。"
    End If
End Function