frm_expend.frm

一个小型的家庭理财管理软件,能对日常的收支情况进行有效的管理.

VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{0ECD9B60-23AA-11D0-B351-00A0C9055D8E}#6.0#0"; "MSHFLXGD.OCX"
Begin VB.Form frm_expend 
   BackColor       =   &H00FFFFC0&
   Caption         =   "日常支出"
   ClientHeight    =   7350
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   9375
   Icon            =   "frm_expend.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   7350
   ScaleWidth      =   9375
   StartUpPosition =   2  '屏幕中心
   Begin VB.CommandButton cmd_close 
      Caption         =   "关闭"
      Height          =   375
      Left            =   5280
      TabIndex        =   11
      Top             =   6600
      Width           =   735
   End
   Begin VB.CommandButton cmd_del 
      Caption         =   "删除"
      Height          =   375
      Left            =   4560
      TabIndex        =   10
      Top             =   6600
      Width           =   735
   End
   Begin VB.CommandButton cmd_edit 
      Caption         =   "修改"
      Height          =   375
      Left            =   3840
      TabIndex        =   9
      Top             =   6600
      Width           =   735
   End
   Begin VB.CommandButton cmd_add 
      Caption         =   "添加"
      Height          =   375
      Left            =   3120
      TabIndex        =   8
      Top             =   6600
      Width           =   735
   End
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
      Height          =   3975
      Left            =   0
      TabIndex        =   20
      Top             =   0
      Width           =   9375
      _ExtentX        =   16536
      _ExtentY        =   7011
      _Version        =   393216
      AllowUserResizing=   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H00FFFFC0&
      Height          =   2295
      Left            =   0
      TabIndex        =   0
      Top             =   3960
      Width           =   9375
      Begin VB.TextBox txt_note 
         Height          =   270
         Left            =   7080
         TabIndex        =   21
         Text            =   "Text1"
         Top             =   960
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.TextBox txt_mome 
         Alignment       =   2  'Center
         Height          =   660
         Left            =   3600
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   7
         Top             =   1440
         Width           =   3015
      End
      Begin VB.TextBox txt_intake 
         Height          =   300
         Left            =   3600
         TabIndex        =   5
         Top             =   840
         Width           =   3015
      End
      Begin VB.ComboBox Combo3 
         Height          =   300
         Left            =   840
         TabIndex        =   6
         Top             =   1440
         Width           =   1815
      End
      Begin VB.ComboBox Combo2 
         Height          =   300
         Left            =   840
         TabIndex        =   4
         Top             =   840
         Width           =   1815
      End
      Begin VB.TextBox txt_money 
         Height          =   300
         Left            =   7080
         TabIndex        =   3
         Top             =   240
         Width           =   1215
      End
      Begin VB.ComboBox Combo1 
         Height          =   300
         ItemData        =   "frm_expend.frx":030A
         Left            =   3600
         List            =   "frm_expend.frx":0311
         TabIndex        =   2
         Top             =   240
         Width           =   1695
      End
      Begin MSComCtl2.DTPicker DTPicker1 
         Height          =   300
         Left            =   840
         TabIndex        =   1
         Top             =   240
         Width           =   1815
         _ExtentX        =   3201
         _ExtentY        =   529
         _Version        =   393216
         Format          =   24772609
         CurrentDate     =   37817
      End
      Begin VB.Label Label8 
         BackStyle       =   0  'Transparent
         Caption         =   "元"
         Height          =   255
         Left            =   8520
         TabIndex        =   19
         Top             =   240
         Width           =   375
      End
      Begin VB.Label Label7 
         BackStyle       =   0  'Transparent
         Caption         =   "备注："
         Height          =   375
         Left            =   3000
         TabIndex        =   18
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label6 
         BackStyle       =   0  'Transparent
         Caption         =   "人员："
         Height          =   375
         Left            =   240
         TabIndex        =   17
         Top             =   1440
         Width           =   615
      End
      Begin VB.Label Label5 
         BackStyle       =   0  'Transparent
         Caption         =   "去向："
         Height          =   255
         Left            =   3000
         TabIndex        =   16
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "项目："
         Height          =   375
         Left            =   240
         TabIndex        =   15
         Top             =   840
         Width           =   615
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "金额："
         Height          =   375
         Left            =   6480
         TabIndex        =   14
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "方式："
         Height          =   255
         Left            =   3000
         TabIndex        =   13
         Top             =   240
         Width           =   615
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "日期："
         Height          =   375
         Left            =   240
         TabIndex        =   12
         Top             =   240
         Width           =   615
      End
   End
