โปรแกรมสุ่มตัวเลขจำนวนเต็มแบบไม่ให้ซ้ำกันเลย - Random Number

'Array of long integers for generating all random numbers
Dim r&(1 To 100)

Function Rand&()
    'Get pointers into table
    i% = r&(98)
    j% = r&(99)
    
    'Subtract the two table values
    t& = r&(i%) - r&(j%)
    
    'Adjust result if less than zero
    If t& < 0 Then
        t& = t& + 1000000000
    End If
    
    'Replace table entry with new random number
    r&(i%) = t&
    
    'Decrement first index, keeping in range 1 through 55
    If i% > 1 Then
        r&(98) = i% - 1
    Else
        r&(98) = 55
    End If
    
    'Decrement second index, keeping in range 1 through 55
    If j% > 1 Then
        r&(99) = j% - 1
    Else
        r&(99) = 55
    End If
    
    'Use last random number to index into shuffle table
    i% = r&(100) Mod 42 + 56
    
   'Grab random number from table as current random number
   r&(100) = r&(i%)
    
    'Put new calculated random number into table
    r&(i%) = t&
    
    'Return random number grabbed from table
    Rand& = r&(100)
End Function

Function RandInteger%(a%, b%)
    RandInteger% = a% + (Rand&() Mod (b% - a% + 1))
End Function

Sub RandShuffle(key$)
    'Form 97-character string, with key$ as part of it
    tmp$ = Left$("Abracadabra" + key$ + Space$(86), 97)
    
    'Use each character to seed table
    For i% = 1 To 97
        r&(i%) = Asc(Mid$(tmp$, i%, 1)) * 8171717 + i% * 997&
    Next i%
    
    'Preserve string space
    tmp$ = ""
    
    'Initialize pointers into table
    i% = 97
    j% = 12
    
    'Randomize table to get it warmed up
    For k% = 1 To 997
        
        'Subtract entries pointed to by i% and j%
        r&(i%) = r&(i%) - r&(j%)
        
        'Adjust result if less than zero
        If r&(i%) < 0 Then
            r&(i%) = r&(i%) + 1000000000
        End If
        
        'Decrement first index, keeping in range 1 through 97
        If i% > 1 Then
            i% = i% - 1
        Else
            i% = 97
        End If
        
        'Decrement second index, keeping in range 1 through 97
        If j% > 1 Then
            j% = j% - 1
        Else
            j% = 97
        End If
        
        Next k%
        
        'Initialize pointers for use by Rand& function
        r&(98) = 55
        r&(99) = 24
        
        'Initialize pointer for shuffle table lookup by Rand& function
        r&(100) = 77
End Sub

Option Explicit

Dim MAXNUM As Integer   ' จำนวนตัวเลขสูงสุด
Dim Flag()
Dim TempRandom()          ' เก็บไว้ทดสอบไม่ให้มีค่าซ้ำ
Dim TempRandomAll()     ' สุ่มตัวเลขออกมาทั้งหมด
Dim blnFlag As Boolean

Private Sub Form_Load()
    txtRandom.Text = ""
    txtMax = ""
End Sub

Private Sub cmdRandom_Click()
If Trim(txtMax.Text) = "" Or Len(Trim(txtMax.Text)) = 0 Then Exit Sub
    MAXNUM = txtMax.Text
    
    ' สุ่มค่าเริ่มต้นก่อน
    RandShuffle Date$ + Time$ + Str$(Timer)
    '
    Call RandomNew
    
    ' อันนี้ไม่มีอะไรครับ เลื่อนตำแหน่งตามการแสดงผลของ TextBox เท่านั้นเอง
    txtRandom.SetFocus
    SendKeys "^{End}"
End Sub

Private Sub Timer1_Timer()
Dim k As Variant
Dim n As Integer
Dim i As Integer, j As Integer
ReDim Flag(MAXNUM)
ReDim TempRandom(MAXNUM)
ReDim TempRandomAll(MAXNUM)

    ' ตรวจสอบทุกครั้งที่มีการสุ่ม
    For i = 1 To MAXNUM
        ' Flag is True if already random and fix Vaule
        If Flag(i) = False Then
            'Generate unique number
            Do
                'Generate any number in range
                n = RandInteger(1, MAXNUM)
        
                'Previously grabbed?
                blnFlag = True
                For j = 1 To i
                    k = TempRandomAll(j)
                    If j < i And n = k Then
                        blnFlag = False
                        Exit For
                    End If
                Next
            
                'Grab only if number is unique
                If blnFlag = True Then
                    TempRandom(i) = n
                    TempRandomAll(i) = n
                End If
            Loop Until blnFlag = True
        End If
    Next
End Sub

Sub RandomNew()
Dim i As Integer
ReDim TempRandom(MAXNUM)
    ' Trig Timer
    Timer1_Timer
    
    ' ส่วนนี้แหละครับที่นำไปใช้งานได้เลย
    For i = 1 To MAXNUM
        txtRandom.Text = txtRandom.Text & " " & TempRandomAll(i)
    Next i
    
    ' นำไปแสดงผลใน TextBox
    txtRandom.Text = txtRandom.Text & vbCrLf
End Sub

Private Sub cmdExit_Click()
    End
End Sub

Private Sub txtRandom_KeyPress(KeyAscii As Integer)
    ' ไม่รับการกดคีย์ใดๆ
    KeyAscii = 0
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
        Case 13         ' Enter
        Case Else
            Index = 0
    End Select
    CheckDigitOnly = Index
End Function