'--------------Job No 0900408 --------------
'--DIM PART ONE ONLINE Update Order Qty
'''主要新加過程名 RefreshOrderQty() 用于每次查詢即時更新數據源中的Lot Qty，保持與Protex的一致
'-Add by Shiny Dong
Imports System.IO
Imports Microsoft.VisualBasic
Imports Microsoft.Win32
Imports System.Text.RegularExpressions Namespace BogartMis.Cls Public Class gSub
Private Const mSTRALL = "<ALL>" '該方法是用來填充列表框的選項
Public Overloads Sub FillYYMM(ByVal cbo As ComboBox, Optional ByVal Droplist As ComboBoxStyle = ComboBoxStyle.DropDownList, Optional ByVal FirstEmpty As Boolean = True)
Try
With cbo
Dim y As Integer
Dim m As Integer
.Items.Clear()
.DropDownStyle = Droplist
If FirstEmpty = True Then
.Items.Add("")
End If
For y = Now.AddYears().Year To Step -
For m = To Step -
.Items.Add(y & "-" & IIf(m.ToString.Length = , "" & m, m))
Next
Next
End With
Catch ex As Exception
End Try
End Sub #Region "填充下拉選擇框的方法"
Public Overloads Sub FillComboBox(ByVal cbo As ComboBox, ByVal strSQL As String, ByVal aConn As ADODB.Connection, Optional ByVal CustomValue As String = "", Optional ByVal SelectIndex As Integer = )
Try Dim i As Integer
Dim rs As New ADODB.Recordset
rs.Open(strSQL, aConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
If rs.RecordCount > Then
cbo.Items.Clear()
With cbo
If CustomValue.Trim.Length > Then
.Items.Add(CustomValue)
End If
For i = To rs.RecordCount -
.Items.Add(Trim(rs.Fields().Value))
rs.MoveNext()
Next i
If .Items.Count >= SelectIndex Then
.SelectedIndex = SelectIndex
End If
End With
End If
Catch
End Try
End Sub Public Overloads Sub FillComboBox(ByVal cbo As ComboBox, ByVal Arrary As String(), Optional ByVal SelectIndex As Integer = )
Try
Dim value As String
With cbo
.Items.Clear()
For Each value In Arrary
.Items.Add(value)
Next
If .Items.Count >= SelectIndex Then
.SelectedIndex = SelectIndex
End If
End With
Catch
End Try
End Sub Public Overloads Sub FillComboBox(ByVal rs As ADODB.Recordset, ByVal cbo As ComboBox, Optional ByVal FieldIndex As Integer = , Optional ByVal AddALL As Boolean = False, Optional ByVal SelectIndex As Integer = )
Try
'將recordset的資料填充給combobox
cbo.Items.Clear()
If rs.RecordCount > Then
While Not rs.EOF
If Not IsDBNull(rs.Fields(FieldIndex).Value) Then
cbo.Items.Add(rs.Fields(FieldIndex).Value)
End If
rs.MoveNext()
End While
End If If AddALL = True Then
cbo.Items.Insert(, mSTRALL)
End If
If cbo.Items.Count >= SelectIndex Then
cbo.SelectedIndex = SelectIndex
End If
Catch
End Try
End Sub Public Overloads Sub FillComboBox(ByVal netView As DataView, ByVal cbo As ComboBox, Optional ByVal ColumnsIndex As Integer = , Optional ByVal AddALL As Boolean = False, Optional ByVal SelectIndex As Integer = )
Try
'將recordset的資料填充給combobox
cbo.Items.Clear()
Dim i As Integer
If netView.Count > Then
For i = To netView.Count
If Not IsDBNull(netView(i)(ColumnsIndex)) Then
cbo.Items.Add(netView(i)(ColumnsIndex))
End If
Next
End If
If AddALL = True Then
cbo.Items.Insert(, mSTRALL)
End If
If cbo.Items.Count >= SelectIndex Then
cbo.SelectedIndex = SelectIndex
End If
Catch
End Try
End Sub
#End Region #Region "填充下拉列選框的方法"
'該方法是用來填充列表框的選項
Public Overloads Sub FillListbox(ByVal lstBox As ListBox, ByVal strSQL As String, ByVal aConn As ADODB.Connection, Optional ByVal SelectIndex As Integer = )
Try
Dim i As Integer
Dim rs As New ADODB.Recordset
rs.Open(strSQL, aConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
lstBox.Items.Clear()
If rs.RecordCount > Then
For i = To rs.RecordCount -
With lstBox
.Items.Add(Trim(rs.Fields().Value))
End With
rs.MoveNext()
Next i
End If
If lstBox.Items.Count >= SelectIndex Then
lstBox.SelectedIndex = SelectIndex
End If
Catch
Exit Sub
End Try
End Sub '該方法是用來填充列表框的選項
Public Overloads Sub FillListbox(ByVal lstBox As ListBox, ByVal DataV As DataView, Optional ByVal ColumnsIndex As Integer = , Optional ByVal SelectIndex As Integer = )
Try
Dim netRow As DataRowView
With lstBox
.Items.Clear()
For Each netRow In DataV.Table.Rows
.Items.Add(Trim(netRow.Item(ColumnsIndex)))
Next
If lstBox.Items.Count >= SelectIndex Then
lstBox.SelectedIndex = SelectIndex
End If
End With
Catch
Exit Sub
End Try
End Sub #End Region #Region "填充CheckListBox的方法"
'該方法是用來填充check列表框的選項
Public Sub FillCheckListbox(ByVal chklistBox As CheckedListBox, ByVal strSQL As String, ByVal aConn As ADODB.Connection)
Try
Dim i As Integer
Dim rs As New ADODB.Recordset
rs.Open(strSQL, adoConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
chklistBox.Items.Clear()
If rs.RecordCount > Then
For i = To rs.RecordCount -
With chklistBox
.Items.Add(Trim(rs.Fields().Value))
End With
rs.MoveNext()
Next i
chklistBox.SelectedIndex =
End If
Catch
Exit Sub
End Try
End Sub
#End Region '設定窗體及內部相關控件的語言類型
'隻對窗體標題及內部label,combobox,CheckBox,RadioButton控件起作用，
'對其它控件無效
Public Sub setFromLanguage(ByVal frm As Form, Optional ByVal grp As GroupBox = Nothing, Optional ByVal pal As Panel = Nothing, Optional ByVal tabC As TabControl = Nothing)
On Error Resume Next Dim CT As Control
Dim strField As String = "*"
If g.gLanguage = LanguageType.English Then
strField = "eText"
ElseIf g.gLanguage = LanguageType.Simple Then
strField = "sText"
Else
strField = "tText"
End If
For Each CT In frm.Controls
Dim strSQL As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='" & CT.Name.Trim.ToLower & "'"
If (TypeOf CT Is Label) Or (TypeOf CT Is Button) Or (TypeOf CT Is CheckBox) Or (TypeOf CT Is RadioButton) Or (TypeOf CT Is TextBox) Then
'如此控件名存在多語言時些取相關語言
Dim strK As String = gData.selectValue(strSQL, adoConn)
CT.Text = IIf(strK = "", CT.Text, strK)
End If
Next If Not grp Is Nothing Then
For Each CT In grp.Controls
Dim strSQL As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='" & CT.Name.Trim.ToLower & "'"
If (TypeOf CT Is Label) Or (TypeOf CT Is Button) Or (TypeOf CT Is CheckBox) Or (TypeOf CT Is RadioButton) Or (TypeOf CT Is TextBox) Or (TypeOf CT Is GroupBox) Then
'如此控件名存在多語言時些取相關語言
Dim strK As String = gData.selectValue(strSQL, adoConn)
CT.Text = IIf(strK = "", CT.Text, strK)
End If
Next
End If
If Not pal Is Nothing Then
For Each CT In pal.Controls
Dim strSQL As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='" & CT.Name.Trim.ToLower & "'"
If (TypeOf CT Is Label) Or (TypeOf CT Is Button) Or (TypeOf CT Is CheckBox) Or (TypeOf CT Is RadioButton) Or (TypeOf CT Is TextBox) Or (TypeOf CT Is GroupBox) Then
'如此控件名存在多語言時些取相關語言
Dim strK As String = gData.selectValue(strSQL, adoConn)
CT.Text = IIf(strK = "", CT.Text, strK)
End If
Next
End If
If Not tabC Is Nothing Then
For Each CT In tabC.Controls
Dim strSQL As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='" & CT.Name.Trim.ToLower & "'"
Dim strK As String = gData.selectValue(strSQL, adoConn)
CT.Text = IIf(strK = "", CT.Text, strK)
Dim tabP As TabPage = CType(CT, TabPage)
Dim ct2 As Control
For Each ct2 In tabP.Controls
Dim strSQL2 As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='" & ct2.Name.Trim.ToLower & "'"
If (TypeOf ct2 Is Label) Or (TypeOf ct2 Is Button) Or (TypeOf ct2 Is CheckBox) Or (TypeOf ct2 Is RadioButton) Or (TypeOf ct2 Is TextBox) Or (TypeOf ct2 Is GroupBox) Then
'如此控件名存在多語言時些取相關語言
Dim strK2 As String = gData.selectValue(strSQL2, adoConn)
ct2.Text = IIf(strK2 = "", ct2.Text, strK2)
End If
Next
Next
End If
Dim strsqlk As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & frm.Name.Trim.ToLower & "' and lower(controlName)='me'"
Dim strT As String = gData.selectValue(strsqlk, adoConn)
frm.Text = IIf(strT = "", frm.Text, strT) End Sub '設定單個控件（或控件子項）的語言類型
Public Function setControlLanguage(ByVal strFormName As String, ByVal ControlName As String, Optional ByVal strDefault As String = "NoFound") As String
On Error Resume Next Dim strField As String = "*"
If g.gLanguage = LanguageType.English Then
strField = "eText"
ElseIf g.gLanguage = LanguageType.Simple Then
strField = "sText"
Else
strField = "tText"
End If
Dim strSQLk As String = "select " & strField & " from " & g.gRptdev & "g_language where lower(formname)='" & strFormName.Trim.ToLower & "' and lower(controlName)='" & ControlName.ToLower & "'"
Return IIf(gData.selectValue(strSQLk, adoConn) = "", strDefault, gData.selectValue(strSQLk, adoConn)) End Function '自定義的信息框，因為.net自帶的無多語言顯示功能
'該方法得結合數據庫中的g_message表的數據
Public Function myMsg(ByVal MsgId As Integer, Optional ByVal Buttons As MsgBoxStyle = MsgBoxStyle.SystemModal) As MsgBoxResult
Try
Dim strField As String = "*"
If g.gLanguage = LanguageType.English Then
strField = "msgeText"
ElseIf g.gLanguage = LanguageType.Simple Then
strField = "msgsText"
Else
strField = "msgtText"
End If Dim strSQL As String = "select " & strField & " from " & g.gRptdev & "g_message where msgid=" & MsgId
Dim strMsg As String = gData.selectValue(strSQL, adoConn)
If strMsg.Trim.Length > Then
Return MsgBox(strMsg.Trim, Buttons, "MsgNo." & MsgId.ToString)
Else
Return MsgBox("This Message not setting!", MsgBoxStyle.Critical, "MsgNo." & "")
End If
Catch ex As Exception
Exit Function
End Try
End Function '用來設定主窗體的狀態欄中的提示信息
Public Sub setPrompt(ByVal strTxt As String)
Try
gMainForm.StatusBar1.Panels().Text = strTxt.Trim
Catch ex As Exception
Exit Sub
End Try
End Sub '根據給定的字段名，其type生成所需的where條件
'type為針對的類型，為true時顯示的為客戶資料，其它的為供應商資料
Public Overloads Function getWhere(ByVal strField As String, Optional ByVal Type As WhereType = WhereType.Customer) As String
Try
Dim strWhere As String
Dim decAll As Integer
Dim SQL_C As String = "select ekey from orfexe"
Select Case Type
Case WhereType.Customer
decAll = gData.selectValue("select allcust from " & g.gRptdev & "g_userid where userid='" & g.gUserId & "'", adoConn)
If decAll = Then '如果為1的話表當前用戶擁有全部的客戶或供應商。
strWhere = "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (select info from " & g.gRptdev & "g_userpower where trim(userid)='" & g.gUserId.Trim & "' and trim(item)='customer' and curlib='" & g.gLibrary & "'))"
Else
strWhere = "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (" & SQL_C & "))"
End If
SQL_C = "select ekey from orfexe"
Case WhereType.Supplier
decAll = gData.selectValue("select allsupp from " & g.gRptdev & "g_userid where userid='" & g.gUserId & "'", adoConn)
SQL_C = "select skey from imfexea"
If decAll = Then '如果為1的話表當前用戶擁有全部的客戶或供應商。
strWhere = "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (select info from " & g.gRptdev & "g_userpower where trim(userid)='" & g.gUserId.Trim & "' and trim(item)='supplier' and curlib='" & g.gLibrary & "'))"
Else
strWhere = "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (" & SQL_C & "))"
End If
Case WhereType.ColourCustomer
SQL_C = "select ekey,COLOURTE from " & g.gRptdev & "g_cussv1"
Dim ekeyItem As String = ""
Dim netRow1 As DataRow
If g.gUserDeptId.Length > Then
For Each netRow1 In gData.GetDataTable(SQL_C, netConn).Rows
Dim netRow2 As DataRow
SQL_C = "select userid from " & g.gRptdev & "g_userid where deptid like '" & g.gUserDeptId & "%'"
For Each netRow2 In gData.GetDataTable(SQL_C, netConn).Rows
If Regex.IsMatch("," & netRow1.Item(), "," & netRow2.Item() & ",") = True Then
If ekeyItem.Length > Then
ekeyItem = ekeyItem & ",'" & netRow1.Item() & "'"
Else
ekeyItem = "'" & netRow1.Item() & "'"
End If
Exit For
End If
Next
Next
strWhere = "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (" & IIf(ekeyItem.Trim.Length = , "''", ekeyItem) & "))"
Else
strWhere = "1=1"
End If
End Select
Return strWhere.Trim
Catch ex As Exception
'MsgBox(ex.ToString)
Return "(trim(" & strField.Trim & ") is null or trim(" & strField.Trim & ") in (''))"
End Try
End Function '======================================================================
'Modified by Sanlita Han on 2009-04-14
'Description: Relevant changes of Lot Year Definition. eg. 2010=K, 2011=L......
'======================================================================
Public Overloads Function getLotDate(ByVal LotField As String) As String
Try
Dim i As Integer
Dim strW As String = ""
For i = To
Dim strT As String = "(case when substr(" & LotField & ",3,1)='" & Chr( + i) & "' then '" & IIf(CType(i, String).Length = , "" & i, i) & "' else xx end)"
If strW = "" Then
strW = Replace(strT, "xx", strT)
Else
strW = Replace(strW, "xx", strT)
End If
Next
strW = Replace(strW, "xx", "'12'") Dim strSQL01 As String = ""
For i = To
Dim strSQL02 As String = "(case when substr(" & LotField.Trim & ",2,1)='" & Chr( + i) & "' then '" & CStr(i + ) & "' else xx end)"
If strSQL01 = "" Then
strSQL01 = Replace(strSQL02, "xx", strSQL02)
Else
strSQL01 = Replace(strSQL01, "xx", strSQL02)
End If
Next
strSQL01 = Replace(strSQL01, "xx", "'25'") Dim strDate As String = "'20' || (case when substr(" & LotField.Trim & ",2,1) in('0','1','2','3','4','5','6','7','8','9') then '0'||substr(" & LotField.Trim & ",2,1) else " & strSQL01 & " end) || '-' || (case when substr(" & LotField.Trim & ",3,1) in('0','1','2','3','4','5','6','7','8','9')" & _
" then substr(" & LotField.Trim & ",3,2) else " & strW & " end)" Return strDate
Catch ex As Exception
Return ""
End Try
End Function Public Overloads Function getLotDateSHS(ByVal LotField As String) As String
Try
Dim i As Integer
Dim strW As String = ""
For i = To
Dim strT As String = "(case when substr(" & LotField & ",3,1)='" & Chr( + i) & "' then '" & IIf(CType(i, String).Length = , "" & i, i) & "' else xx end)"
If strW = "" Then
strW = Replace(strT, "xx", strT)
Else
strW = Replace(strW, "xx", strT)
End If
Next
strW = Replace(strW, "xx", "'12'") Dim strSQL01 As String = ""
For i = To
Dim strSQL02 As String = "(case when substr(" & LotField.Trim & ",2,1)='" & Chr( + i) & "' then '" & IIf(i + >= , CStr(i + ), "" & CStr(i + )) & "' else xx end)"
If strSQL01 = "" Then
strSQL01 = Replace(strSQL02, "xx", strSQL02)
Else
strSQL01 = Replace(strSQL01, "xx", strSQL02)
End If
Next
strSQL01 = Replace(strSQL01, "xx", "'23'") Dim strDate As String = "'20' || " & strSQL01 & " || '-' || (case when substr(" & LotField.Trim & ",3,1) in('0','1','2','3','4','5','6','7','8','9')" & _
" then substr(" & LotField.Trim & ",3,2) else " & strW & " end)" Return strDate
Catch ex As Exception
Return ""
End Try
End Function '======================================================================
'Modified by Sanlita Han on 2009-04-14
'Description: Relevant changes of Lot Year Definition. eg. 2010=K, 2011=L......
'======================================================================
Public Overloads Function DateToLot(ByVal yymm As String) As String
Try
If yymm.Trim.Length <> Then Return "" Dim y As String = Mid(yymm, , )
Dim yy As Integer = CType(Mid(yymm, , ), Integer)
Dim m As Integer = CType(Mid(yymm, , ), Integer)
If yy >= Then
Return Chr( + yy + ) & Chr( + m)
Else
Return y & Chr( + m)
End If
Catch ex As Exception
Return ""
End Try
End Function Public Overloads Function DateToLotSHS(ByVal yymm As String) As String
Try
If yymm.Trim.Length <> Then Return ""
If Mid(yymm, , ) & Mid(yymm, , ) < "" Then
yymm = "2008-01"
End If Dim y As String = Chr(IIf(CInt(Mid(yymm, , )) < , , CInt(Mid(yymm, , ))) - + )
Dim m As Integer = CType(Mid(yymm, , ), Integer)
Return y & Chr( + m)
Catch ex As Exception
Return ""
End Try
End Function '根據訂單號分解出此單所屬年月條件
Public Overloads Function FormatDate(ByVal fieldY As String, ByVal fieldM As String, ByVal fieldD As String) As String
Try
Dim strW As String = "substr(cast(date((cast(" & fieldY.Trim & " as varchar(4)) || '-' || cast(" & fieldM & " as varchar(2)) || '-' || cast(" & fieldD & " as varchar(2)))) as char(10)),3)"
Return strW
Catch ex As Exception
Return ""
End Try
End Function
'根據訂單號分解出此單所屬年月日時間 條件
Public Overloads Function FormatDateTime(ByVal fieldY As String, ByVal fieldM As String, ByVal fieldD As String, ByVal fieldT As String) As String
Try
' fieldT = 122512
Dim strW As String = "substr(cast((cast(" & fieldY.Trim & " as varchar(4)) || '-' || cast(" & fieldM & " as varchar(2)) || '-' || cast(" & fieldD & " as varchar(2)) || '-' || cast(" & fieldT & " as varchar(10))) as char(10)),3)"
Return strW
Catch ex As Exception
Return ""
End Try
End Function '根據訂單號分解出Location
Public Overloads Function FormatLocation(ByVal Loc1 As String, ByVal Loc2 As String, ByVal Loc3 As String, ByVal Loc4 As String) As String
Try
Dim strW As String strW = " cast(" & Loc1.Trim & " as varchar(2)) || cast(" & Loc2.Trim & " as varchar(2))|| cast(" & Loc3.Trim & " as varchar(2)) || cast(" & Loc4.Trim & " as varchar(2)) "
Return strW
Catch ex As Exception
Return ""
End Try
End Function '根據訂單號分解出此單所屬年月條件
Public Overloads Function FormatDate(ByVal fieldName As String) As String
Try
Dim strW As String
strW = strW & "('" & Year(Now).ToString.Substring(, ) & "' || substr(cast(" & fieldName & " as varchar(6)),length(cast(" & fieldName & " as varchar(6)))-1,2) || '-' || "
strW = strW & "substr(cast(" & fieldName & " as varchar(6)),length(cast(" & fieldName & " as varchar(6)))-3,2) || '-' || "
strW = strW & "( case when length(cast(rmpdat as varchar(6)))-4=1 then '0' || substr(cast(rmpdat as varchar(6)),1,length(cast(rmpdat as varchar(6)))-4)"
strW = strW & "else substr(cast(rmpdat as varchar(6)),1,length(cast(rmpdat as varchar(6)))-4) end)"
strW = strW & ")"
Return strW
Catch ex As Exception
Return ""
End Try
End Function '主要用來設定用戶的權限，針對有些用戶有權查看單價或數量，而有些用戶無權查看！
'使用方法是用在sql的select語句中
Public Overloads Function powerPrice(ByVal FieldName As String, ByVal PriceType As PriceType) As String
Try
If PriceType = PriceType.RMprice Then
If g.gRMprice = False Then
Return "'**'"
Exit Function
End If
ElseIf PriceType = PriceType.ProductPrice Then
If g.gPOprice = False Then
Return "'**'"
Exit Function
End If
Else
If g.gORprice = False Then
Return "'**'"
Exit Function
End If
End If
Return FieldName
Catch ex As Exception
Return FieldName
End Try
End Function '讀取注冊表中所設定的默認值
Public Function checkDefalueLayout(ByVal formname As String) As String
Try
Dim regK As RegistryKey
Dim regSK As RegistryKey
Dim regSubKEY As RegistryKey
regK = Registry.CurrentUser.OpenSubKey("Bogart")
regSK = regK.OpenSubKey("Layout")
Dim strLayout As String = regSK.GetValue(formname) '讀取錯誤時默認發送的郵箱
If strLayout Is Nothing Then
Return ""
Else
Return strLayout
End If
Catch ex As Exception
Return ""
End Try
End Function Public Function ReplaceSize(ByVal SizeName As String) As String
Try
Dim rsT As New ADODB.Recordset
Dim strSize As String = SizeName
rsT.Open("select * from " & g.gRptdev & "g_basic where typename='size'", adoConn)
Dim m As Integer
If rsT.RecordCount > Then
For m = To rsT.RecordCount -
strSize = Replace(strSize, rsT.Fields("info").Value, rsT.Fields("remark").Value)
rsT.MoveNext()
Next
End If
Return strSize
Catch ex As Exception
Return SizeName
End Try
End Function
'Added by SimonCheung on 2012/05/23
Public Function ReplaceFit(ByVal SizeName As String) As String
Try
Dim rsT As New ADODB.Recordset
Dim strSize As String = SizeName
rsT.Open("select * from " & g.gRptdev & "g_basic where typename='fit'", adoConn)
Dim m As Integer
If rsT.RecordCount > Then
For m = To rsT.RecordCount -
strSize = Replace(strSize, rsT.Fields("info").Value, rsT.Fields("remark").Value)
rsT.MoveNext()
Next
End If
Return strSize
Catch ex As Exception
Return SizeName
End Try
End Function Public Function GetLocationNameByCode(ByVal code As Int16) As String
Select Case code
Case
Return "Panyu, China"
Case
Return "Hongkong"
Case
Return "Thailand"
Case
Return "Shenzhen, China"
Case
Return "Brunet International"
Case Else
Return ""
End Select
End Function Public Sub SetExcelLogoAndHeader(ByVal xAppS As Excel.Application, ByVal StrReportID As String, ByVal StrTitle As String, Optional ByVal VH As Boolean = True)
Try
Dim T_Logo As DataTable = gData.GetDataTable("SELECT CompanyLogo FROM CompanyProfile WHERE CompanyCode = 'Bogart'", sqlConn)
If T_Logo.Rows.Count > Then Dim LogoFileName As String = Application.StartupPath & "\eLogo.jpg"
Dim TmpLogo As Bitmap = ChangeImageSize(CType(T_Logo.Rows().Item(), Byte()), , ) TmpLogo.Save(LogoFileName) With xAppS.ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
.PrintTitleColumns = ""
End With xAppS.ActiveSheet.PageSetup.CenterHeaderPicture.Filename = LogoFileName
xAppS.ActiveSheet.PageSetup.PrintArea = ""
If VH Then
With xAppS.ActiveSheet.PageSetup '''橫向顯示
.LeftHeader = "Report ID: " & StrReportID & Chr() & "Print By: " & g.gUserId
.CenterHeader = "&""Arial,Bold""&16&G" & Chr() & StrTitle
.RightHeader = "Print Date: &D &T" & Chr() & "Page &P of &N"
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = xAppS.InchesToPoints(0.748031496062992)
.RightMargin = xAppS.InchesToPoints(0.748031496062992)
.TopMargin = xAppS.InchesToPoints(1.18110236220472)
.BottomMargin = xAppS.InchesToPoints(0.984251968503937)
.HeaderMargin = xAppS.InchesToPoints(0.511811023622047)
.FooterMargin = xAppS.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = -
.PrintQuality =
.CenterHorizontally = False
.CenterVertically = False
.Orientation =
.Draft = False
.PaperSize =
.FirstPageNumber = -
.Order =
.BlackAndWhite = False
.Zoom =
.PrintErrors =
End With
Else
With xAppS.ActiveSheet.PageSetup '''縱向顯示
.LeftHeader = "Report ID: " & StrReportID & Chr() & "Print By: " & g.gUserId
.CenterHeader = "&""Arial,Bold""&16&G" & Chr() & StrTitle
.RightHeader = "Print Date: &D &T" & Chr() & "Page &P of &N"
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = xAppS.InchesToPoints(0.748031496062992)
.RightMargin = xAppS.InchesToPoints(0.748031496062992)
.TopMargin = xAppS.InchesToPoints(0.984251968503937)
.BottomMargin = xAppS.InchesToPoints(0.984251968503937)
.HeaderMargin = xAppS.InchesToPoints(0.511811023622047)
.FooterMargin = xAppS.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = -
.PrintQuality =
.CenterHorizontally = False
.CenterVertically = False
.Orientation =
.Draft = False
.PaperSize =
.FirstPageNumber = -
.Order =
.BlackAndWhite = False
.Zoom =
.PrintErrors =
End With
End If End If
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub Public Function ChangeImageSize(ByVal byF As Byte(), Optional ByVal x_W As Int16 = , Optional ByVal x_H As Int16 = ) As System.Drawing.Bitmap
Try
Dim ms As New IO.MemoryStream(byF)
Dim imgT As New PictureBox
imgT.SizeMode = PictureBoxSizeMode.AutoSize
imgT.Image = Image.FromStream(ms)
Dim bmp As New System.Drawing.Bitmap(x_W, x_H)
Dim grp As Graphics = Graphics.FromImage(bmp)
Dim blueBrush As New SolidBrush(Color.White)
grp.FillRectangle(blueBrush, , , x_W, x_H)
Dim intW As Single
Dim intH As Single
If imgT.Width > x_W Then
intW = x_W
intH = imgT.Height * (x_W / imgT.Width)
Else
intW = imgT.Width
intH = imgT.Height
End If
If intH > x_H Then
intH = x_H
intW = imgT.Width * (x_H / imgT.Height)
End If
grp.DrawImage(imgT.Image, (x_W - intW) / , (x_H - intH) / , intW, intH)
Return bmp
Catch ex As Exception
Return Nothing
End Try
End Function Public Function SetHashTable(ByVal TT As DataTable, ByVal A() As String) As DataTable
Dim HastH As New Hashtable
Dim TempT As New DataTable
Dim II As Int16
Dim StrTemp As String
For II = To A.Length -
TempT.Columns.Add(A(II))
If II = Then
StrTemp = A(II)
Else
StrTemp += "," & A(II)
End If
Next
Dim R As DataRow
For Each R In TT.Rows
Dim StrC As String = ""
For II = To A.Length -
StrC += StrTrim(R.Item(A(II)))
Next
If Not HastH.ContainsKey(StrC) Then
HastH.Add(StrC, "")
Dim RA As DataRow = TempT.NewRow
RA.BeginEdit()
For II = To A.Length -
RA.Item(A(II)) = R.Item(A(II))
Next
RA.EndEdit()
TempT.Rows.Add(RA)
End If
Next
Dim TempT1 As DataTable = TempT.Clone
Dim TempDV As DataView = TempT.DefaultView
TempDV.Sort = StrTemp
For Each Rv As DataRowView In TempDV
TempT1.Rows.Add(Rv.Row.ItemArray)
Next
Return TempT1
End Function
'-----------RefershOrderQty 參數T1要處理的Table，i_LotCount 每隔多少個Lol處理一次
Public Sub RefreshOrderQty(ByRef T1 As DataTable, ByVal i_LotCount As Int16, Optional ByVal b_ck_product As Boolean = True) ''''Job 0900408 T1 Base Table , i_LotCount Page Lot to select
Try
Dim s_Lot As String = ""
Dim HasT As DataTable = SetHashTable(T1, Split("LotNO", ","))
Dim TmpLot As New DataTable
Dim b_seadata As Boolean
Dim TmpLotRow As DataRow()
Dim ra As DataRow() = HasT.Select("lotno like ' %' or Lotno is null or Lotno ='' ")
For i As Int16 = To ra.Length -
ra(i).Delete()
Next
HasT.AcceptChanges()
Dim i_HasTCount As Integer = HasT.Rows.Count -
For i As Integer = To i_HasTCount
s_Lot += "'" & Convert.ToString(HasT.Rows(i).Item("Lotno")).Trim & "'" & ","
If i_LotCount = s_Lot.Split(",").Length - Then
b_seadata = True
Else
If s_Lot.Split(",").Length - = (i_HasTCount + ) Mod i_LotCount And (i_HasTCount + - I) <= i_LotCount Then
b_seadata = True
End If
End If
If b_seadata Then
s_Lot = GetInLot(s_Lot)
TmpLot = gData.GetDataTable("SELECT C.ORQ#1||'--'||P.SZ01,C.ORQ#2||'--'||P.SZ02,C.ORQ#3||'--'||P.SZ03,C.ORQ#4||'--'||P.SZ04,C.ORQ#5||'--'||P.SZ05,C.ORQ#6||'--'||P.SZ06,C.ORQ#7||'--'||P.SZ07,C.ORQ#8||'--'||P.SZ08,C.ORQ#9||'--'||P.SZ09,C.ORQ#10||'--'||P.SZ10,C.CSTORD,C1.DEG,H.CSCOMD,C.COM,C.SCLD,P.SCLS FROM PRODA201.ORFORDC C inner join PRODA201.PCFSCLC P ON P.SCL#=C.SCL# AND P.SCLS=C.SCLS INNER JOIN PRODA201.ORFLCCH H ON H.DEG=C.DEG AND H.CSTORD=C.CSTORD AND H.COM=C.COM INNER JOIN (SELECT CSTORD, MAX(DEG) DEG FROM PRODA201.ORFORDC WHERE CSTORD IN (" & s_Lot & ") GROUP BY CSTORD) C1 ON C.CSTORD = C1.CSTORD AND C.DEG = C1.DEG AND C.CSTORD IN (" & s_Lot & ") ", netConn)
For ii As Int16 = To s_Lot.Split(",").Length -
TmpLotRow = T1.Select("lotno=" & s_Lot.Split(",")(ii) & "")
For ii_s As Int16 = To TmpLotRow.Length -
If b_ck_product Then
GetLotQty(TmpLot, TmpLotRow(ii_s).Item("LOTNO"), TmpLotRow(ii_s).Item("PRODUCT"), TmpLotRow(ii_s).Item("CustColor"), TmpLotRow(ii_s).Item("PRODSIZE"), TmpLotRow(ii_s).Item("PRODFIT"), TmpLotRow(ii_s))
Else
GetLotQty(TmpLot, TmpLotRow(ii_s).Item("LOTNO"), "%", TmpLotRow(ii_s).Item("CustColor"), TmpLotRow(ii_s).Item("PRODSIZE"), TmpLotRow(ii_s).Item("PRODFIT"), TmpLotRow(ii_s))
End If Next
Next
s_Lot = ""
TmpLot.Clear()
b_seadata = False
End If
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub Private Sub GetLotQty(ByRef T2 As DataTable, ByVal CLot As String, ByVal Product As String, ByVal Color As String, ByVal ProdSize As String, ByVal ProdFit As String, ByRef R As DataRow)
Try
Dim TmpR As DataRow() = T2.Select("CSTORD='" & CLot.ToUpper.Trim & "' AND DEG LIKE '" & Product.Trim.ToUpper & "%' AND CSCOMD='" & Color.ToUpper.Trim & "' and SCLD='" & ProdFit & "'")
R.Item("orderqty") =
For I As Int16 = To TmpR.Length - 'tmpDs.Tables(0).Rows ' 循環行數
For II As Int16 = To
If Strings.Split(TmpR(I).Item(II - ) & TmpR(I).Item("SCLD"), "--").Length > Then
If Trim(Strings.Split((TmpR(I).Item(II - ) & TmpR(I).Item("SCLD")), "--")()) = ProdSize.Trim & ProdFit.Trim Then
R.Item("orderqty") = Val(Trim(Strings.Split((TmpR(I).Item(II - ) & TmpR(I).Item("SCLD")), "--")()))
R.Item("Colcombo") = TmpR(I).Item("COM")
Exit Try
End If
End If
Next
Next
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub Private Function GetInLot(ByVal StrF As String)
Dim TmpStr As String = "'1'"
If StrF.Trim.Length > Then
TmpStr = Strings.Left(StrF, StrF.Length - )
End If
Return TmpStr
End Function Public Function StrTrim(ByVal Str As Object, Optional ByVal ReF As String = "") As String
If IsDBNull(Str) Then
Return ReF
Else
Return (Trim(Str))
End If
End Function Public Sub GetGroupName(ByVal StrFT As DataTable)
Try
Dim T1 As DataTable = SetHashTable(StrFT, Split("product"))
For Each R As DataRow In T1.Rows
Dim StrSql As String = "select coll from " & g.gLibrary & ".pcfdeg where deg=(select max(deg) deg from " & g.gLibrary & ".pcfdeg where deg like '" & R("product") & "%')"
Dim T2 As DataTable = gData.GetDataTable(StrSql, netConn)
If T2.Rows.Count > Then
Dim Rs As DataRow() = StrFT.Select("product='" & R("product") & "'")
For i As Int16 = To Rs.Length -
Rs(i).Item("groupname") = T2.Rows().Item("coll")
Next
End If
Next
StrFT.AcceptChanges()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
Public Sub GenUserInfoTmpTable()
Try
Dim strF As String
strF = " if object_id('tempdb..#userinfo') is null " & vbCrLf
strF += " begin " & vbCrLf
strF += " create table #userinfo(userid varchar(20),username varchar(30)) " & vbCrLf
strF += " insert into #userinfo(userid,username)values('" & g.gUserId & "','" & g.gUserName & "') " & vbCrLf
strF += " end"
Dim TmpComm As New OleDb.OleDbCommand(strF, sqlConn)
TmpComm.ExecuteNonQuery()
TmpComm.Dispose()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub '處理執行SQL語句中的“單引號”
Public Function GetSingleQuote(ByVal str As String) As String
Try
Dim i As Int16
i = str.IndexOf("'")
While i >
str = str.Substring(, i) & "'" & str.Substring(i)
i = str.IndexOf("'", i + )
End While
Return str
Catch ex As Exception
MsgBox(ex.ToString)
Return "~^_^~"
End Try
End Function
End Class
End Namespace