[VB6/VB.NET] แจกโค้ดการรับค่าน้ำหนัก เพื่อทำการคำนวณหาอัตราค่าบริการขนส่ง
http://www.g2gnet.com/webboard/images/FeeWeightRun.pngวันนี้แจกโค้ดทั้ง VB6 และ VB.NET ในการรับค่าน้ำหนักพัสดุ เพื่อทำการคำนวณหาราคาค่าบริการขนส่ง ซึ่งมีกระบวนการวิธีที่คิดเหมือนกัน แตกต่างกันเพียงแค่คำสั่งที่ใช้งานเท่านั้น โดยแอดมินสมมุติราคาค่าบริการดังนี้ ...
ตัวอย่างจะยังไม่มีการจัดเรียงตามค่าน้ำหนักสูงสุด (MaxWeight)
http://www.g2gnet.com/webboard/images/FeeWeightData.png
สมมุติเราชั่งน้ำหนักได้ 500 กรัม
เมื่อทำการจัดเรียงข้อมูลใหม่ และการทำ Query ด้วยเงื่อนไขมากกว่า หรือ เท่ากับ มันจะแสดงผลออกมาทั้งหมด ดังนั้นหากเราต้องการคำตอบที่ถูกต้องเพียง 1 เดียว ต้องใช้ TOP 1 เพื่อเลือกรายการแรกสุดมาเป็นคำตอบ โดยไม่จำเป็นต้องเปรียบเทียบค่าในแต่ละ Record เลย ... ง่ายมั้ยครับ
http://www.g2gnet.com/webboard/images/FeeWeight.png
มาดูโค้ดหลักของ VB6 ...
Option Explicit
Private Sub Form_Load()
txtWeight.Text = ""
txtWeight.MaxLength = 5
txtFee.Text = ""
'// Connect MS Access DataBase
Call OpenDataBase
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call CloseDataBase
End
End Sub
Private Sub txtFee_KeyPress(KeyAscii As Integer)
'// ป้องกันการกดคีย์ใดๆลงไป
KeyAscii = 0
End Sub
Private Sub txtWeight_KeyPress(KeyAscii As Integer)
'// ไม่มีการป้อนค่าใดๆ หรือป้อนค่า 0
If Trim(txtWeight.Text) = "" Or Val(txtWeight.Text) = 0 Then Exit Sub
'// กดคีย์ Enter
If KeyAscii = 13 Then
Dim FeeService As Double
KeyAscii = 0
FeeService = CalFee(CDbl(txtWeight.Text))
'// ค่าที่รีเทิร์นกลับมาต้องมากกว่า 0 จึงจะแสดงผล
If FeeService > 0 Then
txtFee.Text = FeeService
Else
txtWeight.Text = ""
txtFee.Text = ""
lblFeeName.Caption = ""
MsgBox "คุณป้อนพิกัดน้ำหนักมากกว่าระบบกำหนดเอาไว้.", vbOKOnly + vbExclamation, "รายงานสถานะ"
End If
'// เช็คคีย์ที่กดต้องเป็น 0 - 9
Else
KeyAscii = CheckDigitOnly(KeyAscii)
End If
End Sub
' / --------------------------------------------------------------------------
' / ฟังค์ชั่นในการคำนวณอัตราราคาตามจำนวนน้ำหนัก
Function CalFee(ByVal Weight As Double) As Double
' / --------------------------------------------------------------------------
CalFee = 0
'// ประกาศ Instance Name ใหม่ และเพื่อให้แน่ใจว่าตัด RecordSet ทิ้งไปแล้ว
Set RS = New Recordset
'// เลือกเอาค่าแรกที่ได้มา (TOP 1) และต้องให้จัดเรียงตามน้ำหนักสูงสุด (MaxWeight)
Statement = _
" SELECTTOP 1 tblFee.FeePK, tblFee.FeeName, tblFee.FeeCharge, tblFee.MaxWeight " & _
" FROM tblFee " & _
" WHERE >= " & Val(txtWeight.Text) & _
" ORDER BY tblFee.FeeCharge "
RS.CursorLocation = adUseClient
RS.Open Statement, ConnDB, adOpenForwardOnly, adLockReadOnly, adCmdText
If RS.RecordCount > 0 Then
'// Return Value
CalFee = CDbl(RS("FeeCharge"))
lblFeeName.Caption = RS("FeeName")
End If
RS.Close: Set RS = Nothing
End Function
โค้ดในส่วนของโมดูลการเชื่อมต่อฐานข้อมูล VB6 + Access 2003 ...
Option Explicit
Global ConnDB As New ADODB.Connection
Global RS As New ADODB.Recordset
Global DS As New ADODB.Recordset
Global Statement As String
Global SQLStmt As String
'
' กำหนดว่าเป็นการเพิ่ม หรือ แก้ไขข้อมูล
Global blnNewData As Boolean
' ให้เกิดการ Update ในฟอร์มที่มีการเปลี่ยนแปลง
Global FormUpdate As Boolean
'
' สำหรับทำการค้นหา
Global gPK As Long
' การส่งชื่อตารางข้อมูลไป
Global gTable As String
Public Sub OpenDataBase()
On Error GoTo Err_Handler
Dim DB_File As String
DB_File = App.Path
If Right$(DB_File, 1) <> "\" Then DB_File = DB_File & "\"
DB_File = DB_File & "WeightData.MDB"
' Open a connection.
Set ConnDB = New ADODB.Connection
ConnDB.ConnectionString = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & DB_File & ";" & _
"Persist Security Info=False"
ConnDB.Open
Exit Sub
Err_Handler:
MsgBox "Error : " & Err.Number & " " & Err.Description
End
End Sub
Public Sub CloseDataBase()
' ตรวจสอบว่ามีการเชื่อมโยง - Connect ข้อมูลหรือไม่
If ConnDB.State = adStateOpen Then
ConnDB.Close
Set ConnDB = Nothing
End If
End Sub
Function CheckDigitOnly(Index As Integer) As Integer
Select Case Index
Case 48 To 57 ' 0 - 9
Case 8 ' Back Space
Case 13 ' Enter
Case Else
Index = 0
End Select
CheckDigitOnly = Index
End Function
'/แก้ปัญหาฟังค์ชั่น SendKeys ใน Windows 8+ 64 บิต
Public Sub Sendkeys(Text As String, Optional Wait As Boolean = False)
Dim WshShell As Object
Set WshShell = CreateObject("Wscript.shell")
WshShell.Sendkeys Text, Wait
Set WshShell = Nothing
End Sub
โค้ดในส่วนฟอร์มหลัก VB.NET (2010)
Imports System.Data.OleDb
Public Class frmFeeWeight
Private Sub frmCostWeight_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'// Connect MS Access DataBase
Conn = ConnectDataBase()
lblFeeName.Text = ""
End Sub
Private Sub txtWeight_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtWeight.KeyPress
'// ไม่มีการป้อนค่าใดๆ หรือป้อนค่า 0
If Trim(txtWeight.Text) = "" Or Val(txtWeight.Text) = 0 Then Exit Sub
'// กดคีย์ Enter
If e.KeyChar = Chr(13) Then
e.Handled = True
'// CDbl = Convert to Double
Dim FeeService As Double = CalFee(CDbl(txtWeight.Text))
'// ค่าที่รีเทิร์นกลับมาต้องมากกว่า 0 จึงจะแสดงผล
If FeeService > 0 Then
txtFee.Text = FeeService
Else
txtWeight.Clear()
txtFee.Clear()
lblFeeName.Text = ""
MessageBox.Show("คุณป้อนพิกัดน้ำหนักมากกว่าระบบกำหนดเอาไว้.", "รายงานสถานะ", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End If
Else
'// ตรวจสอบการกดคีย์ จะรับค่า 0 - 9 หรือ ASCII Code = 48 - 57
e.Handled = CheckDigitOnly(Asc(e.KeyChar))
End If
End Sub
'// ฟังค์ชั่นใช้ในการค้นหาอัตราค่าบริการ ตามสัดส่วนน้ำหนัก
Private Function CalFee(ByVal Fee As Double) As Double
CalFee = 0
'// เลือกเอาค่าแรกที่ได้มา (TOP 1) และต้องให้จัดเรียงตามน้ำหนักสูงสุด (MaxWeight)
strSQL = _
" SELECT TOP 1 tblFee.FeePK, tblFee.FeeName, tblFee.FeeCharge, tblFee.MaxWeight " & _
" FROM tblFee " & _
" WHERE (" & _
" >= " & CDbl(txtWeight.Text) & _
" ) ORDER BY MaxWeight "
Try
If Conn.State = ConnectionState.Closed Then Conn.Open()
Cmd = New OleDbCommand(strSQL, Conn)
DR = Cmd.ExecuteReader
While DR.Read()
If DR.HasRows Then
CalFee = Format(CDbl(DR.Item("FeeCharge").ToString), "#,##0.00")
lblFeeName.Text = DR.Item("FeeName").ToString
End If
End While
DR.Close()
Cmd.Dispose()
Catch ex As Exception
MessageBox.Show(ex.Message)
End Try
End Function
Private Sub frmCostWeight_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
If Conn.State = ConnectionState.Open Then Conn.Close()
Me.Dispose()
Application.Exit()
End Sub
End Class
โค้ดในการเชื่อมต่อฐานข้อมูล VB.NET + Access 2007+
Imports System.Data.OleDb
Imports Microsoft.VisualBasic
Module modDataBase
'// Declare variable one time but use many times.
Public Conn As OleDbConnection
Public Cmd As OleDbCommand
Public DS As DataSet
Public DR As OleDbDataReader
Public DA As OleDbDataAdapter
Public strSQL As String '// Major SQL
Public strStmt As String '// Minor SQL
'// Data Path
Public strPathData As String = MyPath(Application.StartupPath)
Public Function ConnectDataBase() As System.Data.OleDb.OleDbConnection
strPathData = MyPath(Application.StartupPath) & "Data\"
'"Provider = Microsoft.Jet.OLEDB.4.0;"
Dim strConn As String = _
"Provider = Microsoft.ACE.OLEDB.12.0;"
strConn += _
"Data Source = " & strPathData & "WeightData.accdb"
Conn = New OleDb.OleDbConnection(strConn)
' Create Connection
Conn.ConnectionString = strConn
' Return
Return Conn
End Function
' / --------------------------------------------------------------------------------
' / Get my project path
' / AppPath = C:\My Project\bin\debug
' / Replace "\bin\debug" with "\"
' / Return : C:\My Project\
Function MyPath(AppPath As String) As String
'/ MessageBox.Show(AppPath);
AppPath = AppPath.ToLower()
'/ Return Value
MyPath = AppPath.Replace("\bin\debug", "\").Replace("\bin\release", "\").Replace("\bin\x86\debug", "\")
'// If not found folder then put the \ (BackSlash) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
End Function
End Module
ฟังค์ชั่นในการรับค่าเฉพาะตัวเลขเท่านั้น VB.NET (2010)
' / --------------------------------------------------------------------------------
' / ฟังค์ชั่นในการป้อนเฉพาะค่าตัวเลขได้เท่านั้น
' / การใช้งานจากเหตุการณ์ KeyPress ของ TextBox
' / e.Handled = CheckDigitOnly(Asc(e.KeyChar))
Function CheckDigitOnly(ByVal index As Integer) As Boolean
Select Case index
Case 48 To 57 ' เลข 0 - 9
CheckDigitOnly = False
Case 8, 13 ' Backspace = 8, Enter = 13
CheckDigitOnly = False
Case Else
CheckDigitOnly = True
End Select
End Function
ดาวน์โหลดโค้ดต้นฉบับ VB6 (FeeWeight.zip) และโค้ดต้นฉบับ VB.NET (2010) ชื่อไฟล์ FeeWeightNet.zip
หน้า:
[1]