Sette exception i range i VB, hvordan?

[TheEdge]

Var litt vanskelig å formulere en god topic på dette..

 

skal lage et lite program i Visual Basic( 6.0)

Problemet er at jeg skal bruke rnd funksjonen til å genere et tilfeldig tall innen en "range" . Så skal den genere neste tall i rekken fra samme "range", men her skal de første tallet være utelukket. Når tredje tall skal generes, skal de to første tallene utelukkes. Sånn skal den holde på intill alle tallene i rangen har vært brukt èn gang i tilfeldig rekkefølge.

 

For å oppsumere: Den skal velge tilfeldige tall innen en "range" og utelate de allerede valgte tallene når neste tall skal genereres, og holde på til alle tallene i rangen har vært med en gang.

 

Dersom jeg da bruker denne koden:

 

Text6(1) = Int((Val(Text3) * Rnd) + 1)

 

Her skal tekstboks 6(1) være et tilfeldig tall mellom 1 og verdien av textboks3.

Så kjøres koden en gang til, men da er det text6(2) som skal ha et tilfeldig tall innenfor samme "range" men hvor det først utplukkede tallet skal være utelatt fra range'n.

 

text6(3) , samme opplegg men her skal de to først utpluggede tallene være utelatt fra rang'en, osv.

 

 

Jeg kan jo selvsagt bare kjøre random med samme rang'en om og om igjen, og bare la den prøve omigjen dersom den treffer et allerede valgt tall. Men det er en heller dårlig ide, da den vil bomme veldig mye på slutten da de fleste tallene allerede er valgt.. Det vil ta for lang tid..

 

Så spørsmålet er da, hvordan i allverden få til dette dersom man tar utgangspunk i den koden jeg skrev???

Eller evt. forslag til andre koder..

 

 

Noen som vet?

 

 

Hensikten med programmet er at jeg skal kunne putte inn f.eks 10 bokstaver, og så skal programmet stokke om på bokstavene og lage nye tibokstavers ord utav de 10 bokstavene i tilfeldig rekkefølge, og liste opp en del forslag. Neste gang blir det kanskje 5 eller 35 bokstaver.. Programmet er jo veldig enkelt, men sliter med å få til disse utelatelsene i rekkevidden.. Huff, norsk er jo et ubrukelig språk da...

 

 

The Edge

[TheEdge]

Hmm, mulig jeg fant løsningen i en annen kode postet på forumet her..

 

Men fåkke prøvd før jeg kommer hjem..

Endret 25. august 2005 av TheEdge

[aadnk]

Jeg skulle tro følgende kode burde fungere:

 

Public Sub SetControls(aTextboxes As Object, ByVal Start As Long, ByVal Last As Long)

 

    ' Vår datatabell som lagrer alle tilgjengelige tall

    Dim aNumbers() As Long, Tell As Long, Buff As Long, lngNum As Long

   

    ' Initialiser tilfeldighetsgenerator

    Randomize

   

    ' Lag datatabell

    ReDim aNumbers(Start To Last)

   

    ' Legg inn de riktige tall

    For Tell = Start To Last

        aNumbers(Tell) = Tell

    Next

   

    ' Finn tilfeldige tall inntil ingen alternativer gjenstår

    For Tell = Start To Last

   

        ' Kalkuler et tilfeldig tall

        lngNum = (Rnd * (UBound(aNumbers) - LBound(aNumbers))) + LBound(aNumbers)

       

        ' Sett den respektive tekstboks

        aTextboxes(Tell) = aNumbers(lngNum)

       

        ' Flytt alle tall ovenfor det oppbrukte tallet nedover

        For Buff = lngNum To UBound(aNumbers) - 1

            aNumbers(Buff) = aNumbers(Buff + 1)

        Next

       

        ' Alloker datatabell igjen, såfremt det er noe igjen å allokere

        If UBound(aNumbers) > Start Then

            ReDim Preserve aNumbers(Start To UBound(aNumbers) - 1)

        End If

   

    Next

 

End Sub

 

For å sette femti tekstbokser til en tilfeldig verdi mellom èn og femti, der ingen dupliserte elementer forekommer, kjører du følgende kode:

 

SetControls Text6, 1, 50

[TheEdge]

For å sette femti tekstbokser til en tilfeldig verdi mellom èn og femti, der ingen dupliserte elementer forekommer, kjører du følgende kode:

 

SetControls Text6, 1, 50

Hei.

 

Takk for forslag. Må se litt på den koden for å forstå den fullt ut, for å finne ut om jeg kan bruke den... Leeeenge siden jeg var borti VB nå, så prøver å friske oppigjen litt for morro skyld..

 

Men for å si det enkelt: Jeg skal mate programmet med et eller annet ord på f.eks. 20 bokstaver, så skal programmet stokke om på dette ordet og komme opp med f.eks. 200 ord på 20 bokstaver med de samme bokstavene som jeg tastet inn.

 

D.v.s. programmet kan ikke plukke tilfeldige bokstaver fra hele alfabetet og så mange av hver bokstav det vil. Den må bruke alle bokstavene jeg tastet inn èn gang.

 

 

The Edge

[aadnk]

Du skal med andre ord lage anagrammer? I så fall tror jeg denne prosedyren vil fungere:

 

Public Sub MakeAnagrams(sText As String, Optional ByVal Locked As Variant, Optional Count As Long)

 

    Dim Tell As Long, sBuffer As String, sTemp As String, lngTemp As Long, lngPos() As Long

 

    ' Sjekk for spesielle tilfeller

    If Len(sText) = 2 Then

   

        ' I dette tilfellet finnes det kun to anagrammer

        AppendAnagram sText

        AppendAnagram Mid(sText, 2, 1) & Mid(sText, 1, 1)

   

        ' Vi er ferdige med søkeprosedyren - ikke gå videre

        Exit Sub

   

    End If

 

    ' Se om låstabellen må allokeres

    If Not IsArray(Locked) Then

       

        ' Alloker nok elementer

        ReDim Locked(1 To Len(sText))

       

        ' Lagre mengden av ulåste karakterer

        Count = Len(sText)

       

        ' Legg til det første anagrammet

        AppendAnagram sText

           

    End If

   

    ' Gå gjennom hver eneste karakter som ikke er låst og lås dem inntil vi har kun to karakterer igjen

    For Tell = 1 To Len(sText)

   

        ' Se om denne karakteren er låst

        If Not Locked(Tell) Then

       

            ' Lås karakter

            Locked(Tell) = True

           

            ' Senk teller

            Count = Count - 1

       

            ' Nå, dersom det fremdeles er noen karakterer igjen

            If Count > 2 Then

           

                ' ... må vi gå igjennom alle sammen

                MakeAnagrams sText, Locked, Count

           

            ElseIf Count = 2 Then

           

                ' Alloker buffer

                sBuffer = sText

           

                ' Tøm tabell

                ReDim lngPos(1)

           

                ' Nå er kun to karakterer ulåst - finn dem begge

                For lngTemp = 1 To Len(sText)

               

                    ' Se om denne karakteren er låst

                    If Not Locked(lngTemp) Then

                   

                        ' Lagre posisjon

                        If lngPos(0) = 0 Then

                            lngPos(0) = lngTemp

                        Else

                            lngPos(1) = lngTemp

                        End If

                   

                    End If

               

                Next

               

                ' Hent den første karakteren av de to som ikke er låst

                sTemp = Mid(sText, lngPos(0), 1)

               

                ' Bytt mellom begge

                Mid(sBuffer, lngPos(0), 1) = Mid(sText, lngPos(1), 1)

                Mid(sBuffer, lngPos(1), 1) = sTemp

               

                ' Legg til dette anagrammet

                AppendAnagram sBuffer

               

            End If

       

            ' Lås opp karakter

            Locked(Tell) = False

           

            ' Øk teller

            Count = Count + 1

       

        End If

   

    Next

   

End Sub

 

Public Sub AppendAnagram(sText As String)

 

    ' Skriv din kode her for å lagre anagrammet som ble funnet (evt. i en tekstboks, en listeboks ect.)

    ' Debug.Print sText

 

End Sub

[TheEdge]

Takk igjen..

 

Den der funker sikkert, dersom jeg bare greier å få kombinert den med et grensesnitt... Men her var en del, for meg, nye funksjoner, eller i allefall en del jeg ikke husker igjen, så jeg må fundere litt på hvordan jeg skal få brukt dette..

 

 

The Edge