Converting ImageCombo from VB6 to Vb.Net shows simple non Editable Textbox - vb.net

I have the following code written in Vb6 for ImageCombo control.
Begin MSComctlLib.ImageCombo dImageCombo
Height = 330
Index = 0
Left = 120
TabIndex = 10
Top = 3480
Visible = 0 'False
Width = 1815
_ExtentX = 3201
_ExtentY = 582
_Version = 393216
ForeColor = -2147483640
BackColor = -2147483643
Text = "ImageCombo1"
End
Then I have a RenderCombo function as follows. It goes through each and every line of function and get a proper value as well for ItemList in ImageCombo but doesn't display anything. It simply appear as a Non Editable Textview.
Private Sub RenderCombo(a_dbmgr As ObjectDBManager, _
ByRef a_X As Integer, ByRef a_Y As Integer, _
bnode As DataSetNode, fldname As String, _
MaxPixHeight As Integer, ColMaxWidth As Integer, _
hLevels As Integer, YStart As Integer, gHeight As Integer, _
padding As Integer, gInframe As Boolean, a_tooltip As String)
Dim tstr As String
Dim ltmp As ComboItem
Dim lseldata As String
Dim loldcolwidth As Integer
Load dImageCombo(nCombos + 1)
nCombos = nCombos + 1
tstr = bnode.GetLeafString("WIDTH")
If tstr <> "" Then
dImageCombo(nCombos).Width = SafeCLng(tstr)
End If
dImageCombo(nCombos).Visible = True
dImageCombo(nCombos).Left = a_X
dImageCombo(nCombos).Top = a_Y
lseldata = bnode.GetLeafString("SELTABLENAV") & "+" & _
bnode.GetLeafString("SELMATCHFIELD") & "+" & _
bnode.GetLeafString("SELMATCHNAV") & "+" & _
bnode.GetLeafString("SELLABELNAME") & "+" & _
bnode.GetLeafString("SELNOBLANK") & "+" & _
bnode.GetLeafString("SELVALCAPS") & "+"
dImageCombo(nCombos).Tag = fldname & "+" & lseldata
mMakeComboList a_dbmgr, bnode, nCombos, lseldata
SetNextXY a_X, a_Y, dImageCombo(nCombos).Width, dImageCombo(nCombos).Height, _
MaxPixHeight, gHeight, hLevels, YStart, ColMaxWidth, loldcolwidth, "COMBO", gInframe
If gInframe Then
dFrame(nFrames).Width = mBumpWidth(dFrame(nFrames).Width, dImageCombo(nCombos).Left + loldcolwidth + padding, "COMBO")
Set dImageCombo(nCombos).Container = dFrame(nFrames)
End If
dImageCombo(nCombos).ToolTipText = a_tooltip
End Sub
Code that I've got in VB.Net after migration is as follows:
Private Sub RenderCombo(ByRef a_dbmgr As ObjectDBManager, ByRef a_X As Short, ByRef a_Y As Short, ByRef bnode As DataSetNode, ByRef fldname As String, ByRef MaxPixHeight As Short, ByRef ColMaxWidth As Short, ByRef hLevels As Short, ByRef YStart As Short, ByRef gHeight As Short, ByRef padding As Short, ByRef gInframe As Boolean, ByRef a_tooltip As String)
Dim tstr As String = ""
Dim ltmp As MSComctlLib.ComboItem
Dim lseldata As String = ""
Dim loldcolwidth As Short
dImageCombo.Load(nCombos + 1)
nCombos = nCombos + 1
tstr = bnode.GetLeafString("WIDTH")
If tstr <> "" Then
dImageCombo(nCombos).Width = SafeCLng(tstr)
End If
dImageCombo(nCombos).Visible = True
dImageCombo(nCombos).Left = a_X
dImageCombo(nCombos).Top = a_Y
lseldata = bnode.GetLeafString("SELTABLENAV") & "+" & bnode.GetLeafString("SELMATCHFIELD") & "+" & bnode.GetLeafString("SELMATCHNAV") & "+" & bnode.GetLeafString("SELLABELNAME") & "+" & bnode.GetLeafString("SELNOBLANK") & "+" & bnode.GetLeafString("SELVALCAPS") & "+"
dImageCombo(nCombos).Tag = fldname & "+" & lseldata
mMakeComboList(a_dbmgr, bnode, nCombos, lseldata)
SetNextXY(a_X, a_Y, dImageCombo(nCombos).Width, dImageCombo(nCombos).Height, MaxPixHeight, gHeight, hLevels, YStart, ColMaxWidth, loldcolwidth, "COMBO", gInframe)
If gInframe Then
dFrame(nFrames).Width = mBumpWidth(dFrame(nFrames).Width, dImageCombo(nCombos).Left + loldcolwidth + padding, "COMBO")
dImageCombo(nCombos).Parent = dFrame(nFrames)
End If
ToolTip1.SetToolTip(dImageCombo(nCombos), a_tooltip)
End Sub
Designer code after migration:
Friend WithEvents dImageCombo As AxImageComboArray
Friend WithEvents _dImageCombo_0 As AxMSComctlLib.AxImageCombo
Me._dImageCombo_0 = New AxMSComctlLib.AxImageCombo
Me.dImageCombo = New AxImageComboArray(Me.components)
CType(Me._dImageCombo_0, System.ComponentModel.ISupportInitialize).BeginInit()
CType(Me.dImageCombo, System.ComponentModel.ISupportInitialize).BeginInit()
Me.dImageCombo.SetIndex(Me._dImageCombo_0, CType(0, Short))
Me._dImageCombo_0.Location = New System.Drawing.Point(8, 232)
Me._dImageCombo_0.Name = "_dImageCombo_0"
Me._dImageCombo_0.OcxState = CType(resources.GetObject("_dImageCombo_0.OcxState"), System.Windows.Forms.AxHost.State)
Me._dImageCombo_0.Size = New System.Drawing.Size(121, 22)
Me._dImageCombo_0.TabIndex = 10
Me._dImageCombo_0.Visible = False
Me.Controls.Add(Me._dImageCombo_0)
CType(Me._dImageCombo_0, System.ComponentModel.ISupportInitialize).EndInit()
CType(Me.dImageCombo, System.ComponentModel.ISupportInitialize).EndInit()
Here is the screenshot of ImageCombo that display as a simple TextBox in Vb.Net.
Any help would be appreciated.

