|
โค้ดโปรแกรมชุดนี้แอดมินเลือกใช้ Digital Gauge ของฟรีจากค่าย Syncfusion น่ะครับ หากต้องการจะปรับแต่งโค้ดก็ต้องไป ดาวน์โหลด Syncfusion Community License มาทำการติดตั้งให้เรียบร้อยก่อน และต้องสมัครสมาชิกเขาด้วยล่ะครับ ถึงจะดาวน์โหลดได้ (เวอร์ชั่นของแอดมิน 17.1400.0.47) และต้องปรับ Net FrameWork ให้เป็นรุ่น 4.0 แบบเต็มด้วยครับ ...
ดาวน์โหลดโปรแกรมเพื่อนำไปใช้งานอย่างเดียว ...
Add References ... สำหรับ MB.DLL เป็น Custom MessageBox เพื่อให้แสดงผลตัวอักษรตัวใหญ่ได้
มาดูโค้ดฉบับเต็มกันเถอะ ...
- 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) ได้ที่นี่ ...
|
ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง
คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน
x
|