Bogart gSub.vb

'--------------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