Related

The best way to convert VB6 code to SQL Query

I'm not a VB 6 programmer and I'm struggling to pull the SQL out of this VB 6 form. Any tips would be greatly appreciated. I removed some DIM statements. Basically this was a form with 4 different reports that formatted the data. Of course this is a legacy app and I'm trying to extract the report logic here.
**** Removed some form code to comply with character limit ****
#End Region
Private Sub frmrptProductionControl_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
mkdtPC()
mkdtReport()
mkdtPCSorted()
End Sub
Function getMinEOQ(ByVal Material As String, ByVal DBConnection As SqlConnection) As Double
Dim UserValues As Int64
popdtParam(Material, "STRING", "MATERIAL")
Dim strSQL As String = "SELECT USER_VALUES FROM MATERIAL WHERE MATERIAL = #MATERIAL"
Dim getValue As New getSingleValuePQ(strSQL, "USER_VALUES", "NUMERIC", dtParam, DBConnection)
UserValues = getValue.Value
dtParam.Clear()
popdtParam(UserValues, "NUMERIC", "USERVALUES")
strSQL = "SELECT NUMERIC2 FROM USER_VALUES WHERE USER_VALUES = #USERVALUES"
getValue = New getSingleValuePQ(strSQL, "NUMERIC2", "NUMERIC", dtParam, DBConnection)
Return getValue.Value
End Function
Private Sub popdtPC(ByVal StartDate As Date, ByVal EndDate As Date, ByVal ReportType As String, Optional ByVal SortByPart As Boolean = 0)
dsPC.Clear()
Dim strsql As String
strsql = "SELECT MATERIAL, JOB, STOCK, INPROCESS, LTAQTY, SALESPRICE, "
strsql &= "LT, LTDEMANDDATE, DEPLETIONDATE, DEMAND6MONTHS, "
strsql &= "DEMAND12MONTHS, PROFIT, UNITCOST, LTDEMAND FROM tblPartData "
If ReportType = "PRODUCTIONCONTROL" Then
strsql &= "WHERE MATERIAL NOT IN (SELECT MATERIAL FROM TBLCRITICALPARTS) "
End If
Dim drdGetData As SqlDataReader = Nothing
Dim cmmGetData As New SqlCommand(strsql, cnSQL)
Try
drdGetData = cmmGetData.ExecuteReader()
Catch objException As SqlException
Dim objerror As SqlError
For Each objerror In objException.Errors
MsgBox(objException.Message)
Next
End Try
Dim Material, NewestJob, Deliveries, Comments, PersonResp, ExpireDate, CriticalColor, Program As String
Dim Stock, InProcess, LTAQty, LT, Demand, Demand6Months, _
Demand12Months, PromisedQty, PartCount, DelinquentCount, LTDemand, _
NewestJobQty As Int32
Dim Profit, DollarSum, DelinquentSum, SalesPrice As Double
Dim LTDemandDate, DepletionDate, DemandDate, PromisedDate As Date
Dim Critical As String
Dim ins As Boolean
PartCount = 0
DelinquentCount = 0
DelinquentSum = 0
DollarSum = 0
While drdGetData.Read
Material = drdGetData("MATERIAL")
Program = getProgram(Material, cnSQL2)
ExpireDate = getExpireDate(Material, cnSQL2)
'MinEOQ = getMinEOQ(Material, cnSQL2)
Stock = drdGetData("STOCK")
Dim returnDemand As Demand = New Demand(Material, StartDate, EndDate, cnSQL2)
Demand = returnDemand.Value
LTDemand = drdGetData("LTDEMAND")
SalesPrice = drdGetData("SALESPRICE")
PartCount = PartCount + 1
DollarSum = DollarSum + Demand * SalesPrice
NewestJob = drdGetData("JOB")
NewestJobQty = getJobQty(NewestJob, cnSQL2)
InProcess = drdGetData("INPROCESS")
LTAQty = drdGetData("LTAQTY")
Demand6Months = drdGetData("DEMAND6MONTHS")
Demand12Months = drdGetData("DEMAND12MONTHS")
LTDemandDate = drdGetData("LTDEMANDDATE")
DepletionDate = drdGetData("DEPLETIONDATE")
Profit = drdGetData("PROFIT")
LT = drdGetData("LT")
Dim returnDeliveries As Deliveries = New Deliveries(Material, StartDate, EndDate, cnSQL2)
Deliveries = returnDeliveries.Value
returnDeliveries = Nothing
Dim returnDemandDate As DemandDate = New DemandDate(Material, cnSQL2)
DemandDate = returnDemandDate.Value
returnDemandDate = Nothing
LTDemandDate = drdGetData("LTDEMANDDATE")
If DemandDate < Now Then
DelinquentCount = DelinquentCount + 1
DelinquentSum = DelinquentSum + Demand * SalesPrice
End If
Dim returnCritical As CriticalPart = New CriticalPart(Material, cnSQL2)
Critical = returnCritical.Critical
PersonResp = returnCritical.PersonResp
Comments = returnCritical.Comments
PromisedQty = returnCritical.Quantity
PromisedDate = IIf(IsDBNull(returnCritical.PromisedDate), Nothing, returnCritical.PromisedDate)
CriticalColor = IIf(IsDBNull(returnCritical.CriticalColor), Nothing, returnCritical.CriticalColor)
returnCritical = Nothing
Select Case ReportType
Case "PRODUCTIONCONTROL"
If Demand > Stock Then
ins = True
Else
ins = False
End If
Case "PRODUCTIONPLANNING"
If Demand > Stock + InProcess Then
ins = True
Else
ins = False
End If
Case "PRODUCTIONPLANNINGLT"
If InProcess + Stock < LTDemand Then
ins = True
Else
ins = False
End If
Case "CRITICAL"
If Critical = "YES" Then
ins = True
Else
ins = False
End If
End Select
If ins = True Then
insertdtPC(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, NewestJobQty, _
LT, ExpireDate, CriticalColor, Program)
End If
End While
Dim myrow As DataRow = dtReport.NewRow()
myrow("DELINQUENT_COUNT") = DelinquentCount
myrow("PART_COUNT") = PartCount
myrow("DOLLAR_SUM") = DollarSum
myrow("DELINQUENT_SUM") = DelinquentSum
myrow("START_DATE") = StartDate
myrow("END_DATE") = EndDate
dtReport.Rows.Add(myrow)
popdtPCSorted(ReportType, SortByPart)
drdGetData.Close()
End Sub
Function getProgram(Material As String, DBConnection As SqlConnection) As String
Dim strSQL As String
strSQL = "SELECT T2.TEXT2 "
strSQL &= "FROM MATERIAL T1, USER_VALUES T2 WHERE "
strSQL &= "T1.USER_VALUES = T2.USER_VALUES AND "
strSQL &= "T1.MATERIAL = #MATERIAL "
popdtParam(Material, "STRING", "MATERIAL")
Dim getValue As New getSingleValuePQ(strSQL, "TEXT2", "STRING", dtParam, DBConnection)
If getValue.Value = "NOTHING" Then
Return ""
Else
Return getValue.Value
End If
End Function
Function getExpireDate(ByVal Material As String, ByVal DBConnection As SqlConnection) As String
Dim strSQL As String
strSQL = "SELECT MAX(T1.PROMISED_DATE) AS EXPIRE_DATE "
strSQL &= "FROM SO_Header T1, SO_Detail T2 "
strSQL &= "WHERE "
strSQL &= "T1.Sales_Order = T2.Sales_Order AND "
strSQL &= "T1.Customer = 'GECO500' AND SUBSTRING(T1.CUSTOMER_PO,1,2) = '90' AND "
strSQL &= "T1.Status = 'Open' AND T2.Status = 'Open' AND "
strSQL &= "T2.Material = #MATERIAL "
popdtParam(Material, "STRING", "MATERIAL")
Dim getDate As New getSingleValuePQ(strSQL, "EXPIRE_DATE", "DATE", dtParam, DBConnection)
If getDate.Value = #1/1/1900# Then
getExpireDate = " "
Else
getExpireDate = Format(getDate.Value, "Short Date")
End If
End Function
Private Sub insertdtPC(ByVal Material As String, ByVal Stock As Int64, ByVal Demand As Int64, ByVal NewestJob As String, _
ByVal InProcess As Int64, ByVal LTAQty As Int64, ByVal Demand6Months As Int64, ByVal Demand12Months As Int64, _
ByVal LTDemandDate As Date, ByVal DepletionDate As Date, ByVal Deliveries As String, ByVal DemandDate As Date, ByVal Profit As Double, _
ByVal Critical As String, ByVal PersonResp As String, ByVal Comments As String, ByVal PromisedQty As Int64, ByVal PromisedDate As Date, ByVal LTDemand As Int64, _
ByVal NewestJobQty As Int64, ByVal LT As Int64, ByVal ExpireDate As String, CriticalColor As String, _
ByVal Program As String)
strsql = "SELECT JOB, MAKE_QUANTITY, COMPLETED_QUANTITY FROM JOB "
strsql &= "WHERE PART_NUMBER = '" + Material + "' AND STATUS = 'Active'"
Dim Job, Routing As String
Dim MakeQuantity, CompletedQuantity As Int32
Routing = Nothing
Dim drdGetData As SqlDataReader = Nothing
Dim cmmGetData As New SqlCommand(strsql, DB1)
Try
drdGetData = cmmGetData.ExecuteReader()
Catch objException As SqlException
Dim objerror As SqlError
For Each objerror In objException.Errors
MsgBox(objException.Message)
Next
End Try
Dim drdRead As Boolean = False
While drdGetData.Read
drdRead = True
Job = drdGetData("JOB")
MakeQuantity = drdGetData("MAKE_QUANTITY")
CompletedQuantity = drdGetData("COMPLETED_QUANTITY")
Dim returnRouting As RoutingString = New RoutingString(Job, DB2, DB3)
Routing = returnRouting.Value
returnRouting = Nothing
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPC, CriticalColor)
End While
If drdRead = False Then
Job = "NONE"
MakeQuantity = 0
CompletedQuantity = 0
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPC, CriticalColor)
End If
DB1.Close()
DB2.Close()
DB3.Close()
End Sub
Private Sub insertDTRecord(ByVal Material As String, ByVal Stock As Int64, ByVal Demand As Int64, ByVal NewestJob As String, ByVal InProcess As Int64, ByVal LTAQty As Int64, ByVal Demand6Months As Int64, _
ByVal Demand12Months As Int64, ByVal LTDemandDate As Date, ByVal DepletionDate As Date, ByVal Job As String, ByVal MakeQuantity As Int64, _
ByVal CompletedQuantity As Int64, ByVal Routing As String, ByVal Deliveries As String, ByVal DemandDate As Date, ByVal Profit As Double, _
ByVal Critical As String, ByVal PersonResp As String, ByVal Comments As String, ByVal PromisedQty As Int64, ByVal PromisedDate As Date, ByVal LTDemand As Int64, _
ByVal NewestJobQty As Int64, ByVal LT As String, Program As String, _
ByVal ExpireDate As String, ByVal myDatatable As DataTable, Optional CriticalColor As String = "BLACK", Optional ByVal SORT_ORDER As Integer = -1)
Dim myrow As DataRow = myDatatable.NewRow()
Dim minEOQ As Int64
minEOQ = getMinEOQ(Material, cnSQL2)
If Not IsDBNull(minEOQ) Then
If minEOQ <> 0 Then
myrow("MIN_EOQ") = minEOQ
End If
End If
myrow("MATERIAL") = Material
myrow("PROGRAM") = Program
myrow("STOCK") = Stock
myrow("DEMAND") = Demand
myrow("NEWEST_JOB") = NewestJob
myrow("IN_PROCESS") = InProcess
myrow("LTA_QUANTITY") = LTAQty
myrow("DEMAND_6MONTHS") = Demand6Months
myrow("DEMAND_12MONTHS") = Demand12Months
myrow("LT_DEMAND_DATE") = LTDemandDate
myrow("DEPLETION_DATE") = DepletionDate
myrow("JOB") = Job
myrow("MAKE_QUANTITY") = MakeQuantity
myrow("COMPLETED_QUANTITY") = CompletedQuantity
myrow("ROUTING") = Routing
myrow("DELIVERIES") = Deliveries
myrow("DEMAND_DATE") = DemandDate
myrow("PROFIT") = Profit
myrow("CRITICAL") = Critical
myrow("PERSON_RESP") = PersonResp
myrow("COMMENTS") = Comments
myrow("PROMISED_QUANTITY") = PromisedQty
If PromisedDate <> Nothing Then
myrow("PROMISED_DATE") = Convert.ToString(Format(PromisedDate, "M/d/yy"))
End If
myrow("LT_DEMAND") = LTDemand
myrow("NEWEST_JOB_QTY") = NewestJobQty
myrow("LT") = Convert.ToInt32(LT)
myrow("LT_DEMAND_DATE") = LTDemandDate
myrow("LTA_QUANTITY") = LTAQty
myrow("EXPIRE_DATE") = ExpireDate
myrow("COLOR") = CriticalColor
If SORT_ORDER <> -1 Then
myrow("SORT_ORDER") = SORT_ORDER
End If
myDatatable.Rows.Add(myrow)
End Sub
Private Sub orderdtPC()
Dim myRows As Array = dtPC.Select()
Dim i As Integer
For i = 0 To myRows.GetUpperBound(0)
myRows(i)("SORT_ORDER") = i
Next
End Sub
Private Sub mkdtReport()
' Create new DataColumn, set DataType, ColumnName and add to DataTable.
Private Sub mkdtPC()
' Create new DataColumn, set DataType, ColumnName and add to DataTable.
*** Removed some Dim statements to post ****
Dim myDataColumn7 As DataColumn = New DataColumn
myDataColumn7.DataType = System.Type.GetType("System.String")
myDataColumn7.ColumnName = "ROUTING"
myDataColumn7.ReadOnly = True
myDataColumn7.Unique = False
dtPCSorted.Columns.Add(myDataColumn7)
Dim myDataColumn8 As DataColumn = New DataColumn
myDataColumn8.DataType = System.Type.GetType("System.Int32")
myDataColumn8.ColumnName = "MAKE_QUANTITY"
myDataColumn8.ReadOnly = True
myDataColumn8.Unique = False
dtPCSorted.Columns.Add(myDataColumn8)
Dim myDataColumn88 As DataColumn = New DataColumn
myDataColumn88.DataType = System.Type.GetType("System.Int32")
myDataColumn88.ColumnName = "COMPLETED_QUANTITY"
myDataColumn88.ReadOnly = True
myDataColumn88.Unique = False
dtPCSorted.Columns.Add(myDataColumn88)
Dim myDataColumn9 As DataColumn = New DataColumn
myDataColumn9.DataType = System.Type.GetType("System.DateTime")
myDataColumn9.ColumnName = "DEMAND_DATE"
myDataColumn9.ReadOnly = True
myDataColumn9.Unique = False
dtPCSorted.Columns.Add(myDataColumn9)
Dim myDataColumn11 As DataColumn = New DataColumn
myDataColumn11.DataType = System.Type.GetType("System.String")
myDataColumn11.ColumnName = "CRITICAL"
myDataColumn11.ReadOnly = True
myDataColumn11.Unique = False
dtPCSorted.Columns.Add(myDataColumn11)
Dim myDataColumn12 As DataColumn = New DataColumn
myDataColumn12.DataType = System.Type.GetType("System.DateTime")
myDataColumn12.ColumnName = "PROMISED_DATE"
myDataColumn12.ReadOnly = True
myDataColumn12.Unique = False
dtPCSorted.Columns.Add(myDataColumn12)
Dim myDataColumn13 As DataColumn = New DataColumn
myDataColumn13.DataType = System.Type.GetType("System.Int32")
myDataColumn13.ColumnName = "PROMISED_QUANTITY"
myDataColumn13.ReadOnly = True
myDataColumn13.Unique = False
dtPCSorted.Columns.Add(myDataColumn13)
Dim myDataColumn14 As DataColumn = New DataColumn
myDataColumn14.DataType = System.Type.GetType("System.String")
myDataColumn14.ColumnName = "COMMENTS"
myDataColumn14.ReadOnly = True
myDataColumn14.Unique = False
dtPCSorted.Columns.Add(myDataColumn14)
Dim myDataColumn15 As DataColumn = New DataColumn
myDataColumn15.DataType = System.Type.GetType("System.String")
myDataColumn15.ColumnName = "PERSON_RESP"
myDataColumn15.ReadOnly = True
myDataColumn15.Unique = False
dtPCSorted.Columns.Add(myDataColumn15)
Dim myDataColumn16 As DataColumn = New DataColumn
myDataColumn16.DataType = System.Type.GetType("System.Int32")
myDataColumn16.ColumnName = "LTA_QUANTITY"
myDataColumn16.ReadOnly = True
myDataColumn16.Unique = False
dtPCSorted.Columns.Add(myDataColumn16)
Dim myDataColumn17 As DataColumn = New DataColumn
myDataColumn17.DataType = System.Type.GetType("System.DateTime")
myDataColumn17.ColumnName = "LT_DEMAND_DATE"
myDataColumn17.ReadOnly = True
myDataColumn17.Unique = False
dtPCSorted.Columns.Add(myDataColumn17)
Dim myDataColumn18 As DataColumn = New DataColumn
myDataColumn18.DataType = System.Type.GetType("System.Int32")
myDataColumn18.ColumnName = "LT_DEMAND"
myDataColumn18.ReadOnly = True
myDataColumn18.Unique = False
dtPCSorted.Columns.Add(myDataColumn18)
Dim myDataColumn19 As DataColumn = New DataColumn
myDataColumn19.DataType = System.Type.GetType("System.String")
myDataColumn19.ColumnName = "NEWEST_JOB"
myDataColumn19.ReadOnly = True
myDataColumn19.Unique = False
dtPCSorted.Columns.Add(myDataColumn19)
Dim myDataColumn20 As DataColumn = New DataColumn
myDataColumn20.DataType = System.Type.GetType("System.Double")
myDataColumn20.ColumnName = "PROFIT"
myDataColumn20.ReadOnly = True
myDataColumn20.Unique = False
dtPCSorted.Columns.Add(myDataColumn20)
Dim myDataColumn21 As DataColumn = New DataColumn
myDataColumn21.DataType = System.Type.GetType("System.Int32")
myDataColumn21.ColumnName = "DEMAND_6MONTHS"
myDataColumn21.ReadOnly = True
myDataColumn21.Unique = False
dtPCSorted.Columns.Add(myDataColumn21)
Dim myDataColumn22 As DataColumn = New DataColumn
myDataColumn22.DataType = System.Type.GetType("System.Int32")
myDataColumn22.ColumnName = "DEMAND_12MONTHS"
myDataColumn22.ReadOnly = True
myDataColumn22.Unique = False
dtPCSorted.Columns.Add(myDataColumn22)
Dim myDataColumn23 As DataColumn = New DataColumn
myDataColumn23.DataType = System.Type.GetType("System.Int32")
myDataColumn23.ColumnName = "NEWEST_JOB_QTY"
myDataColumn23.ReadOnly = True
myDataColumn23.Unique = False
dtPCSorted.Columns.Add(myDataColumn23)
Dim myDataColumn24 As DataColumn = New DataColumn
myDataColumn24.DataType = System.Type.GetType("System.String")
myDataColumn24.ColumnName = "LT"
myDataColumn24.ReadOnly = True
myDataColumn24.Unique = False
dtPCSorted.Columns.Add(myDataColumn24)
Dim myDataColumn25 As DataColumn = New DataColumn
myDataColumn25.DataType = System.Type.GetType("System.Double")
myDataColumn25.ColumnName = "MIN_EOQ"
myDataColumn25.ReadOnly = True
myDataColumn25.Unique = False
dtPCSorted.Columns.Add(myDataColumn25)
Dim myDataColumn26 As DataColumn = New DataColumn
myDataColumn26.DataType = System.Type.GetType("System.String")
myDataColumn26.ColumnName = "EXPIRE_DATE"
myDataColumn26.ReadOnly = True
myDataColumn26.Unique = False
dtPCSorted.Columns.Add(myDataColumn26)
Dim myDataColumn27 As DataColumn = New DataColumn
myDataColumn27.DataType = System.Type.GetType("System.String")
myDataColumn27.ColumnName = "PROGRAM"
myDataColumn27.ReadOnly = True
myDataColumn27.Unique = False
dtPCSorted.Columns.Add(myDataColumn27)
'Dim PrimaryKeyColumns(1) As DataColumn
'PrimaryKeyColumns(0) = dtPCSorted.Columns("SORT_ORDER")
'dtPCSorted.PrimaryKey = PrimaryKeyColumns
End Sub
Private Sub popdtPCSorted(ByVal ReportType As String, SortbyPart As Boolean)
Dim PCDV As DataView
dtPCSorted.Clear()
Select Case ReportType
Case "CRITICAL"
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Case "PRODUCTIONPLANNINGLT"
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"DEPLETION_DATE, MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Case Else
If SortbyPart = False Then
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"DEMAND_DATE, MATERIAL, JOB", _
DataViewRowState.CurrentRows)
Else
PCDV = New DataView(dsPC.Tables("PRODUCTIONCONTROL"), _
"MATERIAL <> ''", _
"MATERIAL, DEMAND_DATE, JOB", _
DataViewRowState.CurrentRows)
End If
End Select
Dim myDRV As DataRowView
Dim i, InProcess, LT, Stock, Demand, LTAQty, Demand6Months, Demand12Months, _
MakeQuantity, CompletedQuantity, PromisedQty, NewestJobQty, LTDemand As Int64
Dim Profit, MinEOQ As Double
Dim Material, NewestJob, Job, Routing, Deliveries, PersonResp, Comments, Critical, ExpireDate, CriticalColor, Program As String
Dim LTDemandDate, DepletionDate, PromisedDate, DemandDate As Date
i = 1
For Each myDRV In PCDV
Material = myDRV("MATERIAL")
Program = myDRV("PROGRAM")
CriticalColor = IIf(IsDBNull(myDRV("COLOR")), "BLACK", myDRV("COLOR"))
If Not IsDBNull(myDRV("MIN_EOQ")) Then
MinEOQ = myDRV("MIN_EOQ")
End If
Demand = myDRV("DEMAND")
Stock = myDRV("STOCK")
NewestJob = myDRV("NEWEST_JOB")
InProcess = myDRV("IN_PROCESS")
LTAQty = myDRV("LTA_QUANTITY")
Demand6Months = myDRV("DEMAND_6MONTHS")
Demand12Months = myDRV("DEMAND_12MONTHS")
LTDemandDate = myDRV("LT_DEMAND_DATE")
ExpireDate = myDRV("EXPIRE_DATE")
If ReportType = "CRITICAL" Then
DepletionDate = myDRV("DEMAND_DATE")
Else
DepletionDate = myDRV("DEPLETION_DATE")
End If
Job = myDRV("JOB")
MakeQuantity = myDRV("MAKE_QUANTITY")
CompletedQuantity = myDRV("COMPLETED_QUANTITY")
If IsDBNull(myDRV("ROUTING")) Then
Routing = " "
Else
Routing = myDRV("ROUTING")
End If
Deliveries = myDRV("DELIVERIES")
DemandDate = myDRV("DEMAND_DATE")
Profit = myDRV("PROFIT")
Critical = myDRV("CRITICAL")
If IsDBNull(myDRV("PERSON_RESP")) Then
PersonResp = "X"
Else
PersonResp = myDRV("PERSON_RESP")
End If
If IsDBNull(myDRV("COMMENTS")) Then
Comments = "X"
Else
Comments = myDRV("COMMENTS")
End If
PromisedQty = myDRV("PROMISED_QUANTITY")
If IsDBNull(myDRV("PROMISED_DATE")) Then
PromisedDate = Nothing
Else
PromisedDate = myDRV("PROMISED_DATE")
End If
LTDemand = myDRV("LT_DEMAND")
NewestJobQty = myDRV("NEWEST_JOB_QTY")
LT = myDRV("LT")
insertDTRecord(Material, Stock, Demand, NewestJob, InProcess, LTAQty, Demand6Months, _
Demand12Months, LTDemandDate, DepletionDate, Job, MakeQuantity, _
CompletedQuantity, Routing, Deliveries, DemandDate, Profit, _
Critical, PersonResp, Comments, PromisedQty, PromisedDate, LTDemand, _
NewestJobQty, LT, Program, ExpireDate, dtPCSorted, CriticalColor, i)
i = i + 1
Next
myDRV = Nothing
End Sub
Function getSortDate(ByVal inDate As Date) As Date
Dim strYear, strMonth, strDay As String
strYear = Trim(Str(DatePart(DateInterval.Year, inDate)))
Dim numMonth As Int64 = DatePart(DateInterval.Month, inDate)
Dim numDay As Int64 = DatePart(DateInterval.Day, inDate)
If numMonth < 10 Then
strMonth = "0" & Trim(Str(numMonth))
Else
strMonth = Trim(Str(numMonth))
End If
If numDay < 10 Then
strDay = "0" & Trim(Str(numDay))
Else
strDay = Trim(Str(numDay))
End If
getSortDate = strYear & strMonth & strDay
End Function
Private Sub btnrptProductionControl_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnrptProductionControl.Click
Dim sortByPart As Boolean
If cbSortByPart.Checked Then
sortByPart = True
Else
sortByPart = False
End If
Dim tStartDate As String = txtStartDate.Text
Dim tEndDate As String = txtEndDate.Text
dsPC.Clear()
If tStartDate = "" Or tEndDate = "" Then
MsgBox("Please enter valid start and end dates.")
Else
If Not IsDate(tStartDate) Or Not IsDate(tEndDate) Then
MsgBox("Please enter valid start and stop dates.")
Else
popdtPC(Convert.ToDateTime(tStartDate), Convert.ToDateTime(tEndDate), "PRODUCTIONCONTROL", sortByPart)
Dim myfrm As New afrmReportPreview(afrmReportPreview.ReportType.rptProductionControl, dsPC)
myfrm.ShowDialog()
End If
End If
End Sub

How can I get my filters to work on Access?

I'm trying to filter through forms with this code that used to work in access 2000 and now doesn't work. I've inherited a really old database and am in the process of rebuilding it bit by bit but I'm trying to get the old one to continue working while I finish this one.
This is the VBA Code
Public Function SpecialLoadAndPopulateTheFilterForm(strBaseTable As String)
Dim strFilterFormName As String
Dim frm As Form
strFilterFormName = "frm" & strBaseTable & "Filter"
DoCmd.OpenForm strFilterFormName
Set frm = Forms(strFilterFormName)
frm!optnOpen = CBool(Nz(INIGetSettingString(strBaseTable & " Filter", "Open", gcnstStrSRCiniPath, "True"), "True"))
frm!optnClose = CBool(Nz(INIGetSettingString(strBaseTable & " Filter", "Close", gcnstStrSRCiniPath, "True"), "True"))
frm!optnHold = CBool(Nz(INIGetSettingString(strBaseTable & " Filter", "Hold", gcnstStrSRCiniPath, "False"), "False"))
If strBaseTable = "Employees" Then
Dim bolValue As Boolean
Dim ctlList As Control
Dim intRow As Integer
Set ctlList = frm!lstEmpTypeFilter
For intRow = 0 To ctlList.ListCount - 1
bolValue = CBool(Nz(INIGetSettingString(strBaseTable & " Types Filter", Trim(CStr(ctlList.Column(1, intRow))), _
gcnstStrSRCiniPath, "False"), "False"))
ctlList.Selected(intRow) = bolValue
Next intRow
End If
End Function

