frmsetekm.frm

这是一个实用的家庭收支管理系统源代码

VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmSetekm 
   Caption         =   "设置支出项"
   ClientHeight    =   4695
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   6315
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4695
   ScaleWidth      =   6315
   StartUpPosition =   2  'CenterScreen
   Begin VB.CommandButton Comm2 
      Caption         =   "删除当前项"
      Height          =   495
      Left            =   4200
      TabIndex        =   7
      Top             =   1920
      Width           =   1455
   End
   Begin VB.CommandButton Comm3 
      Caption         =   "保存"
      Height          =   495
      Left            =   4200
      TabIndex        =   6
      Top             =   2640
      Width           =   1455
   End
   Begin VB.CommandButton retCom 
      Caption         =   "返回"
      Height          =   495
      Left            =   4200
      TabIndex        =   5
      Top             =   3360
      Width           =   1455
   End
   Begin VB.Frame Frame1 
      Caption         =   "设置支出子项"
      Height          =   1455
      Left            =   3600
      TabIndex        =   2
      Top             =   120
      Width           =   2535
      Begin VB.TextBox Text1 
         Height          =   375
         Left            =   120
         TabIndex        =   4
         Top             =   360
         Width           =   2295
      End
      Begin VB.CommandButton Comm1 
         Caption         =   "确定"
         Height          =   495
         Left            =   600
         TabIndex        =   3
         Top             =   840
         Width           =   1455
      End
   End
   Begin VB.TextBox Text2 
      Appearance      =   0  'Flat
      BackColor       =   &H80000004&
      BorderStyle     =   0  'None
      Height          =   1095
      Left            =   0
      MultiLine       =   -1  'True
      TabIndex        =   1
      Text            =   "frmSetekm.frx":0000
      Top             =   3360
      Width           =   3255
   End
   Begin MSComctlLib.TreeView TreeView1 
      Height          =   3255
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   3255
      _ExtentX        =   5741
      _ExtentY        =   5741
      _Version        =   393217
      LabelEdit       =   1
      Style           =   7
      Appearance      =   1
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   3360
      Top             =   2040
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   15
      ImageHeight     =   15
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   1
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "frmSetekm.frx":004F
            Key             =   ""
         EndProperty
      EndProperty
   End
End
Attribute VB_Name = "frmSetekm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim RS As ADODB.Recordset
Dim sqltxt As String
Dim curNode As Node
Dim sel As Boolean    '表示是否从TreeView中选择了一个节点

Private Sub Comm1_Click()
    If Trim(Text1.Text) = "" Then
     MsgBox "子项为空，不能进行设置!", vbOKOnly, "信息提示"
  Else
     For i = 1 To TreeView1.Nodes.Count
         If Trim(TreeView1.Nodes(i).Text) = Trim(Text1.Text) Then
            MsgBox "输入重复的支出项目，不能添加！", vbOKOnly, "信息提示"
            Exit Sub
         End If
     Next i
     If curNode.Image = 4 Then
        MsgBox "支出子项设置不能超过4级！", vbOKOnly, "信息提示"
     Else
        TreeView1.Nodes.Add curNode.Key, 4, "K" & Trim(Text1.Text), Trim(Text1.Text), curNode.Image + 1
     End If
     
     Text1.Text = ""
  End If
End Sub

Private Sub Comm2_Click()
   If sel = False Then
     MsgBox "没有选择任何支出项，不能删除！", vbOKOnly, "信息提示"
  Else
     If curNode.Index = 1 Then
        MsgBox "根节点不能删除！", vbOKOnly, "信息提示"
     Else
        If MsgBox("真的要删除[" + curNode.Text + "]项吗？", vbYesNo, _
           "删除确认") = vbYes Then
            TreeView1.Nodes.Remove curNode.Index
            sel = False
            Frame1.Caption = ""
        End If
      End If
  End If
End Sub

Private Sub Comm3_Click()
  Dim sqltxt As String
  sqltxt = "delete expense"   '删除income中原有的记录
  Set conn = New ADODB.Connection
  conn.ConnectionString = "DSN=FAM;UID=admin;PWD=;"
  conn.Open
  conn.Execute sqltxt
  conn.Close
  sqltxt = "select * from expense"
  Set RS = exesql(sqltxt)
  For i = 2 To TreeView1.Nodes.Count
      RS.AddNew
      RS.Fields("父级别") = TreeView1.Nodes(i).Parent.Image
      RS.Fields("父科目") = TreeView1.Nodes(i).Parent.Text
      RS.Fields("子科目") = TreeView1.Nodes(i).Text
      RS.Fields("级别") = TreeView1.Nodes(i).Image
  Next i
  RS.UpdateBatch
  RS.Close
End Sub

Private Sub Form_Load()
     Dim node1 As Node
  TreeView1.LineStyle = 1
  TreeView1.Style = 7
  TreeView1.ImageList = ImageList1
  sel = True
  sqltxt = "select * from expense"
  Set RS = exesql(sqltxt)
  TreeView1.Nodes.Clear
  If RS.RecordCount = 0 Then    '在TreeView中添加一个根节点
     TreeView1.Nodes.Add , , "K总支出", "总支出", 1 '添加根节点
     Set curNode = TreeView1.Nodes(1)
   Else
     TreeView1.Nodes.Add , , "K" + Trim(RS.Fields("父科目")), _
     Trim(RS.Fields("父科目")), 1    '添加根节点
     Set curNode = TreeView1.Nodes(1)
     RS.MoveFirst
     
     Do While Not RS.EOF
        Set node1 = TreeView1.Nodes.Add("K" + Trim(RS.Fields("父科目")), 4, _
        "K" + Trim(RS.Fields("子科目")), Trim(RS.Fields("子科目")))
      node1.Image = node1.Parent.Image + 1
      RS.MoveNext
     Loop
     TreeView1.Refresh
    End If
    RS.Close
    
End Sub

Private Sub retCom_Click()
  Unload Me
End Sub

Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
  Set curNode = Node
  Frame1.Caption = "设置[" + Trim(curNode.Text) + "]的子项"
  sel = True
End Sub