frmaddnew.vb

对家庭的开支有一个全面的了解和统计

		Me.labmoney.Cursor = System.Windows.Forms.Cursors.Default
		Me.labmoney.RightToLeft = System.Windows.Forms.RightToLeft.No
		Me.labmoney.UseMnemonic = True
		Me.labmoney.Visible = True
		Me.labmoney.AutoSize = False
		Me.labmoney.BorderStyle = System.Windows.Forms.BorderStyle.None
		Me.labmoney.Name = "labmoney"
		Me.Controls.Add(Command1)
		Me.Controls.Add(cbo_xkind)
		Me.Controls.Add(cmdexit)
		Me.Controls.Add(cmdcancel)
		Me.Controls.Add(cmdok)
		Me.Controls.Add(txt_order)
		Me.Controls.Add(txt_money)
		Me.Controls.Add(cbo_usename)
		Me.Controls.Add(cbo_kind)
		Me.Controls.Add(DTPicker_date)
		Me.Controls.Add(Label3)
		Me.Controls.Add(Label2)
		Me.Controls.Add(Label1)
		Me.Controls.Add(laborder)
		Me.Controls.Add(labdate)
		Me.Controls.Add(ladusename)
		Me.Controls.Add(labkind)
		Me.Controls.Add(labmoney)
		CType(Me.DTPicker_date, System.ComponentModel.ISupportInitialize).EndInit()
	End Sub
#End Region 
#Region "升级支持"
	Private Shared m_vb6FormDefInstance As frmaddnew
	Private Shared m_InitializingDefInstance As Boolean
	Public Shared Property DefInstance() As frmaddnew
		Get
			If m_vb6FormDefInstance Is Nothing OrElse m_vb6FormDefInstance.IsDisposed Then
				m_InitializingDefInstance = True
				m_vb6FormDefInstance = New frmaddnew()
				m_InitializingDefInstance = False
			End If
			DefInstance = m_vb6FormDefInstance
		End Get
		Set
			m_vb6FormDefInstance = Value
		End Set
	End Property