End
Attribute VB_Name = "frm_expend"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim Mydb As New ADODB.Recordset
Dim Mydb1 As New ADODB.Recordset
Dim Mydb2 As New ADODB.Recordset
Dim Count1 As New ADODB.Recordset
Dim Str_text As String
Private Sub cmd_add_Click()
            On Error Resume Next
            Dim A, B
            
            B = 1
            Set Count1 = ExeCutesql("select * from 支出", Str_text)
            Count1.MoveLast
            B = Count1.Fields(7) + 1
            A = MsgBox("是否添加前记录？", vbYesNo + 32, "添加记录")
            If A = vbYes Then
               If txt_intake.Text = "" Then
                  MsgBox "请填写去向！", vbOKOnly + 32, "注意！"
               Else
                  ExeCutesql "insert into 支出 values('" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" _
                  & Combo1.Text & "','" & txt_money.Text & "','" & Combo2.Text & "','" & txt_intake.Text _
                  & "','" & Combo3.Text & "','" & txt_mome.Text & "','" & B & "')", Str_text
                  MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
                  Call Xiangmu
                  Call Db
               End If
            End If
            
End Sub
Private Sub cmd_close_Click()
            Unload Me
End Sub
Private Sub cmd_del_Click()
            On Error Resume Next
            Dim A
            
            A = MsgBox("是否删除当前记录？", vbYesNo + 32 + 256, "添加记录")
            If A = vbYes Then
               ExeCutesql "DELETE from 支出 where key=" & txt_note.Text & "", Str_text
               Call Db
               Set Mydb = ExeCutesql("select * from  支出 ", Str_text)
               Set MSHFlexGrid1.DataSource = Mydb
            End If
End Sub
Private Sub cmd_edit_Click()
            On Error Resume Next
            Dim A
            
            A = MsgBox("是否修改前记录？", vbYesNo + 32, "添加记录")
            If A = vbYes Then
               ExeCutesql "Update 支出  Set 日期 = '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "',方式='" & Combo1.Text & "',金额=" & txt_money.Text & ", 去向='" & txt_intake.Text & "',人员='" & Combo3.Text & "',备注='" & txt_mome.Text & "' Where key = " & txt_note.Text & "  ", Str_text
               'Mydb.Requery
               Call Db
               MsgBox "数据修改成功！", vbOKOnly + 64, "成功"
            End If
              
End Sub
Private Sub Combo2_Change()
            Call Db1
End Sub
Private Sub Combo3_Change()
            Call Db2
End Sub
Private Sub Form_Load()
            Call Db
            Call Db1
            Call Db2
            DTPicker1.Value = Date
           ' Combo3.Locked = True
           ' Combo1.Locked = True
End Sub
Public Function Db()
       
       Set Mydb = ExeCutesql("select * from  支出 order by key", Str_text)
       Set MSHFlexGrid1.DataSource = Mydb
End Function
Public Function Db1()
       On Error Resume Next
       Dim A As Integer
       
       Set Mydb1 = ExeCutesql("select * from  支出项目 ", Str_text)
       A = Mydb1.RecordCount
       Set Combo2.DataSource = Mydb1
           For I = 1 To A
               Combo2.AddItem Mydb1.Fields(0)
               Mydb1.MoveNext
               If Mydb1.EOF Then Exit For
           Next I
End Function
Public Function Db2()
       On Error Resume Next
       Dim A As Integer
       
        Set Mydb2 = ExeCutesql("select * from 成员", Str_text)
        A = Mydb2.RecordCount
        Set Combo3.DataSource = Mydb2
            For I = 1 To A
                Combo3.AddItem Mydb2.Fields(0)
                Mydb2.MoveNext
                If Mydb2.EOF Then Exit For
           Next I
        Combo3.AddItem "全家"
End Function


Private Sub Form_Unload(Cancel As Integer)
            'Mydb.Close
            'Mydb1.Close
            'Mydb2.Close
End Sub

Private Sub MSHFlexGrid1_Click()
            On Error Resume Next
            DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1)
            Combo1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2)
            txt_money.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3)
            Combo2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4)
            txt_intake.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
            Combo3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 6)
            txt_mome.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 7)
            txt_note.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 8)
End Sub
           
Private Sub txt_money_LostFocus()
            Dim A As Boolean
            Dim C
            
            C = txt_money.Text
            A = IsNumeric(C)
            
            If C = "" Then
               MsgBox "请输入金额！", vbOKOnly + 32, "注意！"
               txt_money.SetFocus
            Else
               If A = False Then
                  MsgBox "金额只能输入数字！", vbOKOnly + 32, "注意！"
                  txt_money.SetFocus
               End If
            End If
End Sub
Private Function Xiangmu()
                 Dim A
                 Dim Str_text As String
                 Dim Db As New ADODB.Recordset
                 
                 Str_text = Combo2.Text
                 Set Db = ExeCutesql("select * from 支出项目 where value='" & Str_text & "'", "")
                 'MsgBox
                 If Not Str_text = Db.Fields(0) Then
                    ExeCutesql "insert into 支出项目 values('" & Str_text & "')", ""
                 End If
End Function
Private Function Renyuan()
                 'Dim A
                 'Dim Str_text As String
                 'Dim Db As New ADODB.Recordset
                 
                 'Str_text = Combo3.Text
                 'Set Db = ExeCutesql("select * from 成员 where value='" & Str_text & "'", "")
                 'MsgBox
                 'If Not Str_text = Db.Fields(0) Then
                 '   ExeCutesql "insert into 成员 values('" & Str_text & "')", ""
                 'End If

End Function