ผู้เขียน หัวข้อ: [VB6] โค้ดการสุ่มตัวเลขเพื่อจับสลากรางวัลแบบไม่ให้ซ้ำกันเลย  (อ่าน 222 ครั้ง)

ออฟไลน์ ทองก้อน ทับทิมกรอบ

  • Administrator
  • *****
  • กระทู้: 245
  • เพศ: ชาย
  • Webmaster G2GNet
[VB6] โค้ดการสุ่มตัวเลขเพื่อจับสลากรางวัลแบบไม่ให้ซ้ำกันเลย

โค้ดนี้เคยแจกให้ไปนานแล้วล่ะครับ แต่เอาไปไว้ในเฟซบุ๊ค อย่าว่าแต่คนอื่นเลย แม้แต่ผมยังหาโค้ดตัวเองไม่เจอเลย 5555+ ... ก็เลยนำมาแจกใหม่อีกสักครั้ง เผื่อหลายท่านได้นำไปใช้จับสลากรางวัลเพืิ่อฉลองในหน่วยงาน หรืองานเลี้ยงของทุกๆท่านไปครับ ... รับรองไม่มีเลขล็อค ใช้การคำนวณจากคอมพิวเตอร์หมดน่ะครับ 5555+ ...


ผลจากการรันโปรแกรม

มาดูโค้ดกันเถอะ
โค๊ด: [Select]
' / --------------------------------------------------------------------------------------------------------------
' / Developer : Mr.Surapon Yodsanga (Thongkorn Tubtimkrob)
' / eMail : thongkorn@hotmail.com
' / URL: http://www.g2gnet.com
' / Facebook: www.facebook.com/g2gnet
' / Purpose: Random numbers to a unique number.
' / Microsoft Visual Basic 6.0 Service Pack 6
' / --------------------------------------------------------------------------------------------------------------
Option Explicit
Dim rndNum As Integer

' / --------------------------------------------------------------------------------------------------------------
' / เริ่มต้นการสุ่มตัวเลข
Private Sub cmdRandom_Click()
' / --------------------------------------------------------------------------------------------------------------
    If Trim(txtMax.Text) = "" Or Len(Trim(txtMax.Text)) = 0 Or Val(Trim(txtMax.Text)) = 0 Then
        txtMax.SetFocus
        Exit Sub
    End If
    Randomize
    ' เปิดให้ Timer ทำงาน
    Timer1.Enabled = True
    ' ปิดเปิดปุ่ม
    cmdRandom.Enabled = False
    cmdStop.Enabled = True
End Sub

' / --------------------------------------------------------------------------------------------------------------
' / ใช้ Timer เข้าช่วย
Private Sub Timer1_Timer()
' / --------------------------------------------------------------------------------------------------------------
    ' การสุ่มตัวเลข
    'Int((Upperbound - Lowerbound + 1) * Rnd + Lowerbound)
    ' 1 คือค่าต่ำสุด
    rndNum = Int((txtMax.Text) * Rnd + 1)
    ' แสดงผลตัวเลขที่ได้ในแต่ละครั้ง
    lblRandomNumber.Caption = rndNum
End Sub

Private Sub cmdStop_Click()
    cmdRandom.Enabled = True
    cmdStop.Enabled = False
    ' หยุดเวลาของ Timer
    Timer1.Enabled = False
    ' เรียกไปโปรแกรมย่อย ตรวจหาค่าซ้ำกันก่อน
    Call CheckDataRepeat
End Sub

' / --------------------------------------------------------------------------------------------------------------
' / ตรวจสอบว่ามีค่าซ้ำกันหรือไม่
Private Sub CheckDataRepeat()
' / --------------------------------------------------------------------------------------------------------------
    Dim i As Long
    '/ วนรอบเพื่อตรวจสอบค่าซ้ำ
    For i = 0 To lstRandom.ListCount - 1
        lstRandom.ListIndex = i
        ' เช็คค่าซ้ำ
        If lblRandomNumber.Caption = lstRandom.Text Then
            MsgBox "หมายเลข " & lblRandomNumber.Caption & " ได้รับรางวัลไปเรียบร้อยแล้ว.", _
                vbOKOnly + vbInformation, "รายงานสถานะ"
            Exit Sub
        End If
    Next
    ' ไม่มีตัวเลขซ้ำกับค่าเดิม ให้เพิ่มเข้าไปใหม่ที่ ListBox Control
    lstRandom.AddItem lblRandomNumber.Caption
    ' ย้ายโฟกัสไปที่ List Contrl
    lstRandom.SetFocus
    ' ส่งคีย์ Control + End เพื่อให้ลงไปบรรทัดล่างสุด
    Sendkeys "^{End}"
End Sub

' / --------------------------------------------------------------------------------------------------------------
' / *** สำหรับ Windows 8 ขึ้นมาต้องแก้ไขฟังค์ชั่น SendKeys ใหม่ด้วยครับ ***
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

Private Sub txtMax_KeyPress(KeyAscii As Integer)
    KeyAscii = CheckDigitOnly(KeyAscii)
End Sub

' / --------------------------------------------------------------------------------------------------------------
' ฟังค์ชั่นตรวจการกดคีย์ให้รับค่าเฉพาะตัวเลขเท่านั้น
Function CheckDigitOnly(Index As Integer) As Integer
' / --------------------------------------------------------------------------------------------------------------
    Select Case Index
        Case 48 To 57 ' 0 - 9
        Case 8
            ' Back Space ไม่ระบุการรีเทิร์นค่ากลับ แสดงว่าให้ใช้ค่า Index เดิม
        Case 13         ' Enter
        Case Else
            Index = 0
    End Select
    CheckDigitOnly = Index
End Function

Private Sub Form_Load()
    ' ตั้งค่าสูงสุดเป็นตัวอย่างน่ะครับ
    txtMax.Text = "99"
    Me.Move (Screen.Width - Width) \ 2, (Screen.Height - Height) \ 2
    cmdRandom.Enabled = True
    cmdStop.Enabled = False
    Timer1.Enabled = False
    Timer1.Interval = 10
End Sub

' / ต้องกำหนดให้ฟอร์ม KeyPreview = True ก่อน ถึงจะใช้งานส่วนนี้ได้
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyF2:
            Call cmdRandom_Click
        Case vbKeyF3:
            Call cmdStop_Click
        Case vbKeyF10:
            Call cmdExit_Click
    End Select
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Set frmRandomNumber = Nothing
    End
End Sub

ดาวน์โหลดโค้ดต้นฉบับ VB6 ... ที่นี่

ดาวน์โหลดโปรแกรมที่ทำงานได้เลย ... ที่นี่

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

ออฟไลน์ naien

  • Newbie
  • *
  • กระทู้: 36
ขอบคุณครับ

บันทึกการเข้า

ออฟไลน์ dekdar

  • Newbie
  • *
  • กระทู้: 4
ขอบคุณครับ ป๋า

บันทึกการเข้า