个人收支管理程序.doc

F1 Dim n As Integer, j As String: Public mm As String Private Sub cmdOK_Click() Select Case txtmima.Text Case mm Form1.Hide: Form2.Show Case Is mm i = MsgBox(密码错误，重试, 16, 错误) n = n + 1 End Select If n = 3 Then Unload Form1 End IfEnd SubPrivate Sub cmdNo_Click() End End SubPrivate Sub Form_Load() If Dir(balance.past) = Then Exit Sub Else: Dim b As Long Open App.Path & balance.pas For Binary As #1 Get #1, 1, b Close mm = b End IfEnd SubF2Private Sub cmdBill_Click()Form2.Hide: Form4.ShowEnd SubPrivate Sub cmdCount_Click()Form2.Hide: Form5.ShowEnd SubPrivate Sub cmdSet_Click()Form2.Hide: Form3.ShowEnd SubPrivate Sub cmdOut_Click()EndEnd SubF3Private Sub cmdAdd1_Click()Dim NamIn As String, n As Integer: NamIn = txtIn.Text If NamIn = Then Exit Sub For n = 0 To lstIn.ListCount - 1 If NamIn = lstIn.List(n) Then Exit Sub End If Next lstIn.AddItem NamIn NamIn = End SubPrivate Sub cmdAdd2_Click()Dim NamOut As String, n As Integer: NamOut = txtOut.Text If NamOut = Then Exit Sub For n = 0 To lstOut.ListCount - 1 If NamOut = lstOut.List(n) Then Exit Sub End If Next lstOut.AddItem NamOut NamOut = End SubPrivate Sub cmdChange1_Click() lstIn.List(lstIn.ListIndex) = txtIn.Text lstIn.ListIndex = -1 txtIn.Text = End SubPrivate Sub cmdChange2_Click() lstOut.List(lstOut.ListIndex) = txtOut.Text lstOut.ListIndex = -1 txtOut.Text = End SubPrivate Sub cmdClear1_Click()If lstIn.ListIndex -1 Then lstIn.RemoveItem lstIn.ListIndex txtIn.Text = Else: Exit SubEnd IfEnd SubPrivate Sub cmdClear2_Click()If lstOut.ListIndex -1 Then lstOut.RemoveItem lstOut.ListIndex txtOut.Text = Else: Exit SubEnd IfEnd SubPrivate Sub cmdQuit1_Click() txtIn.Text = End SubPrivate Sub cmdQuit2_Click() txtOut.Text = End SubPrivate Sub cmdReturn1_Click()Unload Form3: Form2.ShowEnd SubPrivate Sub cmdReturn2_Click()Unload Form3: Form2.ShowEnd SubPrivate Sub Command14_Click()txtxinmima1.Text = : txtxinmima2.Text = End SubPrivate Sub Command15_Click()Form2.Show: Form3.HideEnd SubPrivate Sub Command13_Click()If IsNumeric(txtxinmima1.Text) = False Then i = MsgBox(密码应为数字, 16, 注意) ElseIf Len(txtxinmima1.Text) 8 Then i = MsgBox(注意密码位数, 16, 注意) ElseIf IsNumeric(txtxinmima1.Text) = True Then If txtxinmima2.Text = txtxinmima1.Text Then Dim b As Long: b = txtxinmima1.Text Open App.Path & balance.pas For Binary As #1 Put #1, 1, b Close i = MsgBox(修改成功, 64, ) Else: i = MsgBox(密码不一致，请重新输入！, 16, 注意) End IfEnd IfEnd SubPrivate Sub Command2_Click()Unload Form3: Form2.ShowEnd SubPrivate Sub Form_Unload(Cancel As Integer)Dim i As Integer Open App.Path & Inputtype.TXT For Output As #1 For i = 0 To lstIn.ListCount - 1 Write #1, lstIn.List(i) Next Open App.Path & Outputtype.TXT For Output As #2 For i = 0 To lstOut.ListCount - 1 Write #2, lstOut.List(i) Next Close #1, #2End SubPrivate Sub lstIn_Click()If lstIn.ListIndex -1 Then txtIn.Text = lstIn.List(lstIn.ListIndex)Else: Exit SubEnd IfEnd SubPrivate Sub lstOut_Click()If lstOut.ListIndex -1 Then txtOut.Text = lstOut.List(lstOut.ListIndex)Else: Exit SubEnd IfEnd SubF4Private Sub cmdClear1_Click()txtNumin.Text = : txtBeizhuIn.Text = : cboIn.Text = End SubPrivate Sub cmdClear2_Click()txtNumOut.Text = : txtBeizhuOut = : cboOut.Text = End SubPrivate Sub cmdKeep_Click()i = MsgBox(核对无误，确认保存, 32, 注意)lstInBill.AddItem DTPIn.Value & Space(5) & cboIn.Text & Space(12) & txtNumin.Text & Space(10) & txtBeizhuInOpen App.Path & Balance.TXT For Append As #2 Print #2, 1; DTPIn.Value, cboIn.Text, txtNumin.Text, txtBeizhuIn Close 2 lstInBill.List(lstInBill.ListCount - 1) = lstInBill.List(lstInBill.NewIndex) End SubPrivate Sub cmdKeep2_Click()i = MsgBox(核对无误，确认保存, 32, 注意)lstOutBill.AddItem DTPout.Value & Space(5) & cboOut.Text & Space(8) & txtNumOut.Text & Space(10) & txtBeizhuOutOpen App.Path & Balance.TXT For Append As #3 Print #3, 0; DTPout.Value, cboOut.Text, txtNumOut.Text, txtBeizhuOut Close 3 lstOutBill.List(lstOutBill.ListCount - 1) = lstOutBill.List(lstOutBill.NewIndex)End SubPrivate Sub cmdReturn3_Click()Form4.Hide: Form2.ShowEnd SubPrivate Sub Form_Load()lstInBill.Text = : lstOutBill.Text = Dim a() As String Dim i As Integer Open App.Path & Inputtype.TXT For Input As #1 Do While Not EOF(1) i = i + 1ReDim Preserve a(1 To i) Input #1, a(i) cboIn.AddItem a(i) Loop Open App.Path & Outputtype.TXT For Input As #2 Do While Not EOF(2) i = i + 1ReDim Preserve a(1 To i) Input #2, a(i) cboOut.AddItem a(i)Loop Close #2, #1End SubPrivate Sub Form_Unload(Cancel As Integer)txtNumin.Text = : txtBeizhuIn = : cboIn.Text = : lstInBill.CleartxtNumOut.Text = : txtBeizhuOut = : cboOut.Text = : lstOutBill.ClearEnd SubF5Private Sub cmdNo_Click()optTime.Value = False: optKind.Value = False: cbokind1.Text = Frame2.Caption = 按类型查询: Label1.Visible = True: Label2.Visible = TrueDTPIn1.Visible = True: DTPIn2.Visible = TrueLabel3.Visible = True: cbokind1.Visible = TrueEnd SubPrivate Sub cmdNo2_Click()optTime2.Value = False: optKind2.Value = False: cboKind2.Text = Frame4.Caption = 按时间查询: Label5.Visible = True: cboKind2.Visible = True Label6.Visible = True: Label7.Visible = TrueDTPOut1.Visible = True: DTPOut2.Visible = TrueEnd SubPrivate Sub cmdOK_Click()Dim y As Single, z As SingleDim a() As String: Dim i As Integer Open App.Path & Balance.txt For Input As #5 Do While Not EOF(5) i = i + 1 ReDim Preserve a(1 To i) Input #5, a(i) If CDate(Mid(a(i), 3, 10) = DTPDuiB1.Value And CDate(Mid(a(i), 3, 10) = DTPIn1.Value And CDate(Mid(a(i), 3, 10) = DTPOut1.Value And CDate(Mid(a(i), 3, 10) = DTPOut2.Value Then lstOut.AddItem Mid(a(i), 3) x = Val(Mid(a(i), 27, 13) y = y + x End If End If Loop Close 4 lblOut.Caption = 从 & DTPOut1.Value & 到 & DTPOut2.Value & 共计支出 & y & 元ElseIf optKind2.Value = True Then Open App.Path & Balance.txt For Input As #4 Do While Not EOF(4) i = i + 1 ReDim Preserve a(1 To i) Input #4, a(i) If Trim(Mid(a(i), 13, 14) = cboKind2.Text Then If Mid(a(i), 1, 1) = 0 Then lstOut.AddItem Mid(a(i), 3) x = Val(Mid(a(i), 27, 13) y = y + x End If End If Loop Close 4lblOut.Caption = cboKind2.Text & 支出总计 & y & 元End IfEnd SubPrivate Sub Form_Load()Dim a() As String Dim i As Integer Open App.Path & Inputtype.TXT For Input As #1 Do While Not EOF(1) i = i + 1ReDim Preserve a(1 To i) Input #1, a(i) cbokind1.AddItem a(i) Loop Open App.Path & Outputtype.TXT For Input As #2 Do While Not EOF(2) i = i + 1ReDim Preserve a(1 To i) Input #2, a(i) cboKind2.AddItem a(i)Loop Close #2, #1 End SubPrivate Sub optKind_Click()Frame2.Caption = 按类型查询收入: Label1.Visible = False: Label2.