Deutsch
Forum

Zahlen in Buchstabenreihe konvertieren

 
- Seite 1 -



Julian
Schmidt
Hallo,
ich versuche gerade Zahlen in eine Buchstabenreihe zu konvertieren. Diese sollen ein ähnliches Format haben wie in Excel.
A,B,C,D,E...
AA,AB,AC,AD,AE...
BA,BB,BC,BE...
ZA,ZB,ZC...
AAA,AAB...
ABA,ABB...
ZZY, ZZZ...
AAAA, AAAB...

Das es bis auf zwei Buchstabenreihen funktioniert habe ich bereits hingekommen.
Mir fehlt aber irgendwie ein Ansatz wie man das weiter hoch rechnen kann.
Ich bräuchte auch eine Gegen-Funktion.
cls
var lbox&=Create("ListBox", %hwnd, 0, 0, 0, width(%hwnd), height(%hwnd))

whileloop 26*30

    AddString(lbox&,LetterOfNumber(&loop,1))

Endwhile

while 1

    waitinput
    case iskey(27) : end
    Settext %hwnd,Str$(GetCurSel(lbox&))+" - "+GetString$(lbox&,GetCurSel(lbox&))

Endwhile

Proc LetterOfNumber

    Parameters number%,grossschreibung%
    case grossschreibung%=1 : var alphabet$="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"
    case grossschreibung%<>1 : var alphabet$="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"
    declare text$,ausnahme%

    while number%<>0

        if number%<27

            text$=text$+SubStr$(alphabet$,number%,",")
            number%=0

        else

            whileloop Round(number%/26,0)

                if number%=(26*&loop)

                    text$=SubStr$(alphabet$,IF(Val(SubStr$(Str$(number%/26),1,"."))-1>0,Val(SubStr$(Str$(number%/26),1,"."))-1,1),",")+SubStr$(alphabet$,26,",")
                    ausnahme%=1

                Endif

            Endwhile

            case ausnahme%<>1 : text$=SubStr$(alphabet$,Val(SubStr$(Str$(number%/26),1,".")),",")+text$
            number%=number%-(26*Val(SubStr$(Str$(number%/26),1,".")))

        Endif

    Endwhile

    Return text$

EndProc


LG

Julian57
 
˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
08.10.2011  
 



« Dieser Beitrag wurde als Lösung gekennzeichnet. »

- Seite 4 -



Jörg
Sellmeyer
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.
'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:
 $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:
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

 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
23.10.2011  
 



 
- Seite 3 -



Nico
Madysa
Glaube ich gern. Ich frage mich auch ehrlich gesagt, was du dir bei der If-Abfrage gedacht hast.

Noch mal: Du hast zwei getrennte Dinge zu tun: Zuerst korrigierst du deine Zahl nach oben, dann benutzt du diese Zahl in Jörgs Algorithmus zum Basenwechsel.
Also so was wie:

"FÜR N=0 BIS (Stellenzahl(zahl,27)-2) TUE X" heißt:
Du lässt N von 0 bis zu einer Zahl laufen und für jeden Wert führst du X aus.
Genau das macht eine Whileloop-Schleife:
whileloop 0,Obere_Grenze%'für alle Zahlen von ... bis ...

    Etwas'mache etwas

EndWhile


In unserem Falle also:

Jetzt musst du praktisch nur noch den Code in der richtigen Reihenfolge zusammenpappen. Ich hoffe, das schaffst du ohne Hilfe.
 
18.10.2011  
 




Julian
Schmidt
Verflixt zu erst hab ich auch eine Schleife gedacht nur dann hat die Idee einer IF-Bedingung doch überwiegt.
 
XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
18.10.2011  
 




Julian
Schmidt
Es will immer noch nicht so ganz.
Ich vermute das "-" nicht gleich 0, sondern gleich 1 ist.
Weiterhin dann A=2, B=3, C=4
Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc Stellenzahl

    Parameters zahl%,basis%
    Return int(lg(zahl%) / lg(basis%))+1

Endproc

