frm_expend.frm
资源名称:jtlc.rar [点击查看]
上传用户:xxdyjx888
上传日期:2022-06-01
资源大小:55k
文件大小:13k
源码类别:
家庭/个人应用
开发平台:
Visual Basic
- 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
- 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 'CenterScreen
- 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
- 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 = 67239937
- 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