Hvordan prøver man bogstaver af?

Hvad skal der skrives til? En fil eller en tekstboks eller hvad? Og skal den blive ved met at køre, til den er nået til en uendelig lang streng?

som driis siger, det ville være rart at vide hvor længe den skal køre...
og hvordan skal rækkefølgen være ??
a
b
c
d
e
f
g
h
i
aa
ab
ac
ad
ae
af
ag
ah
ai
aaa
aab
osv.
eller hvordan ???
Det kan jo (ved begrænset gennemløb) klares med et par simple FOR løkker

Et eksempel, som kører igennem fra A til 000, hvilket er over 59000 udregninger, og sådanne størrelser burde laves i C, da det allerede ved 5-6 stykker ville være millioner, af udregninger vi taler om.

Option Explicit
Dim Bogstaver
Const Antal = 1
Dim I As Integer
Dim J As Integer
Dim K  As Integer
Dim Brugtebogstav

Private Sub Form_Load()
Bogstaver = Array(\"A\", \"B\", \"C\", \"D\", \"E\", \"F\", \"G\", \"H\", \"I\", \"J\", \"K\", \"L\", \"M\", \"N\", \"O\", \"P\", \"Q\", \"R\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\", \"Z\", \"Æ\", \"Ø\", \"Å\", \"1\", \"2\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\", \"0\")
I = 0
Do While I <= UBound(Bogstaver)
txtListe.Text = txtListe.Text + vbCrLf + Bogstaver(I)
I = I + 1
Loop

I = 0
J = 0
Do While I <= UBound(Bogstaver)
    Do While J <= UBound(Bogstaver)
        txtListe.Text = txtListe.Text + vbCrLf + Bogstaver(I) + Bogstaver(J)
        J = J + 1
    Loop
    J = 0
    I = I + 1
Loop

I = 0
J = 0
Do While I <= UBound(Bogstaver)
    Do While J <= UBound(Bogstaver)
            Do While K <= UBound(Bogstaver)
            txtListe.Text = txtListe.Text + vbCrLf + Bogstaver(I) + Bogstaver(J) + Bogstaver(K)
            K = K + 1
            Loop
            K = 0
        J = J + 1
    Loop
    J = 0
    I = I + 1
Loop

End Sub

dcasso>> Den er lidt svær at overskue for en træt fyr... hvor kommer resultatet (i hvilken variabel)?

Er der en måde man kan få den til at stoppe ved et tryk på en tast eller noget i den retning, så den ikke blokerer det hele?

Du bør nok sætte en DoEvents ind et sted i dcasso\'s kode, så den ikke låser det hele.

Du skal bare lave en tekstboks, ved navn txtliste.

Jeg har ikke lavet nogen måde, til at stoppe den på. Dette kunne jo gøres via. messagebokse

Her er lidt at lege videre med.

med en form, en textbox, en commandbutton og en listbox.

Men jeg er træt og den laver en regnefejl når vi når op i 3 cifre...

Option Explicit

Private Sub Command1_Click()
Dim indre, ydre, x1, laengde, ruligen, rulny, leftbase$, leftcalc$, backcount, y
Dim nowbase$, correct$, yc, msg$
List1.Clear
If Text1.Text = \"\" Then Text1.Text = \"0\"
laengde = Text1.Text
If laengde = 0 Then End
\' a=97 z=122 0=48 9=57
x1 = 96
leftbase$ = \"\"
rulnul:
If ruligen = 0 Then x1 = x1 + 1
If ruligen = 1 Then GoTo videre1
Select Case x1
Case 48 To 56
  List1.AddItem Chr$(x1)
Case 97 To 121
  List1.AddItem Chr$(x1)
Case 122
  List1.AddItem Chr$(x1)
  x1 = 47
Case 57
  List1.AddItem Chr$(x1)
  ruligen = 1
End Select
GoTo rulnul

\'****************************************
\'****************************************

rulsub:
x1 = 97
Do While ruligen = 0
  Select Case x1
  Case 48 To 56
    List1.AddItem leftbase$ & Chr$(x1)
    x1 = x1 + 1
  Case 97 To 121
    List1.AddItem leftbase$ & Chr$(x1)
    x1 = x1 + 1
  Case 122
    List1.AddItem leftbase$ & Chr$(x1)
    x1 = 48
  Case 57
    List1.AddItem leftbase$ & Chr$(x1)
    ruligen = 1
  End Select
Loop
Return
\'****************************************
changesub1:
Select Case Asc(nowbase$)
  Case 48 To 56
    nowbase$ = Chr$(Asc(nowbase$) + 1)
    GoTo basecorrect
  Case 97 To 121
    nowbase$ = Chr$(Asc(nowbase$) + 1)
    GoTo basecorrect
  Case 122
    nowbase$ = \"0\"
   
    GoTo basecorrect
basecorrect:
  End Select
If y = 1 Then correct$ = nowbase$
If y > 1 Then correct$ = Left$(leftbase$, y - 1)
backy1:
If Len(leftbase$) > Len(correct$) Then correct$ = correct$ & \"a\": GoTo backy1
leftbase$ = correct$
ruligen = 0: GoSub rulsub
Return
\'****************************************


\'****************************************
\'****************************************

videre1:
If laengde = 1 Then Text1.SetFocus
leftbase$ = \"a\"
leftcalc$ = \"a\"
ruligen = 0: GoSub rulsub
videre2:
y = Len(leftbase$)
videre3:
nowbase$ = Mid$(leftbase$, y, 1)
  Do While nowbase$ <> \"9\"
  If nowbase$ <> \"9\" Then GoSub changesub1
  Loop
y = y - 1: If y > 0 Then GoTo videre3

leftbase$ = leftbase$ & \"a\": If Len(leftbase$) < laengde Then GoTo videre2
videre4:
Text1.SetFocus
End Sub

Private Sub Form_Load()
Text1.Text = \"2\"
End Sub


Anyway det har da været sjovt :-)

