ชุมชนคนรักภาษาเบสิค - Visual Basic Community

 ลืมรหัสผ่าน
 ลงทะเบียน
ค้นหา
ดู: 6017|ตอบกลับ: 1

[VB.NET] แจกฟรีโปรแกรมและโค้ดของการสุ่มตัวเลข 2 และ 3 หลัก ในการจับฉลากรางวัล

[คัดลอกลิงก์]

320

กระทู้

512

โพสต์

6583

เครดิต

ผู้ดูแลระบบ

ทองก้อน ทับทิมกรอบ

Rank: 9Rank: 9Rank: 9

เครดิต
6583



โค้ดโปรแกรมชุดนี้แอดมินเลือกใช้ Digital Gauge ของฟรีจากค่าย Syncfusion น่ะครับ หากต้องการจะปรับแต่งโค้ดก็ต้องไป ดาวน์โหลด Syncfusion Community License มาทำการติดตั้งให้เรียบร้อยก่อน และต้องสมัครสมาชิกเขาด้วยล่ะครับ ถึงจะดาวน์โหลดได้ (เวอร์ชั่นของแอดมิน 17.1400.0.47) และต้องปรับ Net FrameWork ให้เป็นรุ่น 4.0 แบบเต็มด้วยครับ ...


ดาวน์โหลดโปรแกรมเพื่อนำไปใช้งานอย่างเดียว ...

Add References ... สำหรับ MB.DLL เป็น Custom MessageBox เพื่อให้แสดงผลตัวอักษรตัวใหญ่ได้


มาดูโค้ดฉบับเต็มกันเถอะ ...
  1. Imports System.IO
  2. Imports System.Media

  3. Public Class frmRandomNumber
  4.     Dim RndNum As Integer
  5.     Dim Buzzer As String

  6.     Private Sub Timer1_Tick(sender As System.Object, e As System.EventArgs) Handles Timer1.Tick
  7.         ' / Formular
  8.         ' / Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)
  9.         RndNum = Int((CInt(cmbUpper.Text) - CInt(cmbLower.Text) + 1) * Rnd() + CInt(cmbLower.Text))
  10.         '//
  11.         If rdo2Digit.Checked Then
  12.             Me.DigitalGauge1.Value = Microsoft.VisualBasic.Right("00" & RndNum, 2)
  13.         Else
  14.             Me.DigitalGauge1.Value = Microsoft.VisualBasic.Right("000" & RndNum, 3)
  15.         End If
  16.         '//
  17.     End Sub

  18.     Private Sub frmRandomNumber_FormClosed(sender As Object, e As System.Windows.Forms.FormClosedEventArgs) Handles Me.FormClosed
  19.         Me.Dispose()
  20.         Application.Exit()
  21.     End Sub

  22.     Private Sub frmRandomNumber_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
  23.         '/ Me.DigitalGauge1.Size = New Size(760, 308)
  24.         Randomize()
  25.         'Timer1.Interval = 50
  26.         Timer1.Enabled = False
  27.         '
  28.         Call SetupGridView()
  29.         rdo3Digit.Checked = True
  30.         'Call SetupRange()
  31.         '//
  32.         cmbBuzzer.Items.Add("Buzzer 1")
  33.         cmbBuzzer.Items.Add("Buzzer 2")
  34.         cmbBuzzer.SelectedIndex = 0
  35.         '//
  36.         With cmbSpeed
  37.             .Items.Add("Speed 1")
  38.             .Items.Add("Speed 2")
  39.             .Items.Add("Speed 3")
  40.         End With
  41.         cmbSpeed.SelectedIndex = 1
  42.         '// DigiTalGauge Setup
  43.         With cmbColor
  44.             .Items.Add("Color 1")
  45.             .Items.Add("Color 2")
  46.             .Items.Add("Color 3")
  47.         End With
  48.         cmbColor.SelectedIndex = 0
  49.     End Sub

  50.     Sub SetupRange()
  51.         cmbLower.Items.Clear()
  52.         cmbUpper.Items.Clear()
  53.         If rdo2Digit.Checked Then
  54.             For i = 1 To 99
  55.                 cmbLower.Items.Add(i)
  56.                 cmbUpper.Items.Add(i)
  57.             Next
  58.             '//
  59.         ElseIf rdo3Digit.Checked Then
  60.             For i = 1 To 999
  61.                 cmbLower.Items.Add(i)
  62.                 cmbUpper.Items.Add(i)
  63.             Next
  64.         End If
  65.         cmbLower.SelectedIndex = 0
  66.         cmbUpper.SelectedIndex = cmbUpper.Items.Count - 1
  67.     End Sub

  68.     Private Sub btnStartStop_Click(sender As System.Object, e As System.EventArgs) Handles btnStartStop.Click
  69.         If CInt(cmbLower.Text) >= CInt(cmbUpper.Text) Then
  70.             Dim show As New mb.ShowMessagebox
  71.             show.Fonts(New Font("Century Gothic", 34))
  72.             show.ShowBox("ค่าเริ่มต้นต้องน้อยกว่าค่าสิ้นสุดเท่านั้น.", mb.MStyle.ok, mb.FStyle.Exclamation, "ตั้งค่าตัวเลขไม่ถูกต้อง")
  73.             Return
  74.         End If
  75.         '//
  76.         If Me.btnStartStop.Text = "START" Then
  77.             Timer1.Enabled = False
  78.             btnStartStop.Text = "STOP"
  79.             btnSave.Enabled = True
  80.             btnRemove.Enabled = True
  81.             rdo2Digit.Enabled = True
  82.             rdo3Digit.Enabled = True
  83.             cmbLower.Enabled = True
  84.             cmbUpper.Enabled = True
  85.             '// Add Row.
  86.             For iRow = 0 To dgvData.Rows.Count - 1
  87.                 If Me.DigitalGauge1.Value = dgvData.Rows(iRow).Cells(0).Value Then
  88.                     Dim show As New mb.ShowMessagebox
  89.                     show.Fonts(New Font("Century Gothic", 34))
  90.                     show.ShowBox("หมายเลข: " & Me.DigitalGauge1.Value & " ได้รับรางวัลเรียบร้อยแล้ว.", mb.MStyle.ok, mb.FStyle.Exclamation, "รายงานรางวัลซ้ำ")
  91.                     Return
  92.                 End If
  93.             Next
  94.             dgvData.Rows.Add(New String() {Me.DigitalGauge1.Value, ""})
  95.             dgvData.Focus()
  96.             SendKeys.Send("^{END}")
  97.             If chkPlaySound.Checked Then Call PlaySoundLotto()
  98.             Timer1.Stop()

  99.             '//
  100.         Else
  101.             Randomize()
  102.             'Timer1.Interval = 50    ' 1000 millisecond = 1 second.
  103.             Timer1.Enabled = True
  104.             btnStartStop.Text = "START"
  105.             btnSave.Enabled = False
  106.             btnRemove.Enabled = False
  107.             rdo2Digit.Enabled = False
  108.             rdo3Digit.Enabled = False
  109.             cmbLower.Enabled = False
  110.             cmbUpper.Enabled = False
  111.         End If
  112.     End Sub

  113.     Private Sub rdo3Digit_CheckChanged(sender As System.Object, e As System.EventArgs) Handles rdo3Digit.CheckChanged
  114.         Me.DigitalGauge1.CharacterCount = 3
  115.         Call SetupRange()
  116.     End Sub

  117.     Private Sub rdo2Digit_CheckChanged(sender As System.Object, e As System.EventArgs) Handles rdo2Digit.CheckChanged
  118.         Me.DigitalGauge1.CharacterCount = 2
  119.         Call SetupRange()
  120.     End Sub

  121.     ' / --------------------------------------------------------------------------------
  122.     Private Sub SetupGridView()
  123.         With dgvData
  124.             .RowHeadersVisible = False
  125.             .AllowUserToAddRows = False
  126.             .AllowUserToDeleteRows = False
  127.             .AllowUserToResizeRows = False
  128.             .MultiSelect = False
  129.             .SelectionMode = DataGridViewSelectionMode.FullRowSelect
  130.             .ReadOnly = True
  131.             .RowTemplate.Height = 48
  132.             .ColumnHeadersHeight = 54
  133.             .Font = New Font("Century Gothic", 32, FontStyle.Bold)
  134.             ' Columns Specified
  135.             .Columns.Add("Number", "หมายเลข")
  136.             .Columns.Add("Reward", "รางวัล")
  137.             .Columns(1).DefaultCellStyle.Font = New Font("Tahoma", 20, FontStyle.Bold)
  138.             '/ Autosize Column
  139.             .AutoSizeColumnsMode = DataGridViewAutoSizeColumnsMode.Fill
  140.             '.AutoResizeColumns()
  141.             '// Even-Odd Color
  142.             .AlternatingRowsDefaultCellStyle.BackColor = Color.AliceBlue
  143.             '/ Adjust Header Styles
  144.             With .ColumnHeadersDefaultCellStyle
  145.                 .BackColor = Color.Navy
  146.                 .ForeColor = Color.Black ' Color.White
  147.                 .Font = New Font("Century Gothic", 28, FontStyle.Bold)
  148.             End With
  149.         End With
  150.         For i = 0 To 1
  151.             With dgvData
  152.                 .Columns(i).HeaderCell.Style.Alignment = DataGridViewContentAlignment.MiddleLeft
  153.                 .Columns(i).DefaultCellStyle.Alignment = DataGridViewContentAlignment.MiddleLeft
  154.             End With
  155.         Next
  156.     End Sub

  157.     Private Sub dgvData_DoubleClick(sender As Object, e As System.EventArgs) Handles dgvData.DoubleClick
  158.         If dgvData.Rows.Count = 0 Then Return
  159.         frmReward.ShowDialog()
  160.     End Sub

  161.     Private Sub btnRemove_Click(sender As System.Object, e As System.EventArgs) Handles btnRemove.Click
  162.         If dgvData.RowCount = 0 Then Exit Sub
  163.         '//
  164.         Dim show As New mb.ShowMessagebox
  165.         show.Fonts(New Font("Century Gothic", 34))
  166.         If show.ShowBox("คุณแน่ใจว่าต้องการลบข้อมูลนี้?", mb.MStyle.YesNo, mb.FStyle.Question, "ยืนยันการลบข้อมูล") = DialogResult.Yes Then
  167.             dgvData.Rows.Remove(dgvData.CurrentRow)
  168.             dgvData.Refresh()
  169.         End If
  170.     End Sub

  171.     Private Sub btnSave_Click(sender As System.Object, e As System.EventArgs) Handles btnSave.Click
  172.         If dgvData.Rows.Count = 0 Then Return
  173.         '/ ประกาศใช้งาน Save File Dialog ในแบบ Run Time
  174.         Dim dlgSaveFile As SaveFileDialog = New SaveFileDialog

  175.         ' / Save File Dialog
  176.         With dlgSaveFile
  177.             .InitialDirectory = MyPath(Application.StartupPath)
  178.             .Title = "Select text file."
  179.             .Filter = "Text Files (*.txt)|*.txt"
  180.             .FilterIndex = 1
  181.             .RestoreDirectory = True
  182.         End With
  183.         '/ Choose OK button after Browse ...
  184.         If dlgSaveFile.ShowDialog() = DialogResult.OK Then
  185.             Dim swWriter As New StreamWriter(dlgSaveFile.FileName)
  186.             Dim LineToWrite As String = String.Empty
  187.             Try
  188.                 For _Row As Integer = 0 To dgvData.Rows.Count - 1
  189.                     LineToWrite = String.Empty
  190.                     For _Column As Integer = 0 To dgvData.Columns.Count - 1
  191.                         LineToWrite &= ", " & dgvData.Rows(_Row).Cells(_Column).Value.ToString
  192.                     Next
  193.                     LineToWrite = LineToWrite.Remove(0, 1) '/ Remove the first comma.
  194.                     swWriter.WriteLine(Trim(LineToWrite))
  195.                 Next
  196.                 swWriter.Flush()
  197.                 swWriter.Close()
  198.                 '//
  199.                 Dim show As New mb.ShowMessagebox
  200.                 show.Fonts(New Font("Century Gothic", 34))
  201.                 show.ShowBox("บันทึกข้อมูลเรียบร้อย.", mb.MStyle.ok, mb.FStyle.Exclamation, "รายงานสถานะ")
  202.             Catch ex As Exception
  203.                 MessageBox.Show(ex.Message, "รายงานความผิดพลาด", MessageBoxButtons.OK, MessageBoxIcon.Warning)
  204.             End Try
  205.         End If
  206.     End Sub

  207.     ' / --------------------------------------------------------------------------------
  208.     ' / Get my project path
  209.     ' / AppPath = C:\My Project\bin\debug
  210.     ' / Replace "\bin\debug" with ""
  211.     ' / Return : C:\My Project\
  212.     Function MyPath(AppPath As String) As String
  213.         '/ MessageBox.Show(AppPath);
  214.         AppPath = AppPath.ToLower()
  215.         '/ Return Value
  216.         MyPath = AppPath.Replace("\bin\debug", "").Replace("\bin\release", "").Replace("\bin\x86\debug", "")
  217.         '// If not found folder then put the \ (BackSlash ASCII Code = 92) at the end.
  218.         If Microsoft.VisualBasic.Right(MyPath, 1) <> Chr(92) Then MyPath = MyPath & Chr(92)
  219.     End Function

  220.     Private Sub btnPlaySound_Click(sender As System.Object, e As System.EventArgs) Handles btnPlaySound.Click
  221.         Call PlaySoundLotto()
  222.     End Sub

  223.     Sub PlaySoundLotto()
  224.         If cmbBuzzer.SelectedIndex = 0 Then
  225.             Buzzer = MyPath(Application.StartupPath) & "audio\lottosound.wav"
  226.         Else
  227.             Buzzer = MyPath(Application.StartupPath) & "audio\buzzers.wav"
  228.         End If
  229.         Dim Player As New SoundPlayer(Buzzer)
  230.         Player.Play()
  231.     End Sub

  232.     Private Sub ToolStripStatusLabel2_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel2.Click
  233.         Process.Start("https://www.g2gnet.com")
  234.     End Sub

  235.     Private Sub ToolStripStatusLabel3_Click(sender As System.Object, e As System.EventArgs) Handles ToolStripStatusLabel3.Click
  236.         Process.Start("https://www.facebook.com/g2gnet")
  237.     End Sub

  238.     Private Sub cmbSpeed_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbSpeed.SelectedIndexChanged
  239.         Select Case cmbSpeed.SelectedIndex
  240.             Case 0
  241.                 Timer1.Interval = 100
  242.             Case 1
  243.                 Timer1.Interval = 50
  244.             Case 2
  245.                 Timer1.Interval = 10
  246.         End Select
  247.     End Sub

  248.     Private Sub cmbColor_SelectedIndexChanged(sender As System.Object, e As System.EventArgs) Handles cmbColor.SelectedIndexChanged
  249.         Select Case cmbColor.SelectedIndex
  250.             Case 0
  251.                 With Me.DigitalGauge1
  252.                     .BackgroundGradientStartColor = Color.Black
  253.                     .BackgroundGradientEndColor = Color.Black
  254.                     .ForeColor = Color.White
  255.                 End With
  256.             Case 1
  257.                 With Me.DigitalGauge1
  258.                     .BackgroundGradientStartColor = Color.White
  259.                     .BackgroundGradientEndColor = Color.White
  260.                     .ForeColor = Color.Red
  261.                 End With
  262.             Case 2
  263.                 With Me.DigitalGauge1
  264.                     .BackgroundGradientStartColor = Color.White
  265.                     .BackgroundGradientEndColor = Color.White
  266.                     .ForeColor = Color.Black
  267.                 End With
  268.         End Select
  269.     End Sub
  270. End Class
