|  | 
 
|  
 โค้ดโปรแกรมชุดนี้แอดมินเลือกใช้ 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ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึงคุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน  |