XProfan

Deutsch

Siehe auch: zaehlen beliebig buchstaben zaehler [...]

Es hat mir keine Ruhe gelassen und ich hab noch weitergetüftelt. Jetzt hab ich's raus und es ist letztlich unkomplizierter als anfangs erwartet.
Kompilieren Markieren Separieren

'und umgekehrt
'Jörg Selllmeyer 2011
'zur freien Verwendung
'hier bekommt man sehr gut erklärt, wie das Umrechnen von Zahlen in eine andere Basis funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm
'Die Schwierigkeit hierbei, ist die fehlende Null. Alle Nullstellen müssen abgefangen werden, die
'aktuelle Stelle um eins verringert und die folgende Stelle ebenfalls um eins verringert werden.
'Der Wert A000 wird dann also ohne Nullen zu YYZ. C000 wird zu BYYZ

Proc Nr2ABC

    Parameters Zahl!
    Declare Wert$,Rest%

    While Zahl! > 0

        Rest% = Zahl! Mod 26
        Zahl! = Zahl! \ 26

        If Rest% = 0

            'hier werden die Nullstellen abgefangen und umgewandelt
            Zahl! = Zahl! -1
            Rest% = 26

        EndIf

        Case Rest% > 0:Wert$ = Chr$(Rest% + 64) + Wert$

    Wend

    Return Wert$

EndProc

Proc ABC2Nr

    Parameters Text$
    Declare Zahl!,Summe!,B$
    Text$ = Upper$(Text$)

    WhileLoop Len(Text$),1,-1

        B$ = SubStr$(Text$,-&Loop)
        Zahl! = (Ord(B$)-64) * 26^(&Loop-1)
        Summe! = Summe! + Zahl!

    Wend

    Return Int(Summe!)

EndProc

Cls
WindowTitle "Zahlen in Buchstaben umwandeln und umgekehrt"
Print "LQSVOFKGQM =", ABC2Nr("LQSVOFKGQM")
Print "AAAAAA =", ABC2Nr("AAAAAA")
Print "ABCDEFGH =", ABC2Nr("ABCDEFGH")
Print
Print "XPROFAN macht Spass =", ABC2Nr("XPROFAN"),ABC2Nr("macht"),ABC2Nr("Spass")
Print
Declare s$
Randomize

WhileLoop 10

    s$ = Chr$(Rnd(26) + 65) + s$

Wend

Print s$ + " =",ABC2Nr(s$)
WaitInput
Cls
Randomize

WhileLoop 0,780,1

    Print Nr2ABC(&Loop),

Wend

WaitInput
Cls

WhileLoop 00,480,1

    Print Nr2ABC(&Loop + Rnd(345676)),

Wend

WaitInput

Hier ist noch ein kleines Programm, bei dem man ein bischen herumexperimentieren kann:
Kompilieren Markieren Separieren

 $H windows.ph
Def DelLast(2) Mid$(@$(1),1,(Len(@$(1)) - @&(2)))
'hier kann man schön nachlesen, wie so eine Umrechnung funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm

Proc Nr2ABC

    Parameters Zahl!
    Declare Wert$,Rest%

    While Zahl! > 0

        Rest% = Zahl! Mod 26
        Zahl! = Zahl! \ 26

        If Rest% = 0

            Zahl! = Zahl! -1
            Rest% = 26

        EndIf

        Case Rest% > 0:Wert$ = Chr$(Rest% + 64) + Wert$

    Wend

    Return Wert$

EndProc

Proc ABC2Nr

    Parameters Text$
    Declare Zahl!,Summe!,B$

    WhileLoop Len(Text$),1,-1

        B$ = SubStr$(Text$,&Loop)
        Zahl! = Chr$(B$) * 26^(&Loop-1)
        Summe! = Summe! + Zahl!

    Wend

    Return Summe!

EndProc

SubProc Create.TextR

    Return @Control("STATIC",@$(2),$50000002,@%(3),@%(4), \
    @%(5),@%(6),@%(1),101, %hInstance)

EndProc

Proc Text_setzen

    Parameters cb&,txt&,txt1&
    Declare Text$,Ergebnis!
    Text$ = GetText$(txt&)
    SetText txt1&,Str$((GetCurSel(cb&)) * Val(Text$))
    Clear Text$

    WhileLoop 0,Stellen%-1

        Ergebnis! = Val(GetText$(txt1&[&Loop])) + Ergebnis!
        Text$ = Text$ + GetText$(cb&[&Loop])

    Wend

    SetText txt_Ergebnis&,Str$(Ergebnis!)
    SetText txt_Alphabet&,Text$
    SetText txt_Nr2ABC&,Nr2ABC(Ergebnis!)

EndProc

Proc Button_Aktion

    Parameters btn&

    If GetText$(btn&) = "Null setzen"

        SendMessage(cb&[focus%],$014E,0,0)
        Text_setzen(cb&[focus%],txt&[focus%],txt1&[focus%])
        SetText btn&,"Zufall"

    Else

        SendMessage(cb&[focus%],$014E,Rnd(26),0)
        Text_setzen(cb&[focus%],txt&[focus%],txt1&[focus%])
        SetText btn&,"Null setzen"

    EndIf

EndProc