More efficient method for string parsing?

First part of the code is to retrieve data from the web. It takes only a part of the second to complete the request. Second part of the code is to split data so that parts of data can be shown in different labels and it takes around 5-6 second to complete this operation?
Why is that? Can it be done faster?
First part of the code (textbox1 key down event)
If e.KeyCode = Keys.Enter Then
TextBox1.Text = UCase(TextBox1.Text)
If TextBox1.Text = "" Then
GoTo exx
Else
Dim strURL As String
Dim strSymbol As String = TextBox1.Text
strURL = " http://quote.yahoo.com/d/quotes.csv?" & _
"s=" & strSymbol & _
"&d=t" & _
"&f=snl1pmwvj1l1"
MessageBox.Show(RequestWebData(strURL))
Second part of the code and functions :
Label24.Text = (GetName2(RequestWebData(strURL), 3))
Dim myText = Label24.Text
Dim dIndex = myText.IndexOf("Inc.")
If (dIndex > -1) Then
Label24.Text = (Strings.Left(Label24.Text, dIndex + 4))
Else
Label24.Text = (Label24.Text)
End If
Dim myText2 = Label24.Text
Dim dIndex2 = myText2.IndexOf("Common")
If (dIndex2 > -1) Then
Label24.Text = (Label24.Text.Replace("Common", ""))
Else
Label24.Text = (Label24.Text)
End If
Label6.Text = (GetName(RequestWebData(strURL), 4))
Label6.Text = (GetName3(Label6.Text, 1))
Label6.Text = FormatNumber(Label6.Text, 2)
Label17.Text = (GetName(RequestWebData(strURL), 5))
Label21.Text = (GetName(RequestWebData(strURL), 7))
Dim x As String = GetName(RequestWebData(strURL), 8)
Label30.Text = GetName3(x, 1)
Label30.Text = FormatNumber(Label30.Text, 0)
Label32.Text = GetName3(x, 2)
TextBox2.Focus()
Function GetName(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split(""",")(i)
End Function
Function GetName2(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split("""")(i)
End Function
Function GetName3(ByVal LineIn As String, ByVal i As Integer) As String
'Dim x As Integer
Return LineIn.Split(",")(i)
End Function
Maybe it is so slow because of these three functions that I am using to split data?

WHERE IN clause using VB.NET in Entity Framework

I have two CheckboxLists. Based on the items checked, the checked values are concatenated into a comma separated string and passed to my entity framework method. The result would be a List(Of Entity).
I want to convert
SELECT *
FROM dbo.Findings /*Below criteria is added only if any of the values are checked*/
WHERE FindingCategoryId IN (<Checked Values>)
AND FindingSeverityId IN (<CheckBoxValues>)
I am unable to find an equivalent for IN for VB.Net in EF.
I looked at the C# post here and came up with the below code. I get an error as
Unable to create a constant value of type 'System.Object'. Only primitive types ('such as Int32, String, and Guid') are supported in this context.
How can I use the IN clause in Vb.Net? Any help is appreciated.
My code:
Public Function Findings(ByVal findingSeverity As String, ByVal findingCategory As String) As List(Of Finding)
Dim aTypeLoanId As Integer = If(Not IsNothing(AuditTypeLoanId), AuditTypeLoanId, -1)
Dim findingTargetId = CInt(FindingTarget.LoanHeader)
Using e As New LQCEntities()
Dim result = (From f In e.FindingEntities _
From hmd In e.HeaderMetaDataEntities.Where(Function(h) h.MetaDataId = f.TargetId).DefaultIfEmpty() _
From cl In e.CheckListEntities.Where(Function(c) c.CheckListId = f.TargetId).DefaultIfEmpty() _
Where f.AuditTypeLoanId = aTypeLoanId _
Select New Finding With _
{
.FindingId = f.FindingId, _
.FindingCategoryId = f.FindingCategoryId, _
.FindingSeverityId = f.FindingSeverityId, _
.EnteredBy = f.ADUser.DisplayName, _
.EnteredDate = f.EnteredDate _
})
Dim fsArray() = Nothing
Dim fcArray() = Nothing
If (Not String.IsNullOrEmpty(findingSeverity)) Then
Dim fs = findingSeverity.Split(",")
For i As Integer = 0 To fs.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fs(i), j)) Then
ReDim Preserve fsArray(i)
fsArray(i) = j
End If
Next
If (fsArray.Count > 0) Then
result = result.Where(Function(i) fsArray.Contains(i.FindingSeverityId))
End If
End If
If (Not String.IsNullOrEmpty(findingCategory)) Then
Dim fc = findingCategory.Split(",")
For i As Integer = 0 To fc.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fc(i), j)) Then
ReDim Preserve fcArray(i)
fcArray(i) = j
End If
Next
If (fcArray.Count > 0) Then
result = result.Where(Function(i) fcArray.Contains(i.FindingCategoryId))
End If
End If
Return result.ToList()
End Using
End Function
I changed the fsArray and fcArray to a List(Of Integer) and it worked.
Code is as below:
Public Function Findings(ByVal findingSeverity As String, ByVal findingCategory As String) As List(Of Finding)
Dim aTypeLoanId As Integer = If(Not IsNothing(AuditTypeLoanId), AuditTypeLoanId, -1)
Dim findingTargetId = CInt(FindingTarget.LoanHeader)
Using e As New LQCEntities()
Dim result = (From f In e.FindingEntities _
From hmd In e.HeaderMetaDataEntities.Where(Function(h) h.MetaDataId = f.TargetId).DefaultIfEmpty() _
From cl In e.CheckListEntities.Where(Function(c) c.CheckListId = f.TargetId).DefaultIfEmpty() _
Where f.AuditTypeLoanId = aTypeLoanId _
Select New Finding With _
{
.FindingId = f.FindingId, _
.AuditTypeLoanId = f.AuditTypeLoanId, _
.FindingCategoryId = f.FindingCategoryId, _
.CategoryDescription = f.FindingCategory.CategoryDescription, _
.FindingSeverityId = f.FindingSeverityId, _
.SeverityDescription = f.FindingSeverity.SeverityDescription, _
.TargetId = f.TargetId, _
.UserResponse = f.UserResponse, _
.Field = If(f.FindingTargetId = findingTargetId, hmd.ColumnDescription, cl.CheckListDesc), _
.OldValue = f.OldValue, _
.NewValue = f.NewValue, _
.Comments = f.Comments, _
.EnteredBy = f.ADUser.DisplayName, _
.EnteredDate = f.EnteredDate _
})
If (Not String.IsNullOrEmpty(findingSeverity)) Then
Dim fsList As New List(Of Integer)
Dim fs = findingSeverity.Split(",")
For i As Integer = 0 To fs.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fs(i), j)) Then
fsList.Add(j)
End If
Next
If (fsList.Count > 0) Then
result = result.Where(Function(i) fsList.Contains(i.FindingSeverityId))
End If
End If
If (Not String.IsNullOrEmpty(findingCategory)) Then
Dim fc = findingCategory.Split(",")
Dim fcList As New List(Of Integer)
For i As Integer = 0 To fc.Count - 1
Dim j As Integer = 0
If (Integer.TryParse(fc(i), j)) Then
fcList.Add(j)
End If
Next
If (fcList.Count > 0) Then
result = result.Where(Function(i) fcList.Contains(i.FindingCategoryId))
End If
End If
Return result.ToList()
End Using
End Function

