[VB.NET] แจกฟรีโปรแกรมและโค้ดของการสุ่มตัวเลข 2 และ 3 หลัก ในการจับฉลากรางวัล
http://www.g2gnet.com/webboard/images/vbnet/RandomAward.pngโค้ดโปรแกรมชุดนี้แอดมินเลือกใช้ Digital Gauge ของฟรีจากค่าย Syncfusion น่ะครับ หากต้องการจะปรับแต่งโค้ดก็ต้องไป ดาวน์โหลด Syncfusion Community License มาทำการติดตั้งให้เรียบร้อยก่อน และต้องสมัครสมาชิกเขาด้วยล่ะครับ ถึงจะดาวน์โหลดได้ (เวอร์ชั่นของแอดมิน 17.1400.0.47) และต้องปรับ Net FrameWork ให้เป็นรุ่น 4.0 แบบเต็มด้วยครับ ...
ดาวน์โหลดโปรแกรมเพื่อนำไปใช้งานอย่างเดียว ...
Add References ... สำหรับ MB.DLL เป็น Custom MessageBox เพื่อให้แสดงผลตัวอักษรตัวใหญ่ได้
http://www.g2gnet.com/webboard/images/vbnet/RandomAwardRef.png
มาดูโค้ดฉบับเต็มกันเถอะ ...
Imports System.IO
Imports System.Media
Public Class frmRandomNumber
Dim RndNum As Integer
Dim Buzzer As String
Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
' / Formular
' / Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)
RndNum = Int((CInt(cmbUpper.Text) - CInt(cmbLower.Text) + 1) * Rnd() + CInt(cmbLower.Text))
'//
If rdo2Digit.Checked Then
Me.DigitalGauge1.Value = Microsoft.VisualBasic.Right("00" & RndNum, 2)
Else
Me.DigitalGauge1.Value = Microsoft.VisualBasic.Right("000" & RndNum, 3)
End If
'//
End Sub
Private Sub frmRandomNumber_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
Me.Dispose()
Application.Exit()
End Sub
Private Sub frmRandomNumber_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
'/ Me.DigitalGauge1.Size = New Size(760, 308)
Randomize()
'Timer1.Interval = 50
Timer1.Enabled = False
'
Call SetupGridView()
rdo3Digit.Checked = True
'Call SetupRange()
'//
cmbBuzzer.Items.Add("Buzzer 1")
cmbBuzzer.Items.Add("Buzzer 2")
cmbBuzzer.SelectedIndex = 0
'//
With cmbSpeed
.Items.Add("Speed 1")
.Items.Add("Speed 2")
.Items.Add("Speed 3")
End With
cmbSpeed.SelectedIndex = 1
'// DigiTalGauge Setup
With cmbColor
.Items.Add("Color 1")
.Items.Add("Color 2")
.Items.Add("Color 3")
End With
cmbColor.SelectedIndex = 0
End Sub
Sub SetupRange()
cmbLower.Items.Clear()
cmbUpper.Items.Clear()
If rdo2Digit.Checked Then
For i = 1 To 99
cmbLower.Items.Add(i)
cmbUpper.Items.Add(i)
Next
'//
ElseIf rdo3Digit.Checked Then
For i = 1 To 999
cmbLower.Items.Add(i)
cmbUpper.Items.Add(i)
Next
End If
cmbLower.SelectedIndex = 0
cmbUpper.SelectedIndex = cmbUpper.Items.Count - 1
End Sub
Private Sub btnStartStop_Click(sender As System.Object, e As System.EventArgs) Handles btnStartStop.Click
If CInt(cmbLower.Text) >= CInt(cmbUpper.Text) Then
Dim show As New mb.ShowMessagebox
show.Fonts(New Font("Century Gothic", 34))
show.ShowBox("ค่าเริ่มต้นต้องน้อยกว่าค่าสิ้นสุดเท่านั้น.", mb.MStyle.ok, mb.FStyle.Exclamation, "ตั้งค่าตัวเลขไม่ถูกต้อง")
Return
End If
'//
If Me.btnStartStop.Text = "START" Then
Timer1.Enabled = False
btnStartStop.Text = "STOP"
btnSave.Enabled = True
btnRemove.Enabled = True
rdo2Digit.Enabled = True
rdo3Digit.Enabled = True
cmbLower.Enabled = True
cmbUpper.Enabled = True
'// Add Row.
For iRow = 0 To dgvData.Rows.Count - 1
If Me.DigitalGauge1.Value = dgvData.Rows(iRow).Cells(0).Value Then
Dim show As New mb.ShowMessagebox
show.Fonts(New Font("Century Gothic", 34))
show.ShowBox("หมายเลข: " & Me.DigitalGauge1.Value & " ได้รับรางวัลเรียบร้อยแล้ว.", mb.MStyle.ok, mb.FStyle.Exclamation, "รายงานรางวัลซ้ำ")
Return
End If
Next
dgvData.Rows.Add(New String() {Me.DigitalGauge1.Value, ""})
dgvData.Focus()
SendKeys.Send("^{END}")
If chkPlaySound.Checked Then Call PlaySoundLotto()
Timer1.Stop()
'//
Else
Randomize()
'Timer1.Interval = 50 ' 1000 millisecond = 1 second.
Timer1.Enabled = True
btnStartStop.Text = "START"
btnSave.Enabled = False
btnRemove.Enabled = False
rdo2Digit.Enabled = False
rdo3Digit.Enabled = False
cmbLower.Enabled = False
cmbUpper.Enabled = False
End If
End Sub
Private Sub rdo3Digit_CheckChanged(sender As System.Object, e As System.EventArgs) Handles rdo3Digit.CheckChanged
Me.DigitalGauge1.CharacterCount = 3
Call SetupRange()
End Sub
Private Sub rdo2Digit_CheckChanged(sender As System.Object, e As System.EventArgs) Handles rdo2Digit.CheckChanged
Me.DigitalGauge1.CharacterCount = 2
Call SetupRange()
End Sub
' / --------------------------------------------------------------------------------
Private Sub SetupGridView()
With dgvData
.RowHeadersVisible = False
.AllowUserToAddRows = False
.AllowUserToDeleteRows = False
.AllowUserToResizeRows = False
.MultiSelect = False
.SelectionMode = DataGridViewSelectionMode.FullRowSelect
.ReadOnly = True
.RowTemplate.Height = 48
.ColumnHeadersHeight = 54
.Font = New Font("Century Gothic", 32, FontStyle.Bold)
' Columns Specified
.Columns.Add("Number", "หมายเลข")
.Columns.Add("Reward", "รางวัล")
.Columns(1).DefaultCellStyle.Font = New Font("Tahoma", 20, FontStyle.Bold)
'/ Autosize Column
.AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
'.AutoResizeColumns()
'// Even-Odd Color
.AlternatingRowsDefaultCellStyle.BackColor = Color.AliceBlue
'/ Adjust Header Styles
With .ColumnHeadersDefaultCellStyle
.BackColor = Color.Navy
.ForeColor = Color.Black ' Color.White
.Font = New Font("Century Gothic", 28, FontStyle.Bold)
End With
End With
For i = 0 To 1
With dgvData
.Columns(i).HeaderCell.Style.Alignment = DataGridViewContentAlignment.MiddleLeft
.Columns(i).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleLeft
End With
Next
End Sub
Private Sub dgvData_DoubleClick(sender As Object, e As System.EventArgs) Handles dgvData.DoubleClick
If dgvData.Rows.Count = 0 Then Return
frmReward.ShowDialog()
End Sub
Private Sub btnRemove_Click(sender As System.Object, e As System.EventArgs) Handles btnRemove.Click
If dgvData.RowCount = 0 Then Exit Sub
'//
Dim show As New mb.ShowMessagebox
show.Fonts(New Font("Century Gothic", 34))
If show.ShowBox("คุณแน่ใจว่าต้องการลบข้อมูลนี้?", mb.MStyle.YesNo, mb.FStyle.Question, "ยืนยันการลบข้อมูล") = DialogResult.Yes Then
dgvData.Rows.Remove(dgvData.CurrentRow)
dgvData.Refresh()
End If
End Sub
Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click
If dgvData.Rows.Count = 0 Then Return
'/ ประกาศใช้งาน Save File Dialog ในแบบ Run Time
Dim dlgSaveFile As SaveFileDialog = New SaveFileDialog
' / Save File Dialog
With dlgSaveFile
.InitialDirectory = MyPath(Application.StartupPath)
.Title = "Select text file."
.Filter = "Text Files (*.txt)|*.txt"
.FilterIndex = 1
.RestoreDirectory = True
End With
'/ Choose OK button after Browse ...
If dlgSaveFile.ShowDialog() = DialogResult.OK Then
Dim swWriter As New StreamWriter(dlgSaveFile.FileName)
Dim LineToWrite As String = String.Empty
Try
For _Row As Integer = 0 To dgvData.Rows.Count - 1
LineToWrite = String.Empty
For _Column As Integer = 0 To dgvData.Columns.Count - 1
LineToWrite &= ", " & dgvData.Rows(_Row).Cells(_Column).Value.ToString
Next
LineToWrite = LineToWrite.Remove(0, 1) '/ Remove the first comma.
swWriter.WriteLine(Trim(LineToWrite))
Next
swWriter.Flush()
swWriter.Close()
'//
Dim show As New mb.ShowMessagebox
show.Fonts(New Font("Century Gothic", 34))
show.ShowBox("บันทึกข้อมูลเรียบร้อย.", mb.MStyle.ok, mb.FStyle.Exclamation, "รายงานสถานะ")
Catch ex As Exception
MessageBox.Show(ex.Message, "รายงานความผิดพลาด", MessageBoxButtons.OK, MessageBoxIcon.Warning)
End Try
End If
End Sub
' / --------------------------------------------------------------------------------
' / 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 ASCII Code = 92) at the end.
If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
End Function
Private Sub btnPlaySound_Click(sender As System.Object, e As System.EventArgs) Handles btnPlaySound.Click
Call PlaySoundLotto()
End Sub
Sub PlaySoundLotto()
If cmbBuzzer.SelectedIndex = 0 Then
Buzzer = MyPath(Application.StartupPath) & "audio\lottosound.wav"
Else
Buzzer = MyPath(Application.StartupPath) & "audio\buzzers.wav"
End If
Dim Player As New SoundPlayer(Buzzer)
Player.Play()
End Sub
Private Sub ToolStripStatusLabel2_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel2.Click
Process.Start("https://www.g2gnet.com")
End Sub
Private Sub ToolStripStatusLabel3_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel3.Click
Process.Start("https://www.facebook.com/g2gnet")
End Sub
Private Sub cmbSpeed_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbSpeed.SelectedIndexChanged
Select Case cmbSpeed.SelectedIndex
Case 0
Timer1.Interval = 100
Case 1
Timer1.Interval = 50
Case 2
Timer1.Interval = 10
End Select
End Sub
Private Sub cmbColor_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbColor.SelectedIndexChanged
Select Case cmbColor.SelectedIndex
Case 0
With Me.DigitalGauge1
.BackgroundGradientStartColor = Color.Black
.BackgroundGradientEndColor = Color.Black
.ForeColor = Color.White
End With
Case 1
With Me.DigitalGauge1
.BackgroundGradientStartColor = Color.White
.BackgroundGradientEndColor = Color.White
.ForeColor = Color.Red
End With
Case 2
With Me.DigitalGauge1
.BackgroundGradientStartColor = Color.White
.BackgroundGradientEndColor = Color.White
.ForeColor = Color.Black
End With
End Select
End Sub
End Class
โค้ดในส่วนของฟอร์มป้อนรายการของรางวัล (frmReward.vb) ...
Public Class frmReward
Private Sub btnOK_Click(sender As System.Object, e As System.EventArgs) Handles btnOK.Click
frmRandomNumber.dgvData.CurrentRow.Cells(1).Value = Trim(txtReward.Text)
Me.Close()
End Sub
Private Sub frmDetail_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
Select Case e.KeyCode
Case Keys.F9
Call btnOK_Click(sender, e)
Case Keys.Escape
Me.Close()
End Select
End Sub
Private Sub frmReward_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
txtReward.Text = frmRandomNumber.dgvData.CurrentRow.Cells(1).Value.ToString
txtReward.Focus()
End Sub
Private Sub btnCancel_Click(sender As System.Object, e As System.EventArgs) Handles btnCancel.Click
Me.Close()
End Sub
Private Sub txtReward_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtReward.KeyPress
If Asc(e.KeyChar) = 13 Then
e.Handled = True
Call btnOK_Click(sender, e)
End If
End Sub
End Class
ดาวน์โหลดโค้ดต้นฉบับเต็ม VB.NET (2010) ได้ที่นี่ ...
ขอบคุณครับ
หน้า:
[1]