proc NumberToLetter

    Parameters Zahl&
    declare letters$

    whileloop 0,(Stellenzahl(Zahl&,27)-2)

        Zahl& = Zahl& + (27 ^ &loop)

    EndWhile

    letters$=Wechsle_Basis(Zahl&,27)
    Return letters$

endproc

Proc Wechsle_Basis

    Parameters Zahl&,Basis%
    Declare Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ Basis%
        Rest& = Zahl& Mod Basis%

        If Basis% = 27

            Wert$ = SubStr$($Alphabet,Rest&+1) + Wert$

        Else

            Wert$ = SubStr$($Werte,Rest&+1) + Wert$

        EndIf

        Zahl& = Ergebnis&
        Case Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Case Left$(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "0"
    Case Left$(Wert$,1)="A":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "A"
    Wert$=Del$(Wert$,1,1)
    Return Wert$

EndProc

WhileLoop 1000

    AddString Str$(&loop) + " = " + NumberToLetter(&loop)

Endwhile

ListBox$("Ergebnis",2)
 
XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
18.10.2011  
 




Nico
Madysa
Hm, wenn "-"=0 wäre, dann müsste er ja ganz oben auch bei "-" anfangen und nicht bei "A".

Ich vermute eher, dass in meinen Ausführungen zur Korrektur ein kleiner Denkfehler drin war ... Ich melde mich, wenn ich ihn gefunden habe.
 
19.10.2011  
 




Jörg
Sellmeyer
Ich verstehe, ehrlich gesagt, das Problem nicht. Meinen Code oben brauchst Du doch nur um das "-" ergänzen und die 26 durch 27 ergänzen. Dann die überflüssigen führenden "-" wegmachen:
Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc Umwandeln

    Parameters Zahl&,Basis%
    Declare Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ Basis%
        Rest& = Zahl& Mod Basis%

        If Basis% = 27

            Wert$ = SubStr$($Alphabet,Rest&+1) + Wert$

        Else

            Wert$ = SubStr$($Werte,Rest&+1) + Wert$

        EndIf

        Zahl& = Ergebnis&
        Case Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Case Left$(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "0"
    Case Left$(Wert$,1)="-":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "A"
    Return Wert$

EndProc

Cls
ShowMax
Declare l&,d$,z%,s$

WhileLoop 0,26

    s$ = s$ + Chr$(64 + &Loop) + " = " + Str$(&Loop) + ";1;70;"

Wend

s$ = "-" + Del$(s$,1,1)
l& = Create("GridBox",%hwnd,s$,0,2,2,Width(%hwnd)-4,Height(%hwnd)-4)
AddString(l&,MkStr$("|",27))

WhileLoop 0,2900'0

    s$ = Umwandeln(&Loop,27)
    SetText l&,z%,(&Loop Mod 27),s$
    'hier auch mit zugehöriger Zahl:
    'SetText l&,z%,(&Loop Mod 27),Str$(&Loop ) + " = " + s$

    IfNot (&Loop + 1) Mod 27

        Inc z%
        AddString(l&,"|")

    EndIf

Wend

While 1

    WaitInput

Wend

Randomize
Declare Input&

Aber vielleicht verstehe ich auch immer noch nicht, was Du eigentlich erreichen willst...
 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
19.10.2011  
 



 
- Seite 4 -



Nico
Madysa
Ehm ... Denk dir in deiner Gridbox praktisch die linke Spalte weg und die Zeile, in der ein Bindestrich in der Mitte steht -- dann steht da genau das, was Julian haben will.

Bei Word, Excel, Open Ofice, etc. kann man Nummerierungen statt mit Zahlen ja mit Buchstaben durchführen.
1, 2, 3, 4, 5, ... --> A, B, C, D, E, ...
Und diese Buchstabierung setzt sich ab 24 halt so fort:
X, Y, Z, AA, AB, AC, AD, ... ZY, ZZ, AAA, AAB, ...

Und Julian will praktisch eine Funktion, die jeder Zahl die entsprechende Buchstabenfolge zuordnet und eine, die das Gegenteil macht.

Mir den Kode anzusehen, habe ich leider noch nicht geschafft. Gerade etwas mehr zu tun, als ich vor ein paar Stunden noch erwartet hätte.
 
19.10.2011  
 




Julian
Schmidt
Nico Madysa (19.10.11)
Hm, wenn "-"=0 wäre, dann müsste er ja ganz oben auch bei "-" anfangen und nicht bei "A".


Ist dem den nicht so?
Es will immer noch nicht so ganz.
Ich vermute das "-" nicht gleich 0, sondern gleich 1 ist.
Weiterhin dann A=2, B=3, C=4
[CODE]Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc Stellenzahl

    Parameters zahl%,basis%
    Return int(lg(zahl%) / lg(basis%))+1

Endproc

proc NumberToLetter

    Parameters Zahl&
    declare letters$

    whileloop 0,(Stellenzahl(Zahl&,27)-2)

        Zahl& = Zahl& + (27 ^ &loop)

    EndWhile

    letters$=Wechsle_Basis(Zahl&,27)
    Return letters$

endproc

Proc Wechsle_Basis

    Parameters Zahl&,Basis%
    Declare Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ Basis%
        Rest& = Zahl& Mod Basis%

        If Basis% = 27

            Wert$ = SubStr$($Alphabet,Rest&+1) + Wert$

        Else

            Wert$ = SubStr$($Werte,Rest&+1) + Wert$

        EndIf

        Zahl& = Ergebnis&
        Case Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Case Left$(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "0"
    Case Left$(Wert$,1)="A":Wert$=Del$(Wert$,1,1)
    Case Wert$ = "":Wert$ = "A"
    Return Wert$

EndProc

WhileLoop 1000

    AddString Str$(&loop) + " = " + NumberToLetter(&loop)

Endwhile

ListBox$("Ergebnis",2)

Ich sehe da zumindest "-" Zeichen am Anfang.
Hab beim letzten Posting evtl. einfach vergessen ein Codezeile zu lösche. Hatte das erste Zeichen abgeschnitten der Übersichtlichkeit halber
 
XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
19.10.2011  
 




Jörg
Sellmeyer
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.
'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:
 $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:
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

 
Windows XP SP2 XProfan X4
... und hier mal was ganz anderes als Profan ...
23.10.2011  
 




Julian
Schmidt
Cool es funktioniert, und sogar super schnell
Danke Jörg
 
XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
23.10.2011  
 



Pheeeerfekt!
 
23.10.2011  
 




Julian
Schmidt

Das Thema ist ja immernoch aktiv. Muss ich mal schließen
 
XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor

˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...] 
31.10.2011  
 



Also sowas!
 
01.11.2011  
 




Antworten


Thementitel, max. 100 Zeichen.
 

Systemprofile:

Kein Systemprofil angelegt. [anlegen]

XProfan:

 Beitrag  Schrift  Smilies  ▼ 

Bitte anmelden um einen Beitrag zu verfassen.
 

Themenoptionen

27.283 Betrachtungen

Unbenanntvor 0 min.
H.Brill09.05.2014
mein19.05.2013
Georg Teles21.03.2013
RudiB.08.11.2012
Mehr...

Themeninformationen



Admins  |  AGB  |  Anwendungen  |  Autoren  |  Chat  |  Datenschutz  |  Download  |  Eingangshalle  |  Hilfe  |  Händlerportal  |  Impressum  |  Mart  |  Schnittstellen  |  SDK  |  Services  |  Spiele  |  Suche  |  Support

Ein Projekt aller XProfaner, die es gibt!


Mein XProfan
Private Nachrichten
Eigenes Ablageforum
Themen-Merkliste
Eigene Beiträge
Eigene Themen
Zwischenablage
Abmelden
 Deutsch English Français Español Italia
Übersetzungen

Datenschutz


Wir verwenden Cookies nur als Session-Cookies wegen der technischen Notwendigkeit und bei uns gibt es keine Cookies von Drittanbietern.

Wenn du hier auf unsere Webseite klickst oder navigierst, stimmst du unserer Erfassung von Informationen in unseren Cookies auf XProfan.Net zu.

Weitere Informationen zu unseren Cookies und dazu, wie du die Kontrolle darüber behältst, findest du in unserer nachfolgenden Datenschutzerklärung.


einverstandenDatenschutzerklärung
Ich möchte keinen Cookie