#End Region 
	Dim db As DAO.Database
	Dim rs As DAO.Recordset
	Dim neworder As String
	Dim newdate As Date
	Dim newusename As String
	Dim newkind As String
	Dim newxkind As String
	Dim newmoney As Decimal
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 cbo_kind.SelectedIndexChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub cbo_kind_SelectedIndexChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cbo_kind.SelectedIndexChanged
		Dim sql As String
		Dim xkrs As DAO.Recordset
		sql = "select xkind_name from xkind where dkind_name ='" & Trim(cbo_kind.Text) & "'"
		xkrs = db.OpenRecordset(sql)
		cbo_xkind.Items.Clear()
		If Not xkrs.EOF Then
			xkrs.MoveFirst()
			Do Until xkrs.EOF
				cbo_xkind.Items.Add(Trim(xkrs.Fields("xkind_name").Value))
				xkrs.MoveNext()
			Loop 
		Else
			MsgBox("数据库中没有小类别数据,请在添加!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "设置小类别")
		End If
		cbo_xkind.SelectedIndex = 0
	End Sub
	
	Private Sub cbo_kind_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles cbo_kind.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub cbo_usename_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles cbo_usename.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub cmdcancel_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdcancel.Click
		txt_order.Text = ""
		'DTPicker_date.Value = "date$(now)"
		cbo_usename.Text = ""
		cbo_kind.Text = ""
		txt_money.Text = ""
		cmdexit.Focus()
	End Sub
	
	Private Sub cmdexit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdexit.Click
		Me.Close()
		frmmain.DefInstance.Show()
	End Sub
	
	Private Sub cmdok_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdok.Click
		'判断各输入框的内容是否为空
		If Trim(txt_order.Text) = "" Then
			MsgBox("开支编号不能为空,请输入开支编号!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			txt_order.Focus()
			Exit Sub
		End If
		
		If Trim(DTPicker_date.Value) = "" Then
			MsgBox("开支日期不能为空,请选择开支日期!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			DTPicker_date.Focus()
			Exit Sub
		End If
		
		If Trim(cbo_usename.Text) = "" Then
			MsgBox("开支人不能为空,请选择开支人!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			cbo_usename.Focus()
			Exit Sub
		End If
		
		If Trim(cbo_kind.Text) = "" Then
			MsgBox("开支大类别不能为空,请选择开支类别!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			cbo_kind.Focus()
			Exit Sub
		End If
		
		If Trim(cbo_xkind.Text) = "" Then
			MsgBox("开支小类别不能为空,请选择开支类别!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			cbo_xkind.Focus()
			Exit Sub
		End If
		
		
		If Trim(txt_money.Text) = "" Then
			MsgBox("开支金额不能为空,请输入开支金额!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			txt_money.Focus()
			Exit Sub
		End If
		
		
		'判断开支编号是否输入数字.
		If Not IsNumeric(Trim(txt_order.Text)) Then
			MsgBox("请输入数字,开支编号要是数字!", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			txt_order.Focus()
			txt_order.Text = ""
			Exit Sub
		End If
		'检查有没有重复的记录
		Dim db1 As DAO.Database
		Dim rst1 As DAO.Recordset
		Dim sql As String
		db1 = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		sql = "select * from payout where pay_order=" & (txt_order.Text)
		rst1 = db.OpenRecordset(sql)
		
		If rst1.EOF = False Then
			MsgBox("开支编号重复,请重新输入", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			rst1.Close()
			txt_order.Focus()
			txt_order.Text = ""
			Exit Sub
		Else
			rst1.Close()
			'添加记录
			neworder = Trim(txt_order.Text)
			newdate = CDate(Trim(DTPicker_date.Value))
			newusename = Trim(cbo_usename.Text)
			newkind = Trim(cbo_kind.Text)
			newxkind = Trim(cbo_xkind.Text)
			newmoney = CDec(Trim(txt_money.Text))
			
			With rs
				.AddNew()
				.Fields("pay_order").Value = CInt(neworder)
				.Fields("pay_date").Value = newdate
				.Fields("pay_usename").Value = newusename
				.Fields("pay_kind").Value = newkind
				.Fields("payx_kind").Value = newxkind
				.Fields("pay_money").Value = newmoney
				.Update()
			End With
		End If
		MsgBox("你已经成功地把一条新记录加到数据库中了。", MsgBoxStyle.Information + MsgBoxStyle.OKOnly, "成功增加新记录")
		txt_order.Text = ""
		'DTPicker_date.Value = Date
		'cbo_usename.Text = ""
		'cbo_kind.Text = ""
		cbo_xkind.Text = ""
		txt_money.Text = ""
		cbo_kind.Focus()
		
		
		
		' 判断现在是几月，来决定开支编号中月份的写法
		Dim yue As String
		If Month(Today) >= 10 Then
			yue = CStr(Month(Today))
		Else
			yue = "0" & Month(Today)
		End If
		
		
		' 判断数据库中该月的开支条数，来决定开支编号中开支编号部分的写法
		
		Dim kzsql As String
		Dim kzrst As DAO.Recordset
		Dim b As Short
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rs.Index = ("pay_order")
		kzsql = "select * from  payout where pay_date >= " & "#" & Year(CDate(DateString)) & "-" & Month(CDate(DateString)) & "-" & "01" & " #"
		'sql1 = "select * from payout where pay_date " & ">=" & "#" & Year(Date) & "-" & Month(Date$) & "-" & "01" & "#"
		kzrst = db.OpenRecordset(kzsql)
		b = kzrst.RecordCount
		
		If Len(b) >= 4 Then
			txt_order.Text = Year(Now) & yue & (b + 1)
		ElseIf Len(b) = 3 Then 
			txt_order.Text = Year(Now) & yue & "0" & (b + 1)
		ElseIf Len(b) = 2 Then 
			txt_order.Text = Year(Now) & yue & "00" & (b + 1)
		Else
			MsgBox("当月没有开支记录,请输入新的开支记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
		End If
		
		
		
		
		Dim dbs As DAO.Database
		Dim xrs As DAO.Recordset
		dbs = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		'sql = "select * from payout where  pay_date >= #2003-12-1# "
		' sql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
		'  Set xrs = dbs.OpenRecordset(sql)
		' xrs.MoveLast
		
		' If xrs.RecordCount = 0 Then
		'     MsgBox "按你所指定的条件查询没有记录,请重新设置条件查询!", vbOKOnly + vbInformation, "查询没有记录"
		'      Exit Sub
		'   End If
		'txt_order.Text = Year(Date$) & Month(Date$) & (0) & (xrs.RecordCount + 1)
		Label1.Text = "数据库中已有：" & (rs.RecordCount) & "条记录。"
	End Sub
	
	Private Sub cmdok_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles cmdok.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		Dim rcord As DAO.Recordset
		Dim kzsql As String
		Dim dbx As DAO.Database
		kzsql = "select * from  payout where pay_date >= " & "#" & Year(CDate(DateString)) & "-" & Month(CDate(DateString)) & "-" & "01" & " #"
		dbx = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rcord = db.OpenRecordset(kzsql)
		Label3.Text = CStr(rcord.RecordCount)
		
	End Sub
	
	Private Sub DTPicker_date_KeyDownEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMSComCtl2.DDTPickerEvents_KeyDownEvent) Handles DTPicker_date.KeyDownEvent
		If eventArgs.KeyCode = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmaddnew.Activate 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmaddnew_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
		Dim dkrs As DAO.Recordset
		dkrs = db.OpenRecordset("dkind")
		If Not dkrs.EOF Then
			dkrs.MoveFirst()
			Do Until dkrs.EOF
				cbo_kind.Items.Add(Trim(dkrs.Fields("dkind_name").Value))
				dkrs.MoveNext()
			Loop 
		Else
			MsgBox("数据库中没有大类别数据,请在添加!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "设置大类别")
		End If
	End Sub
	
	Private Sub frmaddnew_Load(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Load
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rs = db.OpenRecordset("payout")
		DTPicker_date.Value = Today
		
		' 判断现在是几月，来决定开支编号中月份的写法
		Dim yue As String
		If Month(Today) >= 10 Then
			yue = CStr(Month(Today))
		Else
			yue = "0" & Month(Today)
		End If
		
		
		' 判断数据库中该月的开支条数，来决定开支编号中开支编号部分的写法
		
		Dim kzsql As String
		Dim kzrst As DAO.Recordset
		Dim b As Short
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		'Set rs = db.OpenRecordset("payout")
		'rs.Index = ("pay_order")
		'kzsql = "select * from payout where pay_order >=" & Year(Date$) & yue & "001"
		kzsql = "select * from  payout where pay_date >= " & "#" & Year(CDate(DateString)) & "-" & Month(CDate(DateString)) & "-" & "01" & " #"
		kzrst = db.OpenRecordset(kzsql)
		b = kzrst.RecordCount
		
		If Len(b) >= 4 Then
			txt_order.Text = Year(Now) & yue & (b + 1)
		ElseIf Len(b) = 3 Then 
			txt_order.Text = Year(Now) & yue & "0" & (b + 1)
		ElseIf Len(b) = 2 Then 
			txt_order.Text = Year(Now) & yue & "00" & (b + 1)
		Else
			MsgBox("当月没有开支记录,请输入新的开支记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
		End If
		
	End Sub
	
	
	'UPGRADE_WARNING: Form 事件 frmaddnew.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmaddnew_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		frmmain.DefInstance.Show()
	End Sub
	
	Private Sub txt_money_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txt_money.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
	
	Private Sub txt_order_KeyPress(ByVal eventSender As System.Object, ByVal eventArgs As System.Windows.Forms.KeyPressEventArgs) Handles txt_order.KeyPress
		Dim KeyAscii As Short = Asc(eventArgs.KeyChar)
		If KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
		If KeyAscii = 0 Then
			eventArgs.Handled = True
		End If
	End Sub
End Class