- Mikker

Ellers kan du jo afprøve den op til 2 bogstaver, så skal du bare bruge, denne del af koden:

Option Explicit
Dim Bogstaver
Const Antal = 1
Dim I As Integer
Dim J As Integer
Dim K  As Integer
Dim Brugtebogstav

Private Sub Form_Load()
Bogstaver = Array(\"A\", \"B\", \"C\", \"D\", \"E\", \"F\", \"G\", \"H\", \"I\", \"J\", \"K\", \"L\", \"M\", \"N\", \"O\", \"P\", \"Q\", \"R\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\", \"Z\", \"Æ\", \"Ø\", \"Å\", \"1\", \"2\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\", \"0\")
I = 0
Do While I <= UBound(Bogstaver)
txtListe.Text = txtListe.Text + vbCrLf + Bogstaver(I)
I = I + 1
Loop

I = 0
J = 0
Do While I <= UBound(Bogstaver)
    Do While J <= UBound(Bogstaver)
        txtListe.Text = txtListe.Text + vbCrLf + Bogstaver(I) + Bogstaver(J)
        J = J + 1
    Loop
    J = 0
    I = I + 1
Loop
End sub

Du bør også holde dig fra DoEvents, da dette vil nedsætte hastigheden

dcasso>> Selvfølgelig nedsætter det hastigheden, men det kan jo være, at han gerne vil kunne bruge maskinen imens, hvis prog. skal køre længe.

Jeg forsøger i øjeblikket dit første forslag dcasso, men VB er nu låst og der sker intet i txtboksen, så en stop-ting ville egentlig være rar!

mikker>> Jeg er ked af at sige det, men jeg sorstår sku ikke din kode og derfor kan jeg ikke bruge den, da jeg ikke kan fejlrette i den (og da der er en fejl!)..... :(

driis>> De andre programmer kører fint, men jeg kan ikke bremse VB.....

Jepper.

Hvordan vil du bremse vb (Skal det være via. valgmuligheder, eller hva?)

Hvis du vil kunne standse det ved klik på en knap, kan du jo tildele en værdi til en variabel, og så bruge loop until. F.eks. ved klik på stopknap

StopPressed=True

og i dcasso\'s kode

Loop Until StopPressed=True

Eller noget i den retning.

Præcis

I øvrigt stoppede den ved \"DTI\" øhh.... hvorfor nu det?

driis>> Kan det evt. uddybes lidt (jeg er nok ikke helt så øvet som I andre!), hvor skal den der stoppressed-ting ind henne?

Hvis det stopper der, så er det pga. der ikke er mere plads i tekstboksen (jeg kørte nemlig ikke projektet efter med tre bogstaver), så du bliver nok nødt til at flytte det over i en fil (altså via kode)

Denne her gemmer det hele i filen c:\\testfila.txt og så er den hurtig:

Option Explicit
Dim Bogstaver
Const Antal = 1
Dim I As Integer
Dim J As Integer
Dim K  As Integer
Dim Brugtebogstav
Private Sub Form_Load()

Open \"C:\\testfila.txt\" For Output As #1
Bogstaver = Array(\"A\", \"B\", \"C\", \"D\", \"E\", \"F\", \"G\", \"H\", \"I\", \"J\", \"K\", \"L\", \"M\", \"N\", \"O\", \"P\", \"Q\", \"R\", \"S\", \"T\", \"U\", \"V\", \"W\", \"X\", \"Y\", \"Z\", \"Æ\", \"Ø\", \"Å\", \"1\", \"2\", \"3\", \"4\", \"5\", \"6\", \"7\", \"8\", \"9\", \"0\")
I = 0
Do While I <= UBound(Bogstaver)
Print #1, Bogstaver(I)
I = I + 1
Loop

I = 0
J = 0
Do While I <= UBound(Bogstaver)
    Do While J <= UBound(Bogstaver)
        Print #1, Bogstaver(I) + Bogstaver(J)
        J = J + 1
    Loop
    J = 0
    I = I + 1
Loop

I = 0
J = 0
Do While I <= UBound(Bogstaver)
    Do While J <= UBound(Bogstaver)
            Do While K <= UBound(Bogstaver)
            DoEvents
            Print #1, Bogstaver(I) + Bogstaver(J) + Bogstaver(K)
            K = K + 1
            Loop
            K = 0
        J = J + 1
    Loop
    J = 0
    I = I + 1
Loop
Close #1

End Sub

Hvis det er ligemeget, så tag og vælg den \"normale\" måde at beskrive talsystemer på:

0-9 betyder 0-9
A-Z betyder 10-35

Det du skal have lavet er et Base36 talsystem. Ligesom ved Hexadecimal, der er et Base16 talsystem, så skal du bruge flere tegn (A, B, osv.)

Du skal benytte følgende formel for at få returneret dit Base36 tal fra et Base10 til (almindeligt titalssystem tal):

Lavet i VBA, men det skulle ikke være noget problem lige at \"vippe\" den over i JS.

Public Function GetBase36(MyVal As Long) As String
    Dim TempVal, Pos As Long
    Dim MyConv As String
    Dim C As Integer
   
    MyConv = \"\"
    For C = 3 To 0 Step -1
        Pos = 36 ^ C
        TempVal = MyVal \\ Pos
        MyVal = MyVal - TempVal * Pos
        If TempVal > 9 Then
            TempVal = TempVal + 55
        Else
            TempVal = TempVal + 48
        End If
        MyConv = MyConv + Chr(TempVal)
    Next C
    GetBase36 = MyConv
End Function

Hvorfor ikke bruger ASCII værdier i stedet for bogstaver...? Så kan du jo opbygge en rutine af ascii værdier der bliver konverteret til bogstaver.

Sådan som jeg forstår det: hvorfor ikke bruge timer? det vil da gøre livet lettere...

ok.. det var det

vbghost >>
Det er faktisk det jeg gør !

clausmort skal have det ud i en streng, så derfor returnerer min rutine en streng på 1-4 tegn alt efter, hvor stort et tal han indgiver.

OK!

Her er så koden der virker og hvor du selv bestemmer hvor mange cifre det skal gælde.

MEN

Efter at have kørt en gennemgang med 4 cifre fik jeg en fil på lige under 10 MB!!!
Ikke så nemt at lege med i en txt-editor :-)

Men hvis du insisterer så værsgo:

1 form med en text1 og command1:
Option Explicit

Private Sub Command1_Click()
Dim laengde, a$, x1, y1, leftcalc$, leftbase$, ruligen, z, sammenlign$, msg$
Open \"c:\\bogstavleg.txt\" For Output As #1
If Text1.Text = \"0\" Or Text1.Text = \"\" Then End
laengde = Val(Text1.Text) + 1

forfra:
sammenlign$ = \"\"
leftbase$ = leftbase$ & \"a\": If Len(leftbase$) = laengde Then GoTo slutprog
leftcalc$ = leftbase$

For z = 1 To Len(leftcalc$)
sammenlign$ = sammenlign$ & \"9\"
Next z
gennemloop:

y1 = Len(leftcalc$)
DoEvents
a$ = Mid$(leftcalc$, y1, 1)
ruligen = 0
x1 = 97
Do While ruligen = 0
Select Case x1
  Case 48 To 56
  Mid(leftcalc$, y1, 1) = Chr$(x1)
  Print #1, leftcalc$
  \'List1.AddItem leftcalc$
  x1 = x1 + 1
  Case 97 To 121
  Mid(leftcalc$, y1, 1) = Chr$(x1)
  Print #1, leftcalc$
  \'List1.AddItem leftcalc$
  x1 = x1 + 1
  Case 122
  Mid(leftcalc$, y1, 1) = Chr$(x1)
  Print #1, leftcalc$
  \'List1.AddItem leftcalc$
  x1 = 48
  Case 57
  Mid(leftcalc$, y1, 1) = Chr$(x1)
  Print #1, leftcalc$
  \'List1.AddItem leftcalc$
  ruligen = 1
End Select
Loop
If leftcalc$ = sammenlign$ Then GoTo forfra
tjekvenstre:
y1 = y1 - 1: If y1 = 0 Then GoTo forfra
If Mid$(leftcalc$, y1, 1) = \"9\" Then GoTo tjekvenstre
If y1 > 0 Then
a$ = Mid$(leftcalc$, y1, 1)
x1 = Asc(a$)
  Select Case x1
  Case 57
    If y1 = 1 Then x1 = 97
    Mid(leftcalc$, y1, 1) = Chr$(x1)
    GoTo slutselect
  Case 48 To 56
    x1 = x1 + 1
    Mid(leftcalc$, y1, 1) = Chr$(x1)
    GoTo slutselect
  Case 97 To 121
    x1 = x1 + 1
    Mid(leftcalc$, y1, 1) = Chr$(x1)
    GoTo slutselect
  Case 122
    x1 = 48
    Mid(leftcalc$, y1, 1) = Chr$(x1)
slutselect:
  End Select

leftcalc$ = Left$(leftcalc$, y1) & \"a\"
checkigen:
If Len(leftcalc$) < Len(leftbase$) Then leftcalc$ = leftcalc$ & \"a\": GoTo checkigen
End If

GoTo gennemloop

 
GoTo forfra
\'************************************************************
slutprog:
Text1.SetFocus
Close
msg$ = \"Færdig, se filen i c:\\bogstavleg.txt\"
MsgBox msg$
End Sub

Private Sub Form_Load()
Text1.Text = \"4\"
End Sub

Jeg har lavet koden en del mere simpel at se, men jeg skal gerne lave den endnu nemmere hvis du ikke lige kan gennemskue den.
Dette vil dog blot betyde at der kom en hel del flere linier på :-(

Anyway den virker!

- Mikker