frmquery.vb

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

		rs2 = db.OpenRecordset("select * from payout where " & Trim("pay_order") & Trim(cboqu_order.Text) & (txtqu_order.Text))
		If rs2.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		With dataset
			.Rows = 1
			.set_Cols( , 6)
			.set_ColWidth(3,  , 1500)
			.CellAlignment = 4
			.set_TextMatrix(0, 0, "开支编号")
			.set_TextMatrix(0, 1, "开支日期")
			.set_TextMatrix(0, 2, "开支人")
			.set_TextMatrix(0, 3, "开支大种类")
			.set_TextMatrix(0, 4, "开支小种类")
			.set_TextMatrix(0, 5, "开支金额")
			Do While Not rs2.EOF
				.Rows = .Rows + 1
				.CellAlignment = 4
				.set_TextMatrix(.Rows - 1, 0, rs2.Fields(0).Value)
				.set_TextMatrix(.Rows - 1, 1, VB6.Format(rs2.Fields(1).Value, "yyyy-mm-dd"))
				.set_TextMatrix(.Rows - 1, 2, rs2.Fields(2).Value)
				.set_TextMatrix(.Rows - 1, 3, rs2.Fields(3).Value)
				.set_TextMatrix(.Rows - 1, 4, rs2.Fields(5).Value)
				.set_TextMatrix(.Rows - 1, 5, VB6.Format(rs2.Fields(4).Value, "0.00"))
				rs2.MoveNext()
			Loop 
		End With
		'计算查询到的总金额
		Dim rs5 As DAO.Recordset
		rs5 = db.OpenRecordset("select sum(pay_money) as total from payout where " & Trim("pay_order") & Trim(cboqu_order.Text) & (txtqu_order.Text))
		If rs5.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		Lbl1.Text = "你查询到" & (rs2.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0).Value & "元"
		rs2.Close()
		rs5.Close()
	End Sub
	'以下一段代码是实现按日期查询
	Sub query_date()
		Dim sql As Object
		'Dim sql As String
		rs.Index = ("pay_order")
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		'sql = "select * from  payout where " & "pay_date <= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "31" & " # " & " And " & "pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
		'sql = "select * from  payout where pay_date >= " & "#" & Year(Date$) & "-" & Month(Date$) & "-" & "01" & " #"
		'UPGRADE_WARNING: 未能解析对象 sql 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		sql = "select * from payout where  pay_date " & Trim(cboqu_date.Text) & "#" & Trim(DTPqu_date.Value) & "#"
		'UPGRADE_WARNING: 未能解析对象 sql 的默认属性。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup1037"”
		rs3 = db.OpenRecordset(sql)
		If rs3.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		With dataset
			.Rows = 1
			.set_Cols( , 6)
			.CellAlignment = 4
			.set_ColWidth(3,  , 1500)
			.set_TextMatrix(0, 0, "开支编号")
			.set_TextMatrix(0, 1, "开支日期")
			.set_TextMatrix(0, 2, "开支人")
			.set_TextMatrix(0, 3, "开支大种类")
			.set_TextMatrix(0, 4, "开支小种类")
			.set_TextMatrix(0, 5, "开支金额")
			Do While Not rs3.EOF
				.Rows = .Rows + 1
				.CellAlignment = 4
				.set_TextMatrix(.Rows - 1, 0, rs3.Fields(0).Value)
				.set_TextMatrix(.Rows - 1, 1, VB6.Format(rs3.Fields(1).Value, "yyyy-mm-dd"))
				.set_TextMatrix(.Rows - 1, 2, rs3.Fields(2).Value)
				.set_TextMatrix(.Rows - 1, 3, rs3.Fields(3).Value)
				.set_TextMatrix(.Rows - 1, 4, rs3.Fields(5).Value)
				.set_TextMatrix(.Rows - 1, 5, VB6.Format(rs3.Fields(4).Value, "0.00"))
				rs3.MoveNext()
			Loop 
		End With
		
		Dim rs5 As DAO.Recordset
		rs5 = db.OpenRecordset("select sum(pay_money) as total from  payout where pay_date " & Trim(cboqu_date.Text) & "#" & Trim(DTPqu_date.Value) & "#")
		If rs5.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		Lbl1.Text = "你查询到" & (rs3.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0).Value & "元"
		rs3.Close()
		rs5.Close()
	End Sub
	
	'以下一段代码是实现按种类查询
	Sub query_kind()
		rs.Index = ("pay_order")
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rs4 = db.OpenRecordset("select * from payout where  pay_kind='" & cbokind_qu.Text & "'")
		If rs4.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		With dataset
			.Rows = 1
			.set_Cols( , 6)
			.CellAlignment = 4
			.set_ColWidth(3,  , 1500)
			.set_TextMatrix(0, 0, "开支编号")
			.set_TextMatrix(0, 1, "开支日期")
			.set_TextMatrix(0, 2, "开支人")
			.set_TextMatrix(0, 3, "开支大种类")
			.set_TextMatrix(0, 4, "开支小种类")
			.set_TextMatrix(0, 5, "开支金额")
			Do While Not rs4.EOF
				.Rows = .Rows + 1
				.CellAlignment = 4
				.set_TextMatrix(.Rows - 1, 0, rs4.Fields(0).Value)
				.set_TextMatrix(.Rows - 1, 1, VB6.Format(rs4.Fields(1).Value, "yyyy-mm-dd"))
				.set_TextMatrix(.Rows - 1, 2, rs4.Fields(2).Value)
				.set_TextMatrix(.Rows - 1, 3, rs4.Fields(3).Value)
				.set_TextMatrix(.Rows - 1, 4, rs4.Fields(5).Value)
				.set_TextMatrix(.Rows - 1, 5, VB6.Format(rs4.Fields(4).Value, "0.00"))
				'  .TextMatrix(.Rows, 6) = Format(rs4.Fields(4), "0.00")
				rs4.MoveNext()
			Loop 
		End With
		
		'计算查询到的总金额
		Dim rs5 As DAO.Recordset
		rs5 = db.OpenRecordset("select sum(pay_money) as total from payout where  pay_kind='" & cbokind_qu.Text & "'")
		If rs5.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		Lbl1.Text = "你查询到" & (rs4.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0).Value & "元"
		rs4.Close()
		rs5.Close()
	End Sub
	
	
	'UPGRADE_WARNING: Form 事件 frmquery.Activate 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmquery_Activated(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Activated
		rs.Index = ("pay_order")
		Dim dkrs As DAO.Recordset
		dkrs = db.OpenRecordset("dkind")
		If Not dkrs.EOF Then
			dkrs.MoveFirst()
			Do Until dkrs.EOF
				cbokind_qu.Items.Add(Trim(dkrs.Fields("dkind_name").Value))
				dkrs.MoveNext()
			Loop 
		Else
			MsgBox("数据库中没有大类别数据,请在添加!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "设置大类别")
		End If
		
		
	End Sub
	
	Private Sub frmquery_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")
		rs1 = db.OpenRecordset("select distinct pay_kind from payout")
		rs.Index = ("pay_order")
		With dataset
			.Rows = 1
			.set_Cols( , 6)
			.CellAlignment = 4
			.set_ColWidth(3,  , 1500)
			.set_TextMatrix(0, 0, "开支编号")
			.set_TextMatrix(0, 1, "开支日期")
			.set_TextMatrix(0, 2, "开支人")
			.set_TextMatrix(0, 3, "开支大种类")
			.set_TextMatrix(0, 4, "开支小种类")
			.set_TextMatrix(0, 5, "开支金额")
			Do While Not rs.EOF
				.Rows = .Rows + 1
				.CellAlignment = 4
				.set_TextMatrix(.Rows - 1, 0, rs.Fields(0).Value)
				.set_TextMatrix(.Rows - 1, 1, VB6.Format(rs.Fields(1).Value, "yyyy-mm-dd"))
				.set_TextMatrix(.Rows - 1, 2, rs.Fields(2).Value)
				.set_TextMatrix(.Rows - 1, 3, rs.Fields(3).Value)
				.set_TextMatrix(.Rows - 1, 4, rs.Fields(5).Value)
				.set_TextMatrix(.Rows - 1, 5, VB6.Format(rs.Fields(4).Value, "0.00"))
				rs.MoveNext()
			Loop 
		End With
		
		'使各文本框无效
		cbokind_qu.Enabled = False
		txtqu_order.Enabled = False
		cboqu_order.Enabled = False
		cboqu_date.Enabled = False
		DTPqu_date.Enabled = False
		rs.Index = ("pay_order")
		'自动算出开支编号
		' 判断现在是几月，来决定开支编号中月份的写法
		Dim yue As String
		If Month(Today) >= 10 Then
			yue = CStr(Month(Today))
		Else
			yue = "0" & Month(Today)
		End If
		txtqu_order.Text = Year(CDate(DateString)) & yue & "001"
		'设置当前日期
		DTPqu_date.Value = DateString
	End Sub
	
	
	Private Sub cmdquit_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdquit.Click
		Me.Close()
		frmmain.DefInstance.Show()
	End Sub
	
	Private Sub cmdsearch_Click(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles cmdsearch.Click
		'判断用户选择了那种查询方式
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		rs = db.OpenRecordset("payout")
		Dim a As String
		
		If (opt_order.Checked = False) And (opt_date.Checked = False) And (opt_kind.Checked = False) Then
			a = CStr(MsgBox("确定不选择查询条件，而查询所有的数据吗？", MsgBoxStyle.YesNo + MsgBoxStyle.Information, "提示"))
			If a = CStr(MsgBoxResult.Yes) Then
				With dataset
					.Rows = 1
					.set_Cols( , 6)
					.CellAlignment = 4
					.set_ColWidth(3,  , 1500)
					.set_TextMatrix(0, 0, "开支编号")
					.set_TextMatrix(0, 1, "开支日期")
					.set_TextMatrix(0, 2, "开支人")
					.set_TextMatrix(0, 3, "开支大种类")
					.set_TextMatrix(0, 4, "开支小种类")
					.set_TextMatrix(0, 5, "开支金额")
					Do While Not rs.EOF
						.Rows = .Rows + 1
						.CellAlignment = 4
						.set_TextMatrix(.Rows - 1, 0, rs.Fields(0).Value)
						.set_TextMatrix(.Rows - 1, 1, VB6.Format(rs.Fields(1).Value, "yyyy-mm-dd"))
						.set_TextMatrix(.Rows - 1, 2, rs.Fields(2).Value)
						.set_TextMatrix(.Rows - 1, 3, rs.Fields(3).Value)
						.set_TextMatrix(.Rows - 1, 4, rs.Fields(5).Value)
						.set_TextMatrix(.Rows - 1, 5, VB6.Format(rs.Fields(4).Value, "0.00"))
						rs.MoveNext()
					Loop 
				End With
			Else
				Exit Sub
			End If
		End If
		
		db = DAODBEngine_definst.OpenDatabase("d:\data\payout.mdb")
		Dim rs5 As DAO.Recordset
		rs5 = db.OpenRecordset("select sum(pay_money) as total from payout")
		If rs5.RecordCount = 0 Then
			MsgBox("按你所指定的条件查询没有记录,请重新设置条件查询!", MsgBoxStyle.OKOnly + MsgBoxStyle.Information, "查询没有记录")
			Exit Sub
		End If
		Lbl1.Text = "你查询到" & (rs.RecordCount) & "条记录" & "总金额为:" & rs5.Fields(0).Value & "元"
		rs5.Close()
		
		If (opt_order.Checked = True) And (cboqu_order.Text <> "") And (txtqu_order.Text <> "") Then
			Call query_order()
		ElseIf (opt_date.Checked = True) And (cboqu_date.Text <> "") And (DTPqu_date.Value <> "") Then 
			Call query_date()
		ElseIf (opt_kind.Checked = True) And (cbokind_qu.Text <> "") Then 
			Call query_kind()
		Else
			cmdsearch.Focus()
			'MsgBox "查询条件不能为空，请选择条件！", vbOKOnly + vbInformation, "提示"
		End If
		
	End Sub
	
	'UPGRADE_WARNING: Form 事件 frmquery.Unload 具有新的行为。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2065"”
	Private Sub frmquery_Closed(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles MyBase.Closed
		frmmain.DefInstance.Show()
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 opt_date.CheckedChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub opt_date_CheckedChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles opt_date.CheckedChanged
		If eventSender.Checked Then
			'使别的查询框无效,使与该单选框对应的文本框有效
			If opt_date.Checked = True Then
				DTPqu_date.Enabled = True
				txtqu_order.Enabled = False
				cbokind_qu.Enabled = False
				cboqu_order.Enabled = False
				cboqu_date.Enabled = True
			End If
		End If
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 opt_kind.CheckedChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub opt_kind_CheckedChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles opt_kind.CheckedChanged
		If eventSender.Checked Then
			'使别的查询框无效,使与该单选框对应的文本框有效
			If opt_kind.Checked = True Then
				cbokind_qu.Enabled = True
				DTPqu_date.Enabled = False
				txtqu_order.Enabled = False
				cboqu_order.Enabled = False
				cboqu_date.Enabled = False
			End If
		End If
	End Sub
	
	'UPGRADE_WARNING: 初始化窗体时可能激发事件 opt_order.CheckedChanged。 单击以获得更多信息:“ms-help://MS.VSCC.2003/commoner/redir/redirect.htm?keyword="vbup2075"”
	Private Sub opt_order_CheckedChanged(ByVal eventSender As System.Object, ByVal eventArgs As System.EventArgs) Handles opt_order.CheckedChanged
		If eventSender.Checked Then
			'使别的查询框无效,使与该单选框对应的文本框有效
			If opt_order.Checked = True Then
				txtqu_order.Enabled = True
				cboqu_order.Enabled = True
				DTPqu_date.Enabled = False
				cbokind_qu.Enabled = False
				cboqu_date.Enabled = False
			End If
		End If
	End Sub
End Class