input.frm

我自己编写的个人财务系统,VB语言,用于个人财务统计,可自己初始化财务类别,密码8127!

      Top             =   1800
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "日期"
      Height          =   180
      Index           =   6
      Left            =   120
      TabIndex        =   25
      Top             =   3720
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "金额"
      Height          =   180
      Index           =   5
      Left            =   3360
      TabIndex        =   24
      Top             =   720
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "账户"
      Height          =   180
      Index           =   4
      Left            =   120
      TabIndex        =   22
      Top             =   3360
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "贷方"
      Height          =   180
      Index           =   3
      Left            =   120
      TabIndex        =   21
      Top             =   2160
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "备注"
      Height          =   180
      Index           =   2
      Left            =   120
      TabIndex        =   20
      Top             =   3000
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "金额"
      Height          =   180
      Index           =   1
      Left            =   3360
      TabIndex        =   19
      Top             =   360
      Width           =   360
   End
   Begin VB.Label Lb1 
      AutoSize        =   -1  'True
      Caption         =   "借方"
      Height          =   180
      Index           =   0
      Left            =   120
      TabIndex        =   18
      Top             =   360
      Width           =   360
   End
End
Attribute VB_Name = "inputfrm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Option Explicit
Dim rs As New ADODB.Recordset
'Dim RS1 As New ADODB.Recordset
Dim Keys(6) As String
Dim setGrade(6) As String
Dim myIndex As Integer
Dim zwGrade(2) As String
Dim Money(2) As Double



Private Sub Calendar1_Click()
T4.Text = Calendar1.Value
T4_LostFocus '执行函数
End Sub

Private Sub Cm1_Click()
If T4.Text = "" Then GoTo L2:
Dim Arr(6) As String
Dim Ar(6) As Double
Tmp = 0
For i = 0 To 2
    If T3(i) <> "" Then
        tmp1 = tmp1 + Val(T3(i).Text)
    End If
Next
If tmp1 <> Text1.Text Then GoTo L2:
For i = 0 To 5
    Arr(i) = T1(i): Ar(i) = Val(T3(i))
Next
vbkey = MsgBox("输入的信息如下：" & vbCrLf & _
       "[借方1]：" & Arr(5) & "[金额]：" & Ar(5) & vbCrLf & _
       "[借方2]：" & Arr(4) & "[金额]：" & Ar(4) & vbCrLf & _
       "[借方3]：" & Arr(3) & "[金额]：" & Ar(3) & vbCrLf & _
       "[贷方1]：" & Arr(2) & "[金额]：" & Ar(2) & vbCrLf & _
       "[贷方2]：" & Arr(1) & "[金额]：" & Ar(1) & vbCrLf & _
       "[贷方3]：" & Arr(0) & "[金额]：" & Ar(0) & vbCrLf & _
       "[日期]：" & T4.Text & vbCrLf & _
       "[帐户]：" & Text2.Text & "", vbOKCancel, "确认")
If vbkey = 2 Then Exit Sub
For i = 0 To 5
    If T1(i).Text = "" And T3(i).Text = "" Then
        Tmp = Tmp + 1
        GoTo ll:
    Else
        If T1(i).Text = "" Or T3(i).Text = "" Then GoTo L2:
            If zwGrade(0) = Left(setGrade(i), Len(zwGrade(0))) Then T3(i).Text = -T3(i).Text
            If zwGrade(1) = Left(setGrade(i), Len(zwGrade(1))) Then T3(i).Text = -T3(i).Text
            If i < 6 And i > 2 Then MyOpen rs, "insert into ziliao (mney,program,dd,name,bz,keys,grade) values('" & Trim(T3(i).Text) & "','" & T1(i).Text & "','" & Trim(T4.Text) & "','" & Trim(Text2.Text) & "','" & Trim(T2.Text) & "','" & Keys(i) & "','" & setGrade(i) & "')"
            If i < 3 Then MyOpen rs, "insert into ziliao (mney,program,dd,name,bz,keys,grade) values('" & -Trim(T3(i).Text) & "','" & T1(i).Text & "','" & Trim(T4.Text) & "','" & Trim(Text2.Text) & "','" & Trim(T2.Text) & "','" & Keys(i) & "','" & setGrade(i) & "')"
    End If

    T1(i) = "": T3(i) = ""
    T1(i).BackColor = vbWhite: T1(i).ForeColor = vbBlack
    T3(i).BackColor = vbWhite: T3(i).ForeColor = vbBlack