Proc Alle_Null

    Parameters btn&

    If GetText$(btn&) = "alle Null setzen"

        WhileLoop 0,Stellen%-1

            SendMessage(cb&[&Loop],$014E,0,0)
            Text_setzen(cb&[&Loop],txt&[&Loop],txt1&[&Loop])
            SetText btn&[&Loop],"Zufall"

        Wend

        SetText btn&,"alle Zufall"

    Else

        WhileLoop 0,Stellen%-1

            SendMessage(cb&[&Loop],$014E,Rnd(26),0)
            Text_setzen(cb&[&Loop],txt&[&Loop],txt1&[&Loop])
            SetText btn&[&Loop],"Null setzen"

        Wend

        SetText btn&,"alle Null setzen"

    EndIf

EndProc

Declare Stellen%
Stellen% = 10
Declare cb&[Stellen%],txt&[Stellen%],txt1&[Stellen%],A$,x%,b%,focushdl&,focus%,Ergebnis&
Declare btn&[Stellen% + 1]
b% = 118
x% = 120
WindowStyle 8 | 24 | 512
Window Stellen% * (b% + 24),300
SetDialogFont ~GetStockObject($11)

WhileLoop 26

    a$ = a$ + Chr$(64 + &loop) + "|"

Wend

a$ = " |" + DelLast(a$,1)
MoveStrToList(a$,"|")

WhileLoop 0,Stellen%-1

    cb&[&Loop] = Create("ChoiceBox",%hwnd,0,5 + &Loop * x%,40,b%,160)
    Create("Tooltip",%hwnd,cb&[&Loop],"26^" + Str$(Stellen%-1 - &Loop))
    MoveListToHandle(cb&[&Loop])
    SendMessage(cb&[&Loop],$014E,0,0)
    txt&[&Loop] = Create("TextR",%hwnd,"",5 + &Loop * x%,10,b%,20)
    txt1&[&Loop] = Create("TextR",%hwnd,"",5 + &Loop * x%,80,b%,20)
    btn&[&Loop] = Create("Button",%hwnd,"Zufall",5 + &Loop * x%,110,b%,20)
    Case &Loop = Stellen% - 1:btn&[&Loop + 1] = Create("Button",%hwnd,"Zufall",5 + (&Loop + 1) * x%,110,b%,20)

Wend

Var txt_Alphabet& = Create("TextR",%hwnd,"",5 + Stellen% * x%,40,b% + Stellen%,20)
Var txt_Ergebnis& = Create("TextR",%hwnd,"",5 + Stellen% * x%,80,b%,20)
Var txt_Nr2ABC& = Create("TextR",%hwnd,"",5 + Stellen% * x%,140,b%,20)
Set("Decimals",0)

WhileLoop 0,Stellen%-1

    SetText txt&[Stellen%-1 - &Loop],Str$(26^&Loop)

Wend

Randomize

While 1

    WaitInput
    focushdl& = %getfocus

    WhileLoop 0,Stellen%-1

        Case focushdl& = cb&[&Loop]:focus% = &Loop

        If focushdl& = btn&[&Loop]

            focus% = &Loop

        EndIf

    Wend

    If %key = 2

        Break

    ElseIf GetFocus(cb&[focus%])

        Case GetCurSel(cb&[focus%]) > -1:Text_setzen(cb&[focus%],txt&[focus%],txt1&[focus%])

    ElseIf Clicked(btn&[focus%])

        Button_Aktion(btn&[focus%])

    ElseIf Clicked(btn&[Stellen%])

        Alle_Null(btn&[Stellen%])

    ElseIf %mousepressed = 2

        CreateMenu
        AppendMenu 100,"Summe kopieren"
        AppendMenu 101,"Buchstaben kopieren"
        TrackMenu %mousex,%mousey

        If MenuItem(100)

            ClearClip
            PutClip GetText$(txt_Ergebnis&)

        ElseIf MenuItem(101)

            ClearClip
            PutClip GetText$(txt_Alphabet&)

        EndIf

    EndIf

Wend

Hier ist noch eine Auflistung:
Kompilieren Markieren Separieren

Proc Nr2ABC

    Parameters Zahl!
    Declare Wert$,Rest%

    While Zahl! > 0

        Rest% = Zahl! Mod 26
        Zahl! = Zahl! \ 26

        If Rest% = 0

            Zahl! = Zahl! -1
            Rest% = 26

        EndIf

        Case Rest% > 0:Wert$ = Chr$(Rest% + 64) + Wert$

    Wend

    Return Wert$

EndProc

Cls
ShowMax
Declare Stellen%[6],Wert$[6],n%,a$,b$,OrdNr&,Header$,s$
Clear Stellen%[]
OrdNr& = 1
Var b% = %maxx \ 27 -1

WhileLoop 26

    s$ = s$ + Chr$(64 + &loop) + ";1;" + Str$(b%) + ";"

Wend

s$ = ";0;" + Str$(b%) + ";" + s$
Var l& = Create("GridBox",%hwnd,s$,0,2,2,Width(%hwnd)-4,Height(%hwnd)-4)

WhileLoop 26^2

    WhileLoop 26

        B$ = B$ + Nr2ABC(OrdNr&) + "|"
        Inc OrdNr&

    Wend

    AddString(l&,Str$(OrdNr&-26) + "|" + b$)
    Clear b$
    WindowTitle Str$(OrdNr&) + " Geduld - es geht bis 26^3 (" + Str$(Int(26^3)) + ")"

Wend

WindowTitle Str$(OrdNr&) + " Geduld - es geht bis 26^3 (" + Str$(Int(26^3)) + ") fertig!"

While 1

    WaitInput

Wend