⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmqu_de.vb

📁 对家庭的开支有一个全面的了解和统计
💻 VB
📖 第 1 页 / 共 3 页
字号:
		
		
		
	End Sub
	
	Private Sub cmdnext_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdnext.Click
		On Error Resume Next
		rs.MoveNext()
		If rs.EOF Then
			MsgBox("已经在数据库最后一条记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			rs.MoveLast()
		End If
		Call viewdata()
	End Sub
	
	Private Sub cmdok_Click()
		
	End Sub
	
	Private Sub cmdprevious_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdprevious.Click
		On Error Resume Next
		rs.MovePrevious()
		If rs.BOF Then
			MsgBox("已经在数据库第一条记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			rs.MoveFirst()
		End If
		Call viewdata()
	End Sub
	
	Private Sub cmdsave_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdsave.Click
		
		
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rs = db.OpenRecordset("payout")
		
		'判断各输入框的内容是否为空
		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 k As Boolean
		
		If Trim(txt_order.Text) <> txtchange Then
			k = True
		Else
			k = False
		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)
		
		Dim sql2 As String
		If k = True And rst1.EOF = False Then
			MsgBox("开支编号重复,请重新输入", MsgBoxStyle.OKOnly + MsgBoxStyle.Exclamation, "警告")
			rst1.Close()
			txt_order.Focus()
			'使各按钮有效
			cmdfirst.Enabled = True
			cmdlast.Enabled = True
			cmdnext.Enabled = True
			cmdprevious.Enabled = True
			cmddelete.Enabled = True
			rs.Index = "pay_order"
			'使各文本框无效
			txt_order.ReadOnly = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_usename.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_kind.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_xkind.Locked = True
			txt_money.ReadOnly = True
			DTPicker_date.Enabled = False
			Exit Sub
			'使保存按钮无效
			cmdsave.Enabled = False
			
		ElseIf k = True And rst1.EOF = True Then 
			
			
			
			db1 = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
			sql2 = "delete * from payout where pay_order = " & txtchange
			db1.Execute((sql2))
			
			With rs
				.AddNew()
				.Fields("pay_order").Value = txt_order.Text
				'UPGRADE_WARNING: 未能解析对象 DTPicker_date.Value 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				.Fields("pay_date").Value = DTPicker_date.Value
				.Fields("pay_usename").Value = cbo_usename.Text
				.Fields("pay_kind").Value = cbo_kind.Text
				.Fields("payx_kind").Value = cbo_xkind.Text
				.Fields("pay_money").Value = Trim(txt_money.Text)
				.Update()
			End With
			rs.Index = "pay_order"
			
			MsgBox("你已经成功的修改了记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			'使各按钮有效
			cmdfirst.Enabled = True
			cmdlast.Enabled = True
			cmdnext.Enabled = True
			cmdprevious.Enabled = True
			cmddelete.Enabled = True
			'使各文本框无效
			txt_order.ReadOnly = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_usename.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_kind.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_xkind.Locked = True
			txt_money.ReadOnly = True
			DTPicker_date.Enabled = False
			'使保存按钮无效
			cmdsave.Enabled = False
		Else : k = False
			Do Until rst1.EOF
				rst1.Delete()
				rst1.MoveNext()
			Loop 
			rs.MoveFirst()
			With rs
				.AddNew()
				.Fields("pay_order").Value = txt_order.Text
				'UPGRADE_WARNING: 未能解析对象 DTPicker_date.Value 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
				.Fields("pay_date").Value = DTPicker_date.Value
				.Fields("pay_usename").Value = cbo_usename.Text
				.Fields("pay_kind").Value = cbo_kind.Text
				.Fields("payx_kind").Value = cbo_xkind.Text
				.Fields("pay_money").Value = Trim(txt_money.Text)
				.Update()
				rs.Index = "pay_order"
			End With
			MsgBox("你已经成功的修改了记录!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "提示")
			'使各按钮有效
			cmdfirst.Enabled = True
			cmdlast.Enabled = True
			cmdnext.Enabled = True
			cmdprevious.Enabled = True
			cmddelete.Enabled = True
			'使各文本框无效
			txt_order.ReadOnly = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_usename.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_kind.Locked = True
			'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
			cbo_xkind.Locked = True
			txt_money.ReadOnly = True
			DTPicker_date.Enabled = False
			'使保存按钮无效
			cmdsave.Enabled = False
		End If
		'是保存按钮无效
		cmdsave.Enabled = False
		
	End Sub
	
	Private Sub Command1_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Command1.Click
		rs.Seek("=", txt_order.Text)
		On Error GoTo kk
		Call viewdata()
kk: 
	End Sub
	
	Private Sub DTPicker_date_Change(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles DTPicker_date.Change
		'rs.FindFirst "pay_date=dtpicker_date.value"
		
	End Sub
	
	Private Sub DTPicker_date_KeyPressEvent(ByVal eventSender As System.Object, ByVal eventArgs As AxMSComCtl2.DDTPickerEvents_KeyPressEvent) Handles DTPicker_date.KeyPressEvent
		If eventArgs.KeyAscii = 13 Then
			System.Windows.Forms.SendKeys.Send("{TAB}")
		End If
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmmodi_del.Activate 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmmodi_del_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 frmmodi_del_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")
		If rs.EOF Then
			MsgBox("记录表中没有记录,请添加记录!")
		Else
			rs.MoveFirst()
			
			
			txt_order.Text = rs.Fields("pay_order").Value
			DTPicker_date._Value = rs.Fields("pay_date").Value
			cbo_usename.Text = rs.Fields("pay_usename").Value
			cbo_kind.Text = rs.Fields("pay_kind").Value
			txt_money.Text = rs.Fields("pay_money").Value
			cbo_xkind.Text = rs.Fields("payx_kind").Value
			
		End If
		
		'使保存按钮无效
		cmdsave.Enabled = False
		
		'使各文本框无效
		txt_order.ReadOnly = True
		'UPGRADE_ISSUE: ComboBox 属性 cbo_usename.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
		cbo_usename.Locked = True
		'UPGRADE_ISSUE: ComboBox 属性 cbo_kind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
		cbo_kind.Locked = True
		'UPGRADE_ISSUE: ComboBox 属性 cbo_xkind.Locked 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2064"”
		cbo_xkind.Locked = True
		txt_money.ReadOnly = True
		DTPicker_date.Enabled = False
		
		rs.Index = ("pay_order")
		rs.MoveFirst()
		Call viewdata()
		StatusBar1.Panels(3).Text = "总记录为:" & (rs.RecordCount) & "条 " & "当前为:" & ((rs.PercentPosition) + 1) & "条"
		
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmmodi_del.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmmodi_del_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		frmmain.DefInstance.Show()
	End Sub
	
	Private Sub Timer1_Tick(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles Timer1.Tick
		StatusBar1.Panels(2).Text = TimeString
		StatusBar1.Panels(1).Text = DateString & WeekDayName(WeekDay(CDate(DateString)), 0, 1)
	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

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -