ҡդӶ ʵŧ 纺촨շ٨絴͵ ᷹ФѺ

͵Դҷҧ Inbox Ѻ

˹ѡ
-
VB 6/VB.Net
ASP/ASP.Net
Ѻ¤
¹ҹ Flash Movie
ռͺش  
 RSS Feeds
 ǹŴ RSS Reader ...   Download  RSS Reader

Forum - www.g2gnet.com
Webmaster - www.g2gnet.com
Visitors - Session views
 5 6 1 6 1 4 7

7 ѹҤ ..2549
102 Users On-Line.
Visitors - Page views
 8 9 7 3 8 9 0
1 Ҿѹ ..2551

Google   
g2gnet.com
Ҵѡ:  

ŢӹǹẺӡѹ - Random Number

Category »  VB 6/VB.Net
: Webmaster 6/8/2550 23:59:00
(ҹ : 98542) 

ѹԧšԷǹ Шҹʹ㹡÷ CAI (Computer Assisted Instruction) MS Visual Basic 6.0 · ...

  1. Ẻ֡ѴŢ͡ ӡ + - * / (ѹͺ˹ҤѺ ѧҴ͸Ժ)
  2. ӡͺ (ͧóẺѹ DAO)
ͧչͧѧਤ÷ӢͺẺ (ʧਤ 1000 ) ͡ѹҾʹʹ оʹ (ա) ͧҡ繼˭ԧ駹鹴 ǨҼ㨨״ 㨴 ʧͧ Ҵ ѹкһҹ ... ... šԷǹФѺ鹩Ѻ繢ͧ Professor ǵҧҵԷҹ֧ (Ҩ UK ҡԴ) 觼Ҩҡ˹ѧ Visual Basic 3.0 ԴǡѹѹǤѺ ... ͧ ... ˹ѧ˹ͧҴѡж١ "" ФѺ ֧ ҹ鹼ͷšԷǹ բŷ͡ûСͺ ͹͡ѹç ... ͧѺ ͸Ժ Ըաùҹ ...
Ѻҷ ѡâͧѹ͡˹ (Initialize) ͧѹ Ѻ Ңͧ Timer ԡк ѹҷӡ (Random) ѧշҧӡѹ ѧ RandShuffle(key$) ǹФѺͧҡ͹ ԧѺ ...

 

   ǹŴ Source Code Ѻ MS Visual Basic 6.0 - Service Pack 6

Ѿҡѹ ѺͧѺվҴ
ͧԴǡѹҡѺŢ 1-100 դ㹡èѴ§ҡ˹
Ţ = Int((٧ش - ҵش + 1) * Rnd + ҵش) Ẻ¤Ѻ
㹤駡鹼ͧԸ ء駨оѺ LOOP Ẻ Dead Lock

ѺͧѺ ÷ͺӤѭشѹͧФѺ ǹͧͧҹŹѹͧ

ǹС Module


'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

͵ - g2gNet Dot Com
Ţ¹ҳԪ硷͹ԡ 0407314800231
CopyLeft © 2004 - 2099 g2gNet.Com All rights reserved.
Email: [email protected] . 08-6862-6560