ll: Next
If Tmp = 6 Then GoTo L2:
MyOpen rs, "select * from pw where name='" & Trim(Text2.Text) & "'"
If rs.EOF Then GoTo L2:
MsgBox "操作成功！", vbInformation + vbOKOnly, "成功"
T1(5).SetFocus
T2.Text = ""
Text1.Text = ""
For i = 0 To 2
    Money(i) = 0
Next
'Text1.BackColor = vbWhite
Exit Sub
L2:    MsgBox "信息不全或不正确,请检查!", , "提示"
End Sub

Private Sub Cm2_Click()
For i = 0 To 5
    T1(i).Text = ""
    T1(i).BackColor = vbWhite
    T3(i).BackColor = vbWhite
    T3(i).Text = ""
Next
myIndex = 5
T2.Text = ""
Text1.Text = ""
'Text1.BackColor = vbWhite
For i = 0 To 2
    Money(i) = 0
Next

End Sub

Private Sub Cm3_Click()
Unload Me
query.Show
End Sub

Private Sub cm4_Click()
Unload Me
End Sub













Private Sub Form_Click()
Calendar1.Visible = False
End Sub

Private Sub Form_Load()
For i = 0 To 2
    Money(i) = 0
Next
Status1 = 1
Me.Top = 0
Me.Left = 0
MyOpen rs, "select grade,grade1 from adpw where grade<>null and grade1<>null"
If rs.EOF Then MsgBox "请先初始化科目!", , "提示": Exit Sub
zwGrade(0) = rs(0)
zwGrade(1) = rs(1)
If Len(Date) <= 9 Then
    tmp1 = Val(Mid(Date, 6, 2))
    tmp2 = Val(Right(Date, 2))
    If tmp1 < 10 Then tmp1 = "0" & Mid(tmp1, 1, 1)
    If tmp2 < 10 Then tmp2 = "0" & Right(tmp2, 1)

    T4.Text = Left(Date, 4) & "-" & tmp1 & "-" & tmp2
Else
    T4.Text = Date
End If
'T4.Text = Date
    Dim oNodex As node

    Set oNodex = TreeView1.Nodes.Add(, , "0_", "科目------")

    MyOpen rs, "select * from program "
If rs.RecordCount > 0 Then 'make sure there are records in the table
    rs.MoveFirst
    Do While rs.EOF = False
        'nImage = rs.Fields("image")
        'nSelectedImage = rs.Fields("selectedimage")
        If Trim(rs.Fields("parents")) = "0_" Then 'All root nodes have 0_ in the parent field
            Set oNodex = TreeView1.Nodes.Add(, 1, Trim(rs.Fields("keys")), _
              Trim(rs.Fields("program")))
              'w = tvwChild
        Else 'All child nodes will have the parent key stored in the parent field
            'Set oNodex = TreeView1.Nodes.Add(Trim(rs.Fields("parents")), tvwChild, _
               'Trim(rs.Fields("keys")), Trim(rs.Fields("program")))
               'w = tvwChild
            Set oNodex = TreeView1.Nodes.Add(Trim(rs.Fields("parents")), tvwChild, _
              Trim(rs.Fields("keys")), Trim(rs.Fields("program")))
           
            'oNodex.EnsureVisible 'expend the TreeView so all nodes are visible
        End If

        rs.MoveNext
    Loop
