cspregression.vb

来自「wrox出版社的另一套经典的VB2005数据库编程学习书籍,收集了书中源码,郑重」· VB 代码 · 共 629 行 · 第 1/2 页

Option Explicit On
Option Strict On
Imports System
Imports System.Data
Imports System.Data.Sql
Imports System.Data.SqlClient

Public Class CSPRegression
	Private cnNwind As SqlConnection
	Private cmData As SqlCommand
	Private alProducts As New ArrayList
	Private blnUseSalesOrders As Boolean
	Private datLastMonthOrders As DateTime
	Private datLastMonthSalesOrders As DateTime
	Private datStartParam As DateTime
	Private datEndParam As DateTime
	Private intProductID As Integer
	Private intMonths As Integer
	Private blnHasLoaded As Boolean
	Private blnIsDblClick As Boolean
	Private blnAllProducts As Boolean

	Private Sub CSPRegression_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
		Try
			Dim strConn As String = My.Settings.NorthwindConnection
			cnNwind = New SqlConnection(strConn)

			'Create NWProduct objects ArrayList
			Dim strSQL As String = "SELECT ProductID, ProductName, UnitPrice, UnitsInStock, UnitsOnOrder " + _
			 "FROM Products WHERE Discontinued = 0 ORDER BY ProductName"
			cmData = New SqlCommand(strSQL, cnNwind)
			cmData.CommandType = CommandType.Text
			cmData.CommandText = strSQL
			cnNwind.Open()
			Dim rdrProducts As SqlDataReader = cmData.ExecuteReader
			With rdrProducts
				If .HasRows Then
					While .Read
						alProducts.Add(New NWProduct(.GetInt32(0), .GetString(1), .GetDecimal(2), .GetInt16(3), .GetInt16(4)))
					End While
				End If
				.Close()
			End With

			'Populate the combo box
			With cboProduct
				.DataSource = alProducts
				.DisplayMember = "ProductName"
				.ValueMember = "ProductID"
			End With

			'Get ending date parameter values
			strSQL = "SELECT MAX(OrderDate) FROM Orders"
			cmData.CommandText = strSQL
			'Date of last order received
			Dim datLastDay As DateTime = CType(cmData.ExecuteScalar, DateTime)
			datLastMonthOrders = DateTime.Parse((datLastDay.Month).ToString + "/1/" + datLastDay.Year.ToString)
			If chkUseSalesOrders.Enabled Then
				cmData.CommandText = "SELECT MAX(OrderDate) FROM SalesOrders"
				datLastDay = CType(cmData.ExecuteScalar, DateTime)
				datLastMonthSalesOrders = DateTime.Parse((datLastDay.Month).ToString + "/1/" + datLastDay.Year.ToString)
			End If
			cnNwind.Close()
			blnHasLoaded = True

			'Default startup values
			cboMonths.SelectedIndex = 3
			intMonths = CInt(cboMonths.SelectedItem)
			datStartParam = datLastMonthOrders.AddMonths(-intMonths)
			txtStartDate.Text = datStartParam.ToShortDateString
			'End date is the last day of the month preceding the date of the last order
			datEndParam = datLastMonthOrders.AddDays(-1)
			txtEndDate.Text = datEndParam.ToShortDateString
			intProductID = CInt(cboProduct.SelectedValue)
			GetData()
		Catch exc As Exception
			MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Exception Loading Linear Regression Form")
		End Try
	End Sub

	Private Class NWProduct
		'Class to fill cboProducts with alProducts objects and provide
		'additional order data to avoid server round-trips
		Private m_ProductID As Integer
		Private m_ProductName As String
		Private m_UnitPrice As Decimal
		Private m_UnitsInStock As Short
		Private m_UnitsOnOrder As Short

		Public Sub New(ByVal intProductID As Integer, _
		 ByVal strProductName As String, ByVal decUnitPrice As Decimal, _
		ByVal shtUnitsInStock As Short, ByVal shtUnitsOnOrder As Short)
			Me.m_ProductID = intProductID
			Me.m_ProductName = strProductName
			Me.m_UnitPrice = decUnitPrice
			Me.m_UnitsInStock = shtUnitsInStock
			Me.m_UnitsOnOrder = shtUnitsOnOrder
		End Sub
		Public ReadOnly Property ProductID() As Integer
			Get
				Return Me.m_ProductID
			End Get
		End Property

		Public ReadOnly Property ProductName() As String
			Get
				Return Me.m_ProductName
			End Get
		End Property

		Public ReadOnly Property UnitPrice() As Decimal
			Get
				Return Me.m_UnitPrice
			End Get
		End Property

		Public ReadOnly Property UnitsInStock() As Short
			Get
				Return Me.m_UnitsInStock
			End Get
		End Property

		Public ReadOnly Property UnitsOnOrder() As Short
			Get
				Return Me.m_UnitsOnOrder
			End Get
		End Property
	End Class

	Private Sub btnGetData_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnGetData.Click
		'Event handler
		SetControlState(False)
		GetData()
		SetControlState(True)
	End Sub

	Private Sub SetControlState(ByVal blnEnabled As Boolean)
		'Enable/disable controls during data retrieval
		btnGetData.Enabled = blnEnabled
		btnAllProducts.Enabled = blnEnabled
		btnCSPClient.Enabled = blnEnabled
		cboProduct.Enabled = blnEnabled
		cboMonths.Enabled = blnEnabled
		chkUseSalesOrders.Enabled = blnEnabled
		chkDescending.Enabled = blnEnabled
	End Sub

	Private Sub GetData()
		'Get data on which linear regression analysis is based
		'This procedure is based on the code in clr_LinearRegression
		Try
			Me.Cursor = Cursors.WaitCursor
			lstData.Items.Clear()
			Dim fntData As New Font("Lucida Console", 10, FontStyle.Regular, GraphicsUnit.Point)
			lstData.Font = fntData
			ClearTextBoxes()
            Application.DoEvents()
			'Create an array of months in ascending date sequence
			Dim intMonth As Integer
			Dim datMonth As DateTime = datEndParam.AddDays(1).AddMonths(-1)
			Dim astrFinal(intMonths - 1, 5) As String
			For intMonth = intMonths To 1 Step -1
				astrFinal(intMonth - 1, 0) = intProductID.ToString
				astrFinal(intMonth - 1, 1) = datMonth.Year.ToString
				astrFinal(intMonth - 1, 2) = datMonth.Month.ToString
				If intMonth < 10 Then
					astrFinal(intMonth - 1, 3) = " " + intMonth.ToString
				Else
					astrFinal(intMonth - 1, 3) = intMonth.ToString
				End If
				astrFinal(intMonth - 1, 4) = "     0"
				astrFinal(intMonth - 1, 5) = "      $0"
				datMonth = datMonth.AddMonths(-1)
			Next intMonth

			'Create an array of data for months with sales
			Dim astrData(intMonths - 1, 5) As String
			Dim strSQL As String = Nothing
			If chkUseSalesOrders.Checked Then
				strSQL = "usp_GetSalesOrdersAggregates"
			Else
				strSQL = "usp_GetOrdersAggregates"
			End If
			With cmData
				.CommandText = strSQL
				.CommandType = CommandType.StoredProcedure
				.Parameters.Clear()
				.Parameters.AddWithValue("@ProductID", intProductID)
				.Parameters.AddWithValue("@StartDate", datStartParam)
				.Parameters.AddWithValue("@EndDate", datEndParam)
			End With
			Dim lngTicks As Long = Now.Ticks
			If cnNwind.State = ConnectionState.Closed Then
				cnNwind.Open()
			End If
			Dim rdrData As SqlDataReader = cmData.ExecuteReader
			Dim intRow As Integer

			'Populate the sales data array
			With rdrData
				If .HasRows Then
					While .Read
						astrData(intRow, 0) = .GetSqlInt32(0).ToString	'Product ID
						astrData(intRow, 1) = .GetSqlInt32(1).ToString	'Year
						astrData(intRow, 2) = .GetSqlInt32(2).ToString	'Month
						astrData(intRow, 3) = .GetSqlInt64(3).ToString	'MonthNum (x)
						Select Case .GetInt32(4)
							Case Is < 10
								astrData(intRow, 4) = "     "
							Case Is < 100
								astrData(intRow, 4) = "    "
							Case Is < 1000
								astrData(intRow, 4) = "   "
							Case Is < 10000
								astrData(intRow, 4) = " "
						End Select
						astrData(intRow, 4) += .GetInt32(4).ToString("N0")	'TotalUnits (y)
						Select Case .GetSqlInt32(5)
							Case Is < 10
								astrData(intRow, 5) = "      "
							Case Is < 100
								astrData(intRow, 5) = "     "
							Case Is < 1000
								astrData(intRow, 5) = "    "
							Case Is < 10000
								astrData(intRow, 5) = "  "
							Case Is < 100000
								astrData(intRow, 5) = " "
						End Select
						astrData(intRow, 5) += .GetInt32(5).ToString("$#,##0")
						intRow += 1
                    End While
					.Close()
					lngTicks = Now.Ticks - lngTicks
					txtGetData.Text = (lngTicks / 10000000).ToString("#0.000")
				Else
					Me.Cursor = Cursors.Default
					Dim strMsg As String = "Your selection returned no rows"
					MsgBox(strMsg, MsgBoxStyle.Exclamation, "Execution Error")
					Return
				End If
			End With
			cmData.CommandType = CommandType.Text

			'Merge astrData with astrFinal
			Dim intMax As Integer = intRow
			For intRow = 0 To intMax - 1
				For intMonth = 0 To intMonths - 1
					If astrData(intRow, 1) = astrFinal(intMonth, 1) And _
					 astrData(intRow, 2) = astrFinal(intMonth, 2) Then
						astrFinal(intMonth, 4) = astrData(intRow, 4)
						astrFinal(intMonth, 5) = astrData(intRow, 5)
						Exit For
					End If
				Next
			Next

			'Populate the list box
			Dim strData As String = Nothing
			If chkDescending.Checked Then
				'Descending date order
				For intRow = intMonths - 1 To 0 Step -1
					If CInt(astrFinal(intRow, 2)) < 10 Then
						strData = "0"
					Else
						strData = ""
					End If
					strData += astrFinal(intRow, 2) + "/" + astrFinal(intRow, 1)
					strData += ", MonthNum (x): " + astrFinal(intRow, 3)
					strData += ", UnitsSold (y): " + astrFinal(intRow, 4)
					strData += ", Sales: " + astrFinal(intRow, 5)
					lstData.Items.Add(strData)
				Next
			Else
				'Ascending date order
				For intRow = 0 To intMonths - 1
					If Val(astrFinal(intRow, 2)) < 10 Then
						strData = "0"
					Else
						strData = ""
					End If
					strData += astrFinal(intRow, 2) + "/" + astrFinal(intRow, 1)
					strData += ", MonthNum (x): " + astrFinal(intRow, 3)
					strData += ", UnitsSold (y): " + astrFinal(intRow, 4)
					strData += ", Sales: " + astrFinal(intRow, 5)
					lstData.Items.Add(strData)
				Next
			End If
			GetRegressionData()
			cnNwind.Close()
			Me.Cursor = Cursors.Default
		Catch exc As Exception
			Me.Cursor = Cursors.Default
			MsgBox(exc.Message, MsgBoxStyle.Exclamation, "Exception Loading Product Data List Box")
		Finally
			Me.Cursor = Cursors.Default
		End Try
	End Sub

	Private Sub GetRegressionData()
		Try
			'Get the regression values for the selected ProductID value
			Dim strSQL As String = "csp_LinearRegression"
			With cmData
				.CommandText = strSQL
				.CommandType = CommandType.StoredProcedure
				.Parameters.Clear()
				.Parameters.AddWithValue("@ProductID", intProductID)
				If chkUseSalesOrders.Checked Then
					.Parameters.AddWithValue("@LastMonth", datLastMonthSalesOrders)
					.Parameters.AddWithValue("@Months", intMonths)
					.Parameters.AddWithValue("@UseSalesOrders", 1)
				Else
					.Parameters.AddWithValue("@LastMonth", datLastMonthOrders)
					.Parameters.AddWithValue("@Months", intMonths)