คัดลอกไปที่คลิปบอร์ด

โค้ดในส่วนของฟอร์มป้อนรายการของรางวัล (frmReward.vb) ...
  1. Public Class frmReward

  2.     Private Sub btnOK_Click(sender As System.Object, e As System.EventArgs) Handles btnOK.Click
  3.         frmRandomNumber.dgvData.CurrentRow.Cells(1).Value = Trim(txtReward.Text)
  4.         Me.Close()
  5.     End Sub

  6.     Private Sub frmDetail_KeyDown(sender As Object, e As System.Windows.Forms.KeyEventArgs) Handles Me.KeyDown
  7.         Select Case e.KeyCode
  8.             Case Keys.F9
  9.                 Call btnOK_Click(sender, e)
  10.             Case Keys.Escape
  11.                 Me.Close()
  12.         End Select
  13.     End Sub

  14.     Private Sub frmReward_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
  15.         txtReward.Text = frmRandomNumber.dgvData.CurrentRow.Cells(1).Value.ToString
  16.         txtReward.Focus()
  17.     End Sub

  18.     Private Sub btnCancel_Click(sender As System.Object, e As System.EventArgs) Handles btnCancel.Click
  19.         Me.Close()
  20.     End Sub

  21.     Private Sub txtReward_KeyPress(sender As Object, e As System.Windows.Forms.KeyPressEventArgs) Handles txtReward.KeyPress
  22.         If Asc(e.KeyChar) = 13 Then
  23.             e.Handled = True
  24.             Call btnOK_Click(sender, e)
  25.         End If
  26.     End Sub
  27. End Class
