frmyh_yhdzdqc.frm

一个用VB写的财务软件源码

End Sub

'按日期自动排序
Private Sub AutoDateSort()
    With mfgYhdzdqc
        IsRefresh = True
        .row = 1
        .col = 1
'如果当前是在增加状态, 则行选择范围=总行数-2
'否则行选择范围=总行数-1
        If Not tbr.Buttons("new").Enabled Then
            .RowSel = .Rows - 2
        Else
            .RowSel = .Rows - 1
        End If

        .ColSel = 1
        If .RowSel <> 1 Then
            .Sort = flexSortStringNoCaseAscending
        End If
        If Not tbr.Buttons("new").Enabled Then
            .row = CurrentRowNum
            .col = 1
        Else
            .row = NewRow
            .col = NewCol
        End If
        IsRefresh = False
    End With
    Call mfgYhdzdqc_GotFocus1
End Sub

'窗体被删除时调用
Private Sub Form_Unload(Cancel As Integer)
    If Not tbr.Buttons("new").Enabled Then
        Cancel = 1
        MsgBox "记录没有保存, 不能退出！", vbOKOnly + vbInformation
    Else
        With mfgYhdzdqc
            If .row > 0 Then
                Call mfgYhdzdqc_LeaveCell
                If IsValidate Then
                    Cancel = 0
                    If IsModify Then
                        Call UpdateCurrentRow
                    End If
                    Unload Myfrmcx
                Else
                    Cancel = -1
                    .row = OldRow
                    .col = ErrorCol
                    Call mfgYhdzdqc_GotFocus1
                End If
            Else
                Cancel = 0
                Unload Myfrmcx
            End If
        End With
    End If
    Unload frmP
End Sub

'窗体尺寸改变后, 控件尺寸相应改变
Private Sub Form_Resize()
    If Me.WindowState <> 1 Then
        If Me.Height < 5000 Then
            Me.Height = 5000
        End If
        If Me.Width < 7000 Then
            Me.Width = 7000
        End If
        lblYhtzqye.Left = Me.ScaleWidth - lblYhtzqye.Width - 30
        mfgYhdzdqc.Height = Me.ScaleHeight - mfgYhdzdqc.Top - fraInfo.Height - 30
        mfgYhdzdqc.Width = Me.ScaleWidth - 2 * mfgYhdzdqc.Left
        fraInfo.Left = Me.ScaleWidth - fraInfo.Width - 30
        fraInfo.Top = Me.ScaleHeight - fraInfo.Height - 30
    End If
End Sub

'动态设置文本框的输入字符的最大长度
Private Sub txtEdit_GotFocus()
    With mfgYhdzdqc
        Select Case True
            Case .col = 3
                txtEdit.MaxLength = 12
                txtEdit.SelStart = 0
                txtEdit.SelLength = Len(txtEdit.text)
            Case .col = 4 Or .col = 5
                txtEdit.MaxLength = 15
                txtEdit.SelStart = 0
                txtEdit.SelLength = Len(txtEdit.text)
            Case .col = 6
                txtEdit.MaxLength = 60
        End Select
    End With
End Sub

'根据所按方向键改变表格中获得焦点的单元格

Private Sub txtEdit_KeyDown(KeyCode As Integer, Shift As Integer)
     With mfgYhdzdqc
        Select Case KeyCode
            Case vbKeyLeft
                If .col > 1 Then
                    .col = .col - 1
                End If
            Case vbKeyRight
                If .col < .Cols - 1 Then
                    .col = .col + 1
                End If
            Case vbKeyUp
                If .row > 1 Then
                    .row = .row - 1
                End If
            Case vbKeyDown
                If .row < .Rows - 1 Then
                    .row = .row + 1
                End If
        End Select
    End With
End Sub

Private Sub txtEdit_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        With mfgYhdzdqc
'如果当前单元格不在最后一列, 则将回车键转换为右方向键;
            If .col < .Cols - 1 Then
                SendKeys "{RIGHT}"
'否则如果单元行不在最后一行
    '则如果单元格数据合法,
        '则将活动单元格移到下一行的第二列,
        '否则将活动单元格移到第五列;
            ElseIf .row < .Rows - 1 Then
                If IsValidate Then
                    .row = .row + 1
                    .col = 1
                Else
                    .col = ErrorCol
                End If
'否则如果在增加状态,
'则如果当前行数据合法,则新增一行;
            ElseIf Not tbr.Buttons("new").Enabled Then
                If IsValidate Then
                    Call AddNewRow