Not saving .txt file in vb.net

Cutting to the chase:
Function Create(ByVal network, ByVal location, ByVal type, ByVal requirement1, ByVal requirement2, ByVal requirement3, ByVal name)
Dim net As String = network
Dim loc As String = location
Dim typ As String = type
Dim nam As String = name
Dim req1 As String = requirement1
Dim req2 As String = requirement2
Dim req3 As String = requirement3
Dim Mission As New System.IO.StreamWriter("C:\" & nam & ".txt")
Mission.WriteLine("Name: " & net)
Mission.WriteLine("Network: " & net)
Mission.WriteLine("Location: " & loc)
Mission.WriteLine("Type: " & typ)
Mission.WriteLine("Requirement: " & req1)
Mission.WriteLine("Requirement: " & req2)
Mission.WriteLine("Requirement: " & req3)
Mission.Close()
Console.WriteLine("Written")
System.Threading.Thread.Sleep(3000)
End Function
No errors appear, but neither does the file in the filepath. I have it all declared when I call the function, so I know that its not the problem.
Help? :)
Sub Create(ByVal network As String, ByVal location As String,
ByVal type As String, ByVal requirement1 As String,
ByVal requirement2 As String, ByVal requirement3 As String,
ByVal name As String)
Dim net As String = network
Dim loc As String = location
Dim typ As String = type
Dim nam As String = name
Dim req1 As String = requirement1
Dim req2 As String = requirement2
Dim req3 As String = requirement3
If Not nam.EndsWith(".txt") Then
nam &= ".txt"
End If
Dim Mission As New System.IO.StreamWriter(Path.Combine(
System.Environment.GetFolderPath(
System.Environment.SpecialFolder.Desktop), nam))
Mission.WriteLine("Name: " & net)
Mission.WriteLine("Network: " & net)
Mission.WriteLine("Location: " & loc)
Mission.WriteLine("Type: " & typ)
Mission.WriteLine("Requirement: " & req1)
Mission.WriteLine("Requirement: " & req2)
Mission.WriteLine("Requirement: " & req3)
Mission.Close()
Console.WriteLine("Written")
'System.Threading.Thread.Sleep(3000)
End Sub
first of all pal, you were passing the parameters as objects!!, second you dont have permission to save to c root directory unless you have administrator privilege, third the threading part at the end is completely useless, its blocking the UI and don't add up to any benefit.
at last but not least.
good luck