frm_family.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_family 
   BackColor       =   &H80000000&
   Caption         =   "添加家庭成员"
   ClientHeight    =   4815
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   7935
   Icon            =   "frm_family.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4815
   ScaleWidth      =   7935
   StartUpPosition =   2  '屏幕中心
   Begin MSHierarchicalFlexGridLib.MSHFlexGrid MSHFlexGrid1 
      Height          =   2175
      Left            =   0
      TabIndex        =   11
      Top             =   0
      Width           =   7935
      _ExtentX        =   13996
      _ExtentY        =   3836
      _Version        =   393216
      BackColor       =   -2147483648
      RowHeightMin    =   5
      AllowUserResizing=   1
      BandDisplay     =   1
      _NumberOfBands  =   1
      _Band(0).Cols   =   2
      _Band(0).GridLinesBand=   1
      _Band(0).TextStyleBand=   0
      _Band(0).TextStyleHeader=   0
   End
   Begin VB.Frame Frame1 
      BackColor       =   &H0080FFFF&
      Height          =   2655
      Left            =   0
      TabIndex        =   0
      Top             =   2160
      Width           =   7935
      Begin VB.TextBox txt_key 
         Height          =   270
         Left            =   6240
         TabIndex        =   14
         Text            =   "Text4"
         Top             =   2160
         Visible         =   0   'False
         Width           =   735
      End
      Begin VB.CommandButton cmd_close 
         Caption         =   "关闭"
         Height          =   375
         Left            =   4680
         TabIndex        =   13
         Top             =   2040
         Width           =   735
      End
      Begin VB.CommandButton cmd_del 
         Caption         =   "删除"
         Height          =   375
         Left            =   3960
         TabIndex        =   12
         Top             =   2040
         Width           =   735
      End
      Begin VB.CommandButton cmd_edit 
         Caption         =   "修改"
         Height          =   375
         Left            =   3240
         TabIndex        =   9
         Top             =   2040
         Width           =   735
      End
      Begin VB.CommandButton cmd_add 
         Caption         =   "添加"
         Height          =   375
         Left            =   2520
         TabIndex        =   8
         Top             =   2040
         Width           =   735
      End
      Begin VB.TextBox Text3 
         Height          =   855
         Left            =   1200
         MultiLine       =   -1  'True
         ScrollBars      =   2  'Vertical
         TabIndex        =   7
         Top             =   960
         Width           =   6015
      End
      Begin MSComCtl2.DTPicker DTPicker1 
         Height          =   300
         Left            =   5880
         TabIndex        =   6
         Top             =   360
         Width           =   1350
         _ExtentX        =   2381
         _ExtentY        =   529
         _Version        =   393216
         Format          =   24772609
         CurrentDate     =   37821
      End
      Begin VB.TextBox Text2 
         Height          =   300
         Left            =   3480
         TabIndex        =   4
         Top             =   360
         Width           =   1230
      End
      Begin VB.TextBox Text1 
         Height          =   300
         Left            =   1200
         TabIndex        =   2
         Top             =   360
         Width           =   1230
      End
      Begin VB.Label Label4 
         BackStyle       =   0  'Transparent
         Caption         =   "座右铭:"
         Height          =   255
         Left            =   360
         TabIndex        =   10
         Top             =   960
         Width           =   735
      End
      Begin VB.Label Label3 
         BackStyle       =   0  'Transparent
         Caption         =   "生日:"
         Height          =   255
         Left            =   5160
         TabIndex        =   5
         Top             =   360
         Width           =   615
      End
      Begin VB.Label Label2 
         BackStyle       =   0  'Transparent
         Caption         =   "姓名:"
         Height          =   255
         Left            =   2880
         TabIndex        =   3
         Top             =   360
         Width           =   495
      End
      Begin VB.Label Label1 
         BackStyle       =   0  'Transparent
         Caption         =   "称呼:"
         Height          =   255
         Left            =   600
         TabIndex        =   1
         Top             =   360
         Width           =   495
      End
   End
End
Attribute VB_Name = "frm_family"
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 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(4) + 1
            A = MsgBox("是否添加前记录?", vbYesNo + 32, "修改记录")
            If A = vbYes Then
               ExeCutesql "insert into 成员 values('" & Text1.Text & "','" & Text2.Text & "','" & Format(DTPicker1.Value, "yyyy-mm-dd") & "','" & Text3.Text & "'," & B & ") ", Str_text
               Call Db
               Mydb.MoveLast
               MsgBox "数据已经保存！", vbOKOnly + 64, "成功"
            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_key.Text & "", Str_text
               'Mydb.Requery
               'If Mydb.EOF Then Mydb.MoveLast
               '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 称呼='" & Text1.Text & "',姓名='" & Text2.Text _
               & "',生日='" & DTPicker1.Value & "',格言='" & Text3.Text & "'where key=" & txt_key.Text & "", Str_text
               MsgBox "数据已经修改成功！", vbOKOnly + 64, "成功"
               Call Db
            End If
End Sub

Private Sub Form_Load()
            Call Db
            DTPicker1.Value = Date
End Sub
Private Function Db()
            Set Mydb = ExeCutesql("select * from 成员", Str_text)
            Set MSHFlexGrid1.DataSource = Mydb
End Function
Private Sub MSHFlexGrid1_Click()
            On Error Resume Next
       
            Text1.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 1)
            Text2.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 2)
            DTPicker1.Value = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 3)
            Text3.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 4)
            txt_key.Text = MSHFlexGrid1.TextMatrix(MSHFlexGrid1.Row, 5)
End Sub