End If
Text2.Text = myName
Calendar1.Value = Date
rs.Close 'Close the table


End Sub



Private Sub Form_Unload(Cancel As Integer)
Status1 = 0
End Sub



Private Sub T1_GotFocus(Index As Integer)
T1(Index).BackColor = vbRed
T1(Index).ForeColor = vbYellow
myIndex = Index

End Sub


Private Sub T1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 Then
        Cm1.SetFocus
    End If
End Sub

Private Sub T1_LostFocus(Index As Integer)
T1(Index).BackColor = vbWhite
T1(Index).ForeColor = vbBlack
End Sub


Private Sub T2_GotFocus()
T2.BackColor = vbRed
T2.ForeColor = vbYellow
End Sub

Private Sub T2_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        Cm1.SetFocus
    End If
End Sub

Private Sub T2_LostFocus()
T2.BackColor = vbWhite
T2.ForeColor = vbBlack
End Sub

Private Sub T3_GotFocus(Index As Integer)
T3(Index).BackColor = vbRed
T3(Index).ForeColor = vbYellow
myIndex = Index
End Sub

Private Sub T3_LostFocus(Index As Integer)
T3(Index).ForeColor = vbBlack
T3(Index).BackColor = vbWhite
'If Index < 6 And Index > 2 Then
'    Text1.Text = Money(0) + Val(T3(Index).Text)
'
'    Text1.BackColor = vbBlue
'End If
Select Case Index
    Case 5
    Money(0) = Val(T3(Index).Text)
    Text1.Text = Money(1) + Money(2) + Money(0)
    Case 4
    Money(1) = Val(T3(Index).Text)
    Text1.Text = Money(1) + Money(2) + Money(0)
    Case 3
    Money(2) = Val(T3(Index).Text)
    Text1.Text = Money(1) + Money(2) + Money(0)
End Select
End Sub



Private Sub T4_Click()
Calendar1.Visible = Not Calendar1.Visible
End Sub

Private Sub T4_DblClick()
tmp1 = Val(Mid(Date, 6, 2))
tmp2 = Val(Right(Date, 2))
If tmp1 < 10 Then tmp1 = "0" & Mid(tmp1, 1, 1)
If tmp2 < 10 Then tmp2 = "0" & Right(tmp2, 1)

T4.Text = Left(Date, 4) & "-" & tmp1 & "-" & tmp2
End Sub

Private Sub T4_GotFocus()
T4.BackColor = vbRed
T4.ForeColor = vbYellow

End Sub

Private Sub T4_LostFocus()
T4.BackColor = vbWhite
T4.ForeColor = vbBlack
tmp1 = Mid(T4, 6, 2)
tmp2 = Right(T4, 2)
If Left(tmp1, 1) = 0 Then Exit Sub
If tmp1 < 10 Then tmp1 = "0" & Mid(tmp1, 1, 1)
If tmp2 < 10 Then tmp2 = "0" & Right(tmp2, 1)
T4.Text = Left(Date, 4) & "-" & tmp1 & "-" & tmp2
End Sub

Private Sub treeview1_nodeclick(ByVal node As MSComctlLib.node)
'If myIndex > 1 Then Exit Sub
MyOpen rs, "select grade from program where keys='" & node.Key & "'"
If rs.EOF Then Exit Sub
setGrade(myIndex) = rs.Fields("grade")

MyOpen rs, "select * from program where grade like '" & setGrade(myIndex) & "_'"
If rs.EOF Then
    T1(myIndex).ForeColor = vbYellow
    T1(myIndex).BackColor = vbBlue
    If myIndex < 6 Then T1(myIndex).Text = node.FullPath
    Keys(myIndex) = Val(node.Key)
    
    
Else
    T1(myIndex).Text = ""
    'T1(2).ForeColor = vbBlue
    T1(myIndex).BackColor = vbBlack
End If


End Sub