Imports System
Imports System.Data
Imports System.Data.OleDb
Imports Microsoft.VisualBasic
Imports System.Console
Imports System.Windows.Forms
Imports System.IO
Imports System.Text
Imports System.Drawing Namespace BogartMis.Cls
Public Class DataControl #Region "SQL Process <Added by: langwang at: 2008/12/5-上午 09:46:57 on machine: WXPGNR530> " Public Function GetDataTable(ByVal strSQL As String, ByVal aConn As SqlClient.SqlConnection) As DataTable Dim netTable As DataTable
Try
OpenConn(aConn)
Dim netDp As SqlClient.SqlDataAdapter
netTable = New DataTable
netDp = New SqlClient.SqlDataAdapter(strSQL, aConn)
netDp.Fill(netTable)
netDp.Dispose()
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
End Try
Return netTable
End Function
Public Function ExecuteCommand(ByVal strSQL As String, ByVal aConn As SqlClient.SqlConnection) As Boolean
Dim cmd As New SqlClient.SqlCommand
Dim i As Integer
Try
OpenConn(aConn)
With cmd
.Connection = aConn
.CommandText = strSQL
.CommandType = CommandType.Text
.CommandTimeout =
i = .ExecuteNonQuery()
End With
Catch ex As Exception
i = -
End Try If i >= Then
Return True
Else
Return False
End If
End Function Public Function ExecuteCommand(ByVal strSQL As String, ByRef objPar As String, ByRef objValues() As Object, ByVal sqlConn As SqlClient.SqlConnection) As Boolean
Dim cmd As New SqlClient.SqlCommand
Dim i As Integer
Dim par As SqlClient.SqlParameter
Dim objPars() As String = objPar.Split(",")
OpenConn(sqlConn)
Try
With cmd
.Connection = sqlConn
.CommandText = strSQL
.CommandType = CommandType.StoredProcedure
.CommandTimeout =
For i = To objPars.Length -
par = New SqlClient.SqlParameter(objPars(i), objValues(i))
.Parameters.Add(par)
Next
i = .ExecuteNonQuery()
End With
Catch ex As Exception
i = -
End Try If i >= Then
Return True
Else
Return False
End If
End Function Public Function SelectValue(ByVal strSQL As String, ByVal aConn As SqlClient.SqlConnection, Optional ByVal DefaultValue As Object = Nothing) As Object
Dim cmd As SqlClient.SqlCommand
Dim o As Object = Nothing
Try
OpenConn(aConn)
cmd = New SqlClient.SqlCommand
With cmd
.Connection = aConn
.CommandText = strSQL
.CommandType = CommandType.Text
.CommandTimeout =
o = .ExecuteScalar()
End With
Catch ex As Exception
o = Nothing
Finally
cmd.Dispose()
End Try
If o Is Nothing Then
Return DefaultValue
Else
Return o
End If
End Function
#End Region #Region " Ole Process"
Public Sub SetVesselControl(ByVal netView As DataView, ByVal VesselName As Control)
Try
Dim e As Control
Dim eCbo As ComboBox
Dim eDtp As DateTimePicker
Dim eCHK As CheckBox
Dim ePic As PictureBox
Dim eNud As NumericUpDown
For Each e In VesselName.Controls
If TypeOf e Is TextBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "txt" Then
e.Text = netView.Table.Rows()(e.Name)
End If
ElseIf TypeOf e Is ComboBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "cbo" Then
eCbo = CType(e, ComboBox)
If eCbo.DataSource Is Nothing Then
eCbo.SelectedItem = netView.Table.Rows()(e.Name)
Else
eCbo.SelectedValue = netView.Table.Rows()(e.Name)
End If
End If
ElseIf TypeOf e Is DateTimePicker Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "dtp" Then
eDtp = CType(e, DateTimePicker)
eDtp.Value = netView.Table.Rows()(e.Name) End If
ElseIf TypeOf e Is NumericUpDown Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "nud" Then
eNud = CType(e, NumericUpDown)
eNud.Value = netView.Table.Rows()(e.Name)
End If
ElseIf TypeOf e Is CheckBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "chk" Then
eCHK = CType(e, CheckBox)
eCHK.Checked = CBool(netView.Table.Rows()(e.Name))
End If
ElseIf TypeOf e Is PictureBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "pic" Then
ePic = CType(e, PictureBox)
Dim By() As Byte = CType(netView.Table.Rows()(e.Name), Byte())
Dim ms As New MemoryStream(By)
ePic.Image = Image.FromStream(ms, True)
ms.Close()
End If
End If
Next
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
End Try
End Sub Public Sub ClearVessel(ByVal VesselName As Control)
Try
Dim e As Control
Dim eCbo As ComboBox
Dim eDTP As DateTimePicker
Dim eCHK As CheckBox
Dim ePic As PictureBox For Each e In VesselName.Controls
If TypeOf e Is TextBox Then
e.Text = ""
ElseIf TypeOf e Is ComboBox Then
eCbo = CType(e, ComboBox)
eCbo.Text = ""
ElseIf TypeOf e Is DateTimePicker Then
eDTP = CType(e, DateTimePicker)
eDTP.Value = DateTime.Today
ElseIf TypeOf e Is CheckBox Then
eCHK = CType(e, CheckBox)
eCHK.Checked = False
ElseIf TypeOf e Is PictureBox Then
ePic = CType(e, PictureBox)
ePic.Image = Nothing
End If
Next
Catch ex As Exception
End Try
End Sub Public Function AddRow(ByVal netView As DataView, ByVal VesselName As Control) As Boolean
Try
Dim e As Control
Dim eTxt As TextBox
Dim eChk As CheckBox
Dim eCbo As ComboBox
Dim ePic As PictureBox
Dim eDTP As DateTimePicker
Dim eNud As NumericUpDown
Dim netRow As DataRowView = netView.AddNew
netRow.BeginEdit()
For Each e In VesselName.Controls
If TypeOf e Is TextBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "txt" Then
netRow(e.Name) = e.Text
End If
ElseIf TypeOf e Is ComboBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "cbo" Then
eCbo = CType(e, ComboBox)
If eCbo.DataSource Is Nothing Then
netRow(e.Name) = eCbo.GetItemText(eCbo.SelectedItem)
Else
netRow(e.Name) = eCbo.GetItemText(eCbo.SelectedValue)
End If
End If
ElseIf TypeOf e Is NumericUpDown Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "nud" Then
eNud = CType(e, NumericUpDown)
netRow(e.Name) = eNud.Value
End If
ElseIf TypeOf e Is CheckBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "chk" Then
eChk = CType(e, CheckBox)
netRow(e.Name) = -CInt(eChk.Checked)
End If
ElseIf TypeOf e Is DateTimePicker Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "dtp" Then
eDTP = CType(e, DateTimePicker)
netRow(e.Name) = eDTP.Value
End If
ElseIf TypeOf e Is PictureBox Then
Try
If Microsoft.VisualBasic.Left(e.Name.ToLower, ).ToString <> "pic" Then
ePic = CType(e, PictureBox)
If ePic.Image Is Nothing Then
Else
Dim ms As New MemoryStream
ePic.Image.Save(ms, ePic.Image.RawFormat)
Dim by() As Byte = ms.GetBuffer
ms.Close()
netRow(e.Name) = by
End If
End If
Catch
End Try
End If
Next
netRow.EndEdit()
Return True
Catch em As Exception
Return False
End Try
End Function Public Function UpdateRow(ByVal netView As DataView, ByVal pkField As String, ByVal VesselName As Control) As Boolean
Try
Dim e As Control
Dim eTxt As TextBox
Dim eChk As CheckBox
Dim eCbo As ComboBox
Dim ePic As PictureBox
Dim eDTP As DateTimePicker
Dim eNud As NumericUpDown
Dim netRow As DataRowView = netView.Item()
netRow.BeginEdit()
For Each e In VesselName.Controls
If e.Name.ToLower <> pkField.ToLower Then
If TypeOf e Is TextBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "txt" Then
netRow(e.Name) = e.Text
End If
ElseIf TypeOf e Is ComboBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "cbo" Then
eCbo = CType(e, ComboBox)
If eCbo.DataSource Is Nothing Then
netRow(e.Name) = eCbo.GetItemText(eCbo.SelectedItem)
Else
netRow(e.Name) = eCbo.GetItemText(eCbo.SelectedValue)
End If
End If
ElseIf TypeOf e Is CheckBox Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "chk" Then
eChk = CType(e, CheckBox)
netRow(e.Name) = -CInt(eChk.Checked)
End If
ElseIf TypeOf e Is NumericUpDown Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "nud" Then
eNud = CType(e, NumericUpDown)
netRow(e.Name) = eNud.Value
End If
ElseIf TypeOf e Is DateTimePicker Then
If Microsoft.VisualBasic.Left(e.Name, ).ToLower <> "dtp" Then
eDTP = CType(e, DateTimePicker)
netRow(e.Name) = eDTP.Value
End If
ElseIf TypeOf e Is PictureBox Then
Try
If Microsoft.VisualBasic.Left(e.Name.ToLower, ).ToString <> "pic" Then
ePic = CType(e, PictureBox)
If ePic.Image Is Nothing Then
Else
Dim ms As MemoryStream
ePic.Image.Save(ms, ePic.Image.RawFormat)
Dim by() As Byte = ms.GetBuffer
ms.Close()
netRow(e.Name) = by
End If
End If
Catch
End Try
End If
End If
Next
netRow.EndEdit()
Return True
Catch em As Exception
Return False
End Try
End Function 'Added by SimonCheung on 2009/08/28 獲取公司Logo
Public Function GetCompanyLogo(ByVal aConn As OleDb.OleDbConnection) As OleDb.OleDbDataAdapter Dim netLogo As OleDb.OleDbDataAdapter
If g.gDefaultCompany = "" Then
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='SHS'", aConn) Else
If g.gDefaultCompany = "" Then
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='Brunet'", aConn)
Else
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='Bogart'", aConn)
End If End If netLogo.SelectCommand.CommandTimeout =
Return netLogo
End Function 'Added by SimonCheung on 2009/10/08 獲取公司Logo
Public Function GetCompanyLogo(ByVal aConn As OleDb.OleDbConnection, ByVal sCompany_Code As String, ByVal sCompany_Name As String) As OleDb.OleDbDataAdapter Dim netLogo As OleDb.OleDbDataAdapter If g.gDefaultCompany = "" Then
If sCompany_Name.Trim.Length > Then
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='" & sCompany_Name & "'", aConn)
Else
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where IntRefCode='" & sCompany_Code & "'", aConn)
' netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='" & IIf(sCompany_Code.Trim = "02", "BLingerie", "SHS") & "'", aConn)
End If
Else
If sCompany_Name.Trim.Length > Then
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='" & sCompany_Name & "'", aConn)
Else
netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where IntRefCode='" & sCompany_Code & "'", aConn)
' netLogo = New OleDb.OleDbDataAdapter("select CompanyLogo as CMPYLOGO from CompanyProfile where CompanyCode='" & IIf(sCompany_Code.Trim = "02", "BLingerie", "Bogart") & "'", aConn)
End If End If netLogo.SelectCommand.CommandTimeout =
Return netLogo
End Function 'Added by Judy on 2010/12/07
Public Function getCompanyImage(ByVal CompanyCode As String) As Boolean
Try
Dim rs As New ADODB.Recordset
'Dim connok As Boolean = True
'If sqlConn_temp.State <> ConnectionState.Open Then
' If Me.connSQL = False Then
' connok = False
' End If
'End If
'If connok = True Then
rs.Open("select CompanyLogo from RPTDEV.dbo.CompanyProfile where CompanyCode='" & CompanyCode.Trim.ToString & "' ", sqlAdo, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockBatchOptimistic)
'End If
If rs.RecordCount <= Then Exit Function
rs.MoveFirst()
Dim by() As Byte = CType(rs.Fields("CompanyLogo").Value, Byte())
If by Is Nothing Then Exit Function
Dim myMem As New IO.MemoryStream(by)
Dim myBmp As New Bitmap(myMem)
Clipboard.SetDataObject(myBmp)
Return True
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
Return False
End Try End Function 'Added by vinson on 2012/12/25
Public Function getCompanyAdditionalLogo(ByVal aConn As OleDb.OleDbConnection, ByVal sCompany_Code As String, ByVal sCompany_Name As String) As OleDb.OleDbDataAdapter
Dim netLogo As OleDb.OleDbDataAdapter
'sCompany_Name = "Brunet"
netLogo = New OleDb.OleDbDataAdapter("select AdditionalLogo from CompanyProfile where CompanyCode='" & sCompany_Name & "'", aConn)
netLogo.SelectCommand.CommandTimeout =
Return netLogo
End Function ''Added by Judy to 2010/12/10
'Public Function InsertCmpLogo(ByVal code As String, ByVal xSheet As Excel.Worksheet, ByVal xBook As Excel.Workbook, ByVal xApp As Excel.Application) As Boolean ' Dim intHH As Int16
' With xSheet.Range("I1")
' intHH = .Rows.Height() - 1
' End With
' If gData.getCompanyImage(g.CmpCode) = True Then
' xSheet.Range("I1").Select()
' xSheet.Paste()
' xApp.Selection.ShapeRange.LockAspectRatio = True
' xApp.Selection.ShapeRange.Height = intHH '按高填充
' End If
' 'End If
' System.Windows.Forms.Clipboard.SetDataObject("")
'End Function ''Added by Judy to 2010/12/07
'Public Function connSQL() As Boolean
' Try
' sqlConn_temp.ConnectionString = "Provider=SQLOLEDB.1;data source=" & g.gSqlServer & ";initial catalog='" & g.gServerUser & "';password='" & g.gServerPassWord & "';user id='" & g.gSqlServerUser & "'"
' sqlConn_temp.CursorLocation = ADODB.CursorLocationEnum.adUseClient
' sqlConn_temp.Open()
' Return True
' Catch ex As Exception
' Return False
' End Try
'End Function 'Added by simoncheung on 2010/04/22 根據Company Code 取得companyName
Public Function GetCompanyName(ByVal C_Code As String) As String
Dim ComanyName As String = gData.SelectValue(" select CompanyCode FROM dbo.CompanyProfile WHERE IntRefCode='" & Trim(C_Code) & "'", sqlAdo)
If ComanyName.Trim.Length > Then
Return ComanyName
Else
Return " "
End If
End Function Public Function GetDataSet(ByVal SQL As String, ByVal aConn As OleDb.OleDbConnection, Optional ByVal TableName As String = Nothing) As DataSet
Try
Dim netDp As OleDb.OleDbDataAdapter
Dim netDs As New DataSet
netDp = New OleDb.OleDbDataAdapter(SQL, aConn) If TableName = Nothing Then
netDp.Fill(netDs)
Else
netDp.Fill(netDs, TableName)
End If
netDp.Dispose() Return netDs
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
End Try
End Function Public Function GetDataView(ByVal SQL As String, ByVal aConn As OleDb.OleDbConnection, Optional ByVal TableName As String = Nothing) As DataView
Dim netDp As OleDb.OleDbDataAdapter
Dim netDs As New DataSet
Try
netDp = New OleDb.OleDbDataAdapter(SQL, aConn) If TableName = Nothing Then
netDp.Fill(netDs)
Else
netDp.Fill(netDs, TableName)
End If
netDp.Dispose() Return netDs.Tables().DefaultView
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
End Try
End Function Public Function GetDataTable(ByVal SQL As String, ByVal aConn As OleDb.OleDbConnection, Optional ByVal TableName As String = Nothing) As DataTable
Try
Dim netDp As OleDb.OleDbDataAdapter
Dim netTable As DataTable
If TableName = Nothing Then
netTable = New DataTable
Else
netTable = New DataTable(TableName)
End If
netDp = New OleDb.OleDbDataAdapter(SQL, aConn)
netDp.Fill(netTable)
netDp.Dispose()
Return netTable
Catch ex As Exception
System.Console.WriteLine(ex.ToString)
If g.gUserId.ToUpper = "SHINYD" Then
MsgBox(SQL & " " & ex.ToString)
End If
End Try
End Function Protected Overrides Sub Finalize()
' If Not impersonationContext Is Nothing Then impersonationContext.Undo()
MyBase.Finalize()
End Sub '檢查給定的條件記錄是否存在
Public Function CheckRecord(ByVal strSQL As String, ByVal aConn As ADODB.Connection) As Boolean
Try Dim rs As New ADODB.Recordset
rs.Open(strSQL, aConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
If rs.RecordCount > Then
Return True
Else
Return False
End If
Catch ex As Exception
Return False
End Try
End Function '返回給定條件的表第一行第一列的數據
Public Function selectValue(ByVal strSQL As String, ByVal aConn As ADODB.Connection, Optional ByVal DefaultValue As Object = "") As Object
Try Dim rs As New ADODB.Recordset
rs.Open(strSQL, aConn, ADODB.CursorTypeEnum.adOpenStatic, ADODB.LockTypeEnum.adLockOptimistic)
If rs.RecordCount > Then
Return Trim(IIf(IsDBNull(rs.Fields().Value) = True, DefaultValue, rs.Fields().Value))
Else
Return DefaultValue
End If
Catch ex As Exception
Dim f As New IO.FileStream("errorlog.txt", IO.FileMode.OpenOrCreate)
f.Flush() Dim data As [Byte]() = System.Text.Encoding.ASCII.GetBytes(ex.ToString)
Dim i As Integer
For i = To data.GetUpperBound()
f.WriteByte(data(i))
Next
f.Close()
Return DefaultValue
End Try
End Function ' <Added by: langwang at: 2008/12/5-上午 09:46:57 on machine: WXPGNR530>
Public Function SelectValue(ByVal strSQL As String, ByVal aConn As OleDb.OleDbConnection, Optional ByVal DefaultValue As Object = "") As String
Try
OpenConn(aConn)
Dim cmd As New OleDb.OleDbCommand(strSQL, aConn)
Dim ret As Object = cmd.ExecuteScalar()
If ret Is Nothing Then
Return DefaultValue
Else
Return CStr(ret)
End If
Catch ex As Exception
Return DefaultValue
End Try
End Function
'==================================
'Add by shiny 2009/04/06 函數 FilterSql
'過濾Sql關鍵符號
'=================================
Public Function FilterSql(ByVal StrF As Object) As String
Try
If IsDBNull(StrF) Then
Return ""
End If Return Strings.Replace(StrF, "'", "''")
Catch ex As Exception
Return StrF
End Try
End Function Public Function selectValues(ByVal strSQL As String, ByVal aConn As OleDb.OleDbConnection, Optional ByVal DefaultValue As String = "") As String
Try
Dim netTable As DataTable = GetDataTable(strSQL, aConn)
If netTable.Rows.Count > Then
Return Trim(IIf(IsDBNull(netTable.Rows().Item()) = True, DefaultValue, netTable.Rows().Item()))
Else
Return DefaultValue
End If
Catch ex As Exception
Return DefaultValue
Exit Function
End Try
End Function Public Function getClotType(ByVal CLOT As String) As String Dim CLOTTD As String = gData.SelectValue(" select VALUE(B.CLOTTD, '') as CLOTTD FROM IMFCLOT A LEFT JOIN IMFCLTT B ON A.SEWFTY = B.CLOTTP WHERE A.CLOT='" & Trim(CLOT) & "'", adoConn)
If CLOTTD.Trim.Length > Then
Return CLOTTD
Else
Return " "
End If
End Function
'Added by Simon Cheung on 2010/09/17 Job# 1000342
Public Function getCustPO(ByVal LOTNO As String) As String
Dim I As Integer
Dim TmpTab As DataTable = gData.GetDataTable("SELECT REMLIN, REMARK FROM ORFORDR WHERE CSTORD='" & LOTNO & "' AND REMTYP = '1' ORDER BY REMLIN ", netConn)
For I = To TmpTab.Rows.Count -
getCustPO = getCustPO & TmpTab.Rows(I).Item("REMARK")
Next
Return getCustPO
End Function Public Function GetPrintTime() As String
'1 Hour 2 year 3 minute 4 month 5 second 6 date
Dim strPrintTime As String = Format(Now(), "HHyymmMMssdd")
Return strPrintTime
End Function
Public Function getProductImage(ByVal ProductCode As String, ByVal IMGTYP As String, ByVal s As Integer, ByVal w As Integer) As Boolean
Try
If Not System.IO.Directory.Exists("C:\TEMP\") Then
System.IO.Directory.CreateDirectory("C:\TEMP\")
End If
Dim LogoFileName As String = "C:\TEMP\TmpProduct.jpg"
Dim TmpLogo As Bitmap = ChangeImageSize(getProductImage(ProductCode, IMGTYP, sqlAdo), s, w)
TmpLogo.Save(LogoFileName)
Return True
Catch ex As Exception
Return False
End Try
End Function Public Function getProductImage(ByVal ProductCode As String, ByVal IMGTYP As String, ByVal sqlAdo As ADODB.Connection) As Byte()
Dim by() As Byte
Dim rsImage As New ADODB.Recordset
'last version product,add by vinson on 2013-03-01
rsImage.Open("select image from ProdSketch.dbo.orximg where imgtyp='" + IMGTYP + "' and deg=(select max(deg) from ProdSketch.dbo.orximg where imgtyp='" + IMGTYP + "' and deg like '" + Mid(ProductCode, , ) + "%') and seqno=(select min(seqno) from ProdSketch.dbo.orximg where imgtyp='" + IMGTYP + "' and deg=(select max(deg) from ProdSketch.dbo.orximg where imgtyp='" + IMGTYP + "' and deg like '" + Mid(ProductCode, , ) + "%'))", sqlAdo)
If rsImage.RecordCount > Then
by = CType(rsImage.Fields("image").Value, Byte())
Else
by = Nothing
End If
rsImage.Close()
Return by
End Function 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 changePicSize(ByVal by() As Byte, Optional ByVal x_W As Int16 = , Optional ByVal x_H As Int16 = ) As Byte()
Try
ChangeImageSize(by, x_W, x_H).Save(Application.StartupPath & "\product.jpg")
Dim fs As New IO.FileStream(Application.StartupPath & "\product.jpg", IO.FileMode.OpenOrCreate)
Dim by2(fs.Length) As Byte
fs.Read(by2, , fs.Length) fs.Close()
Return by2
Catch ex As Exception
Return Nothing
End Try
End Function Public Function changePicSize2(ByVal by() As Byte, Optional ByVal x_W As Int16 = , Optional ByVal x_H As Int16 = ) As Byte()
Try
Dim ms2 As New IO.MemoryStream
ChangeImageSize(by, x_W, x_H).Save(ms2, System.Drawing.Imaging.ImageFormat.Jpeg)
Dim by2() As Byte = ms2.GetBuffer ms2.Close()
Return by2
Catch ex As Exception
Return Nothing
End Try
End Function
#End Region End Class
End Namespace

Bogart gData.vb的更多相关文章

  1. Bogart gSub.vb

    '--------------Job No 0900408 -------------- '--DIM PART ONE ONLINE Update Order Qty '''主要新加過程名 Refr ...

  2. Bogart BogartPublic.vb

    Imports System.Data.SqlClient Imports System.Data #Region "IBogartToolbar,請勿隨便更改" Interfac ...

  3. Bogart SysPwd.vb

    Module syspwd Public Const STR_MASK = "MyFunction" '加密用字串 '預定義密碼長度 Public GintCheckPwd As ...

  4. Bogart gFunction.vb

    Module gFunction '其它不是常用的方法及函數 #Region " 將指定的數據格式轉換為英文格式" Public Function EnglishFormat(By ...

  5. Bogart gGrid.vb

    Namespace BogartMis.Cls Public Class gGrid '設定表格控的列標題的別名 '說明:strItem字符串的格式為"01,02,03,04,05" ...

  6. Bogart BogartAutoCode.vb

    Imports System.Data.SqlClient Imports System.Data Public Class BogartAutoCodeDataBase Private Conn A ...

  7. [转载]C#中MessageBox.Show用法以及VB.NET中MsgBox用法

    一.C#中MessageBox.Show用法 MessageBox.Show (String) 显示具有指定文本的消息框. 由 .NET Compact Framework 支持. MessageBo ...

  8. VB.NET设置控件和窗体的显示级别

    前言:在用VB.NET开发射频检测系统ADS时,当激活已存在的目标MDI子窗体时,被其他子窗体遮住了,导致目标MDI子窗体不能显示. 这个问题怎么解决呢?网上看到一篇帖子VB.NET设置控件和窗体的显 ...

  9. 用VB脚本批到导入字段到PowerDesigner

    在PowerDesigner使用脚本批量导入excel中记录的表结构信息,由于需要通过powerdesigner逆向工程创建一些sybase IQ的表,由于是接口数据,只有excel表,手动导入太耗时 ...

随机推荐

  1. LMS算法

    一.感知器算法和LMS算法 感知器和自适应线性元件在历史上几乎是同时提出的,并且两者在对权值的调整的算法非常相似.它们都是基于纠错学习规则的学习算法. 感知器算法存在如下问题:不能推广到一般的前向网络 ...

  2. 牛客小白月赛2 E:是是非非(尼姆博弈)

    链接:https://www.nowcoder.com/acm/contest/86/E来源:牛客网 题目描述 坎为水,险阳失道,渊深不测:离为火,依附团结,光明绚丽.坎卦:水洊至,习坎:君子以常德行 ...

  3. ElasticSearch(八):springboot集成ElasticSearch集群并使用

    1. 集群的搭建 见:ElasticSearch(七) 2. springboot配置集群 2.1 创建springboot项目,使用idea创建,不过多介绍(创建项目时候建议不要勾选elastics ...

  4. 【BZOJ2558】Count on a tree

    又是因为傻逼错误浪费了半天时间 原题: 给定一棵N个节点的树,每个点有一个权值,对于M个询问(u,v,k),你需要回答u xor lastans和v这两个节点间第K小的点权.其中lastans是上一个 ...

  5. log4j的格式化打印

    log4j.properties的文件内容如下 log4j.rootLogger=INFO, stdoutlog4j.appender.stdout=org.apache.log4j.ConsoleA ...

  6. centos下yum安装pip失败

    [root@wfm ~]# yum -y install pip Loaded plugins: fastestmirror, refresh-packagekit, securityLoading ...

  7. tomcat源码阅读之StandardHost和StandardEngine

    StandardHost及UML类图: 1.StandardHost类是Host接口的默认实现:其继承自ContainerBase类,说明他也是一个容器类,既然是容器类,那肯定也有管道对象PipeLi ...

  8. Nginx+redis部署tomcat集群

    一.部署环境: 两个tomcat实例部署在Ubuntu 14上,IP地址分别为192.168.1.110和192.168.1.111,Nginx和redis部署在windows7上,IP地址为192. ...

  9. ORA-10997:another startup/shutdown operation of this instance in progress解决方法

    SQL> startup ORA-10997: another startup/shutdown operation of this instance inprogress ORA-09967: ...

  10. es6比es5节省代码的地方总结

    对象方法简写: es5写法: var obj = { name: 'jeff', getName: function () { return this.name; } } es6写法(方法定义里,少写 ...