คัดลอกไปที่คลิปบอร์ด

ดาวน์โหลดโค้ดต้นฉบับเต็ม VB.NET (2010) ได้ที่นี่ ...


ขออภัย! โพสต์นี้มีไฟล์แนบหรือรูปภาพที่ไม่ได้รับอนุญาตให้คุณเข้าถึง

คุณจำเป็นต้อง ลงชื่อเข้าใช้ เพื่อดาวน์โหลดหรือดูไฟล์แนบนี้ คุณยังไม่มีบัญชีใช่ไหม? ลงทะเบียน

x
สิ่งที่ดีกว่าการให้ คือการให้แบบไม่มีที่สิ้นสุด

0

กระทู้

58

โพสต์

140

เครดิต

Member

Rank: 2

เครดิต
140
โพสต์ 2022-10-25 15:01:39 | ดูโพสต์ทั้งหมด

ขอบคุณครับ
ขออภัย! คุณไม่ได้รับสิทธิ์ในการดำเนินการในส่วนนี้ กรุณาเลือกอย่างใดอย่างหนึ่ง ลงชื่อเข้าใช้ | ลงทะเบียน

รายละเอียดเครดิต

ข้อความล้วน|อุปกรณ์พกพา|ประวัติการแบน|G2GNet.com  

GMT+7, 2024-11-27 21:42 , Processed in 0.099342 second(s), 5 queries , File On.

Powered by Discuz! X3.4, Rev.62

Copyright © 2001-2020 Tencent Cloud.

ตอบกระทู้ ขึ้นไปด้านบน ไปที่หน้ารายการกระทู้