'                    If .Rows > 3 Then
'                        Call AutoDateSort
'                    End If
                Else
                    .col = ErrorCol
                End If
            End If
        End With
    Else
        With mfgYhdzdqc
            If .col = 4 Or .col = 5 Then
                If Len(txtEdit.text) = 15 And txtEdit.SelLength = 0 Then
                    If KeyAscii <> 8 And KeyAscii <> 10 Then
                        KeyAscii = 0
                    End If
                Else
                    If Len(txtEdit.text) = 12 And KeyAscii <> 8 And KeyAscii <> 10 Then
                        If InStr(1, txtEdit.text, ".") = 0 Then
                            KeyAscii = Asc(".")
                        End If
                    Else
                        KeyAscii = NegativeDoubleEnabled(txtEdit, KeyAscii)
                    End If
                End If
                If KeyAscii <> 0 Then
'如果对账单记录的借方金额被输入, 则贷方金额为零;
                    If .col = 4 Then
                        .TextMatrix(.row, .col + 1) = ""
'如果对账单记录的贷方金额被输入, 则借方金额为零;
                    ElseIf .col = 5 Then
                        .TextMatrix(.row, .col - 1) = ""
                    End If
                End If
            End If
        End With
    End If
End Sub


'文本框离开焦点时, 将文本的最大长度设置为字段"摘要"的长度,防止在单元格获得焦点时摘要被截去;
Private Sub txtEdit_LostFocus()
    txtEdit.MaxLength = 60
End Sub


'判断当前表格行中的借方金额和贷方金额是否同时为零;
Private Function IsValidate() As Boolean
    If OldRow > 0 Then
        IsValidate = True
        With mfgYhdzdqc
            If .TextMatrix(OldRow, 1) >= Format(frmYH_Yetjbqc.dtpQyrq.value, "yyyy-mm-dd") Then
                MsgBox "对账单日期必须小于启用日期！", vbOKOnly + vbInformation
                IsValidate = False
                ErrorCol = 1
                Exit Function
            End If
            If .TextMatrix(OldRow, 4) = "" And .TextMatrix(OldRow, 5) = "" Then
                MsgBox "借方金额和贷方金额不能同时为零！", vbOKOnly + vbInformation
                IsValidate = False
                ErrorCol = 4
                Exit Function
            End If
            If .TextMatrix(OldRow, 4) <> "" And .TextMatrix(OldRow, 5) <> "" Then
                MsgBox "借方金额和贷方金额不能同时有金额！", vbOKOnly + vbInformation
                IsValidate = False
                ErrorCol = 4
                Exit Function
            End If
        End With
    End If
End Function

'设置打印表格
Private Sub SetGrid(ByVal PageNo As Long, Optional ByVal FactRows As Long)
    Dim i As Long, j As Long
    Dim iColWidth() As Integer
    
    With frmP.CllR
        .SetCurSheet PageNo - 1
        .SetRows FactRows, PageNo - 1
        .SetCols COL_END + 2, PageNo - 1
        .PrintSetMargin 10, 10, 10, 10
''        .DoSetPrintPara 1, 9, True                 '设置打印纸张A4纵向
''        .DoSetPrintRange 0, .Cols - 1, 0, .Rows - 1     '设置打印范围
        .ShowSideLabel 0, PageNo - 1
        .ShowTopLabel 0, PageNo - 1
''        .DoSetDefaultFont 9, 0, "宋体"
         .SetDefaultFont .FindFontIndex("宋体", 1), 10
''        .DoSetBackGround 0
''        .DoShowCurrentCell False, False
''        .AllowSizeColInGrid = True
        
    'Title
        .SetCellAlign COL_START, ROW_TITLE, PageNo - 1, 36
''        .DoSetCellFont COL_START, ROW_TITLE, 18, 5, "黑体"
        .SetCellFont COL_START, ROW_TITLE, PageNo - 1, .FindFontIndex("黑体", 1)
        .SetCellFontSize COL_START, ROW_TITLE, PageNo - 1, 19
        .SetCellFontStyle COL_START, ROW_TITLE, PageNo - 1, 10
        .MergeCells COL_START, ROW_TITLE, COL_END, ROW_TITLE
        .SetCellString COL_START, ROW_TITLE, PageNo - 1, "期初银行对账单"
        .SetRowHeight 1, 40, ROW_TITLE, PageNo - 1
    'Comment
        .MergeCells COL_START, ROW_BLANK, COL_END, ROW_BLANK
        .MergeCells COL_START, ROW_SUBJNAME, COL_DEBIT_MONEY, ROW_SUBJNAME
        .MergeCells COL_CREDIT_MONEY, ROW_SUBJNAME, COL_END, ROW_SUBJNAME
        
         .SetCellAlign COL_START, ROW_BLANK, PageNo - 1, 34
''        .DoSetCellFont COL_START, ROW_SUBJNAME, 10, 0, "楷体_GB2312"
        .SetCellFont COL_START, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_START, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_START, ROW_SUBJNAME, PageNo - 1, 0
        .SetCellAlign COL_CREDIT_MONEY, ROW_SUBJNAME, PageNo - 1, 34
''        .DoSetCellFont COL_CREDIT_MONEY, ROW_SUBJNAME, 10, 0, "楷体_GB2312"
        .SetCellFont COL_CREDIT_MONEY, ROW_SUBJNAME, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
        .SetCellFontSize COL_CREDIT_MONEY, ROW_SUBJNAME, PageNo - 1, 11
        .SetCellFontStyle COL_CREDIT_MONEY, ROW_SUBJNAME, PageNo - 1, 0
        
        .SetCellString COL_START, ROW_BLANK, PageNo - 1, "第 " & CStr(PageNo) & " 页"
        .SetCellString COL_START, ROW_SUBJNAME, PageNo - 1, frmYH_Yetjbqc.lblKmmc
        .SetCellString COL_CREDIT_MONEY, ROW_SUBJNAME, PageNo - 1, lblYhtzqye.Caption
    
    'Head
        For i = ROW_HEAD1 To ROW_HEAD1
            .SetRowHeight 1, 30, i, PageNo - 1
            For j = COL_START To COL_END
                .SetCellAlign j, i, PageNo - 1, 36
                .SetCellTextStyle j, i, PageNo - 1, 2
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
        Next i
        
        '设置列宽
        iColWidth = GetColWidth(ColWidth)
        For i = LBound(iColWidth) To UBound(iColWidth)
            .SetColWidth 1, iColWidth(i), i + 1, PageNo - 1
        Next i
        .SetColWidth 1, 1, COL_END + 1, PageNo - 1
        
        '设置内容
        .SetCellString COL_RQ, ROW_HEAD1, PageNo - 1, "日期"
        .SetCellString COL_JSFS, ROW_HEAD1, PageNo - 1, "结算方式"
        .SetCellString COL_BILL_NUMBER, ROW_HEAD1, PageNo - 1, "票号"
        .SetCellString COL_DEBIT_MONEY, ROW_HEAD1, PageNo - 1, "借方金额"
        .SetCellString COL_CREDIT_MONEY, ROW_HEAD1, PageNo - 1, "贷方金额"
        .SetCellString COL_ZY, ROW_HEAD1, PageNo - 1, "摘要"
    'Text
        For i = ROW_GRID_START To .GetRows(PageNo - 1) - 1
            For j = COL_START To COL_END
''                .DoSetCellFont j, i, 10, 0, "楷体_GB2312"
                .SetCellFont j, i, PageNo - 1, .FindFontIndex("楷体_GB2312", 1)
                .SetCellFontSize j, i, PageNo - 1, 11
                .SetCellFontStyle j, i, PageNo - 1, 0
            Next j
            .SetCellAlign COL_RQ, i, PageNo - 1, 36
            .SetCellAlign COL_JSFS, i, PageNo - 1, 33
            .SetCellAlign COL_BILL_NUMBER, i, PageNo - 1, 33
            .SetCellAlign COL_DEBIT_MONEY, i, PageNo - 1, 34
            .SetCellAlign COL_CREDIT_MONEY, i, PageNo - 1, 34
            .SetCellAlign COL_ZY, i, PageNo - 1, 33
        Next i
        .MergeCells .GetCols(PageNo - 1) - 1, ROW_HEAD1, .GetCols(PageNo - 1) - 1, .GetRows(PageNo - 1) - 1
        
''    'Draw Line
''        'Frame
        .DrawGridLine COL_START, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 1, 3, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_RQ, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 2, 5, 2, .FindColorIndex(RGB(0, 0, 0), 1)
        .DrawGridLine COL_JSFS, ROW_HEAD1, COL_END, .GetRows(PageNo - 1) - 1, 2, 2, .FindColorIndex(RGB(0, 0, 0), 1)
''        .DoDrawHLine COL_START, COL_END, ROW_HEAD1, True, CRB_LINE, 2
''        .DoDrawHLine COL_START, COL_END, .Rows - 1, False, CRB_LINE, 2
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_START, True, CRB_LINE, 2
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_END + 1, True, CRB_LINE, 2
''
''        'Text Vertical
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_RQ, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_JSFS, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_BILL_NUMBER, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_DEBIT_MONEY, False, CRB_LINE, 1
''        .DoDrawVLine ROW_HEAD1, .Rows - 1, COL_CREDIT_MONEY,