XProfan

Français

Julian
Schmidt

Salut,
je versuche justement payons dans un Buchstabenreihe trop konvertieren. cet devoir un ähnliches Format avons comment dans 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...

cela es jusqu'à sur deux Buchstabenreihen funktioniert habe je bereits hingekommen.
Mir fehlt mais irgendwie un Ansatz comment on cela plus hoch le calcul peux.
je bräuchte aussi une vers-Funktion.

Kompilieren Marque Séparation

cls
var lbox&=Créer(ListBox, %hwnd, 0, 0, 0, width(%hwnd), height(%hwnd))

whileloop 26*30

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

Endwhile

tandis que 1

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

Endwhile

Proc LetterOfNumber

    Paramètres number%,grossschreibung%
    cas 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"
    cas 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%

    tandis que number%<>0

        si number%<27

            text$=text$+$ Substr(alphabet$,number%,»)
            number%=0

        d'autre

            whileloop Round(number%/26,0)

                si 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

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

        Endif

    Endwhile

    Retour text$

ENDPROC

LG

Julian57

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

08.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

« cette Beitrag wurde comme Solution gekennzeichnet. »

- page 4 -

Jörg
Sellmeyer

Es hat mir aucun Ruhe gelassen et je hab encore weitergetüftelt. maintenant hab ich's raus et c'est letztlich unkomplizierter comme anfangs erwartet.

Kompilieren Marque Séparation

'et renversé
'Jörg Selllmeyer 2011
'zur freien Verwendung
'ici bekommt on très bien erklärt, comment cela Umrechnen de payons dans un autre la base funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm
'qui difficulté hierbei, ist qui fehlende zéro. Alle Nullstellen doit abgefangen volonté, qui
'aktuelle Stelle um une verringert et qui folgende Stelle également um une verringert volonté.
'qui Wert A000 wird ensuite alors sans Nullen trop YYZ. C000 wird trop BYYZ

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            'ici volonté qui Nullstellen abgefangen et umgewandelt
            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Proc ABC2Nr

    Paramètres Text$
    Déclarer numéro!,somme!,B$
    Text$ = Upper$(Text$)

    WhileLoop Len(Text$),1,-1

        B$ = $ Substr(Text$,-&Boucle)
        numéro! = (Ord(B$)-64) * 26^(&Boucle-1)
        somme! = somme! + numéro!

    Wend

    Retour Int(somme!)

ENDPROC

Cls
Titre de la fenêtre "Zahlen dans Buchstaben transformer et umgekehrt"
Imprimer "LQSVOFKGQM =", ABC2Nr("LQSVOFKGQM")
Imprimer "AAAAAA =", ABC2Nr("AAAAAA")
Imprimer "ABCDEFGH =", ABC2Nr("ABCDEFGH")
Imprimer
Imprimer "XPROFAN pouvoir Spass =", ABC2Nr("XPROFAN"),ABC2Nr("macht"),ABC2Nr("Spass")
Imprimer
Déclarer s$
Randomiser

WhileLoop 10

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

Wend

Imprimer s$ + " =",ABC2Nr($ S)
WaitInput
Cls
Randomiser

WhileLoop 0,780,1

    Imprimer Nr2ABC(&Boucle),

Wend

WaitInput
Cls

WhileLoop 00,480,1

    Imprimer Nr2ABC(&Boucle + Tour(345676)),

Wend

WaitInput

ici ist encore un kleines Programme, chez dem on un un peu herumexperimentieren peux:

Kompilieren Marque Séparation

 $H windows.ph
Def DelLast(2) Mid $(@$(1),1,(Len(@$(1)) - @&(2)))
'ici peux on joli nachlesen, comment so une change funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Proc ABC2Nr

    Paramètres Text$
    Déclarer numéro!,somme!,B$

    WhileLoop Len(Text$),1,-1

        B$ = $ Substr(Text$,&Boucle)
        numéro! = Chr$(B$) * 26^(&Boucle-1)
        somme! = somme! + numéro!

    Wend

    Retour somme!

ENDPROC

SubProc Créer.TextR

    Retour @Contrôle("STATIC",@$(2),$50000002,@%(3),@%(4), \
    @%(5),@%(6),@%(1),101, %hInstance)

ENDPROC

Proc Text_setzen

    Paramètres cb&,txt&,txt1&
    Déclarer Text$,Ergebnis!
    Text$ = GetText $(txt&)
    SetText txt1&,Str$((GetCurSel(cb&)) * Val(Text$))
    Claire Text$

    WhileLoop 0,se mettre%-1

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

    Wend

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

ENDPROC

Proc Button_Aktion

    Paramètres btn&

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

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

    D'autre

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

    EndIf

ENDPROC

Proc Alle_Null

    Paramètres btn&

    Si GetText $(btn&) = "alle zéro setzen"

        WhileLoop 0,se mettre%-1

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

        Wend

        SetText btn&,"alle Zufall"

    D'autre

        WhileLoop 0,se mettre%-1

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

        Wend

        SetText btn&,"alle zéro setzen"

    EndIf

ENDPROC

Déclarer se mettre%
Stellen% = 10
Déclarer cb&[se mettre%],txt&[se mettre%],txt1&[se mettre%],A$,x%,b%,focushdl&,focus%,Ergebnis&
Déclarer btn&[se mettre% + 1]
b% = 118
x% = 120
Fenêtre Style 8 | 24 | 512
Fenêtre se mettre% * (b% + 24),300
SetDialogFont ~GetStockObject($11)

WhileLoop 26

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

Wend

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

WhileLoop 0,se mettre%-1

    cb&[&Boucle] = Créer("ChoiceBox",%hwnd,0,5 + &Boucle * x%,40,b%,160)
    Créer("Tooltip",%hwnd,cb&[&Boucle],"26^" + Str$(se mettre%-1 - &Boucle))
    MoveListToHandle(cb&[&Boucle])
    SendMessage(cb&[&Boucle],$014E,0,0)
    txt&[&Boucle] = Créer("TextR",%hwnd,»,5 + &Boucle * x%,10,b%,20)
    txt1&[&Boucle] = Créer("TextR",%hwnd,»,5 + &Boucle * x%,80,b%,20)
    btn&[&Boucle] = Créer("Button",%hwnd,"Zufall",5 + &Boucle * x%,110,b%,20)
    Cas &Boucle = se mettre% - 1:btn&[&Boucle + 1] = Créer("Button",%hwnd,"Zufall",5 + (&Boucle + 1) * x%,110,b%,20)

Wend

Var txt_Alphabet& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,40,b% + se mettre%,20)
Var txt_Ergebnis& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,80,b%,20)
Var txt_Nr2ABC& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,140,b%,20)
Set("Décimal",0)

WhileLoop 0,se mettre%-1

    SetText txt&[se mettre%-1 - &Boucle],Str$(26^&Boucle)

Wend

Randomiser

Tandis que 1

    WaitInput
    focushdl& = %getfocus

    WhileLoop 0,se mettre%-1

        Cas focushdl& = cb&[&Boucle]:focus% = &Boucle

        Si focushdl& = btn&[&Boucle]

            focus% = &Boucle

        EndIf

    Wend

    Si %clé = 2

        Pause

    ElseIf GetFocus(cb&[focus%])

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

    ElseIf Clicked(btn&[focus%])

        Button_Aktion(btn&[focus%])

    ElseIf Clicked(btn&[se mettre%])

        Alle_Null(btn&[se mettre%])

    ElseIf %mousepressed = 2

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

        Si MenuItem(100)

            ClearClip
            PutClip GetText $(txt_Ergebnis&)

        ElseIf MenuItem(101)

            ClearClip
            PutClip GetText $(txt_Alphabet&)

        EndIf

    EndIf

Wend

ici ist encore une Auflistung:

Kompilieren Marque Séparation

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Cls
ShowMax
Déclarer se mettre%[6],Wert$[6],n%,a$,b$,OrdNr&,En-tête$,s$
Claire se mettre%[]
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& = Créer("GridBox",%hwnd,s$,0,2,2,Width(%hwnd)-4,Height(%hwnd)-4)

WhileLoop 26^2

    WhileLoop 26

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

    Wend

    AddStrings(l&,Str$(OrdNr&-26) + "|" + b$)
    Claire b$
    Titre de la fenêtre Str$(OrdNr&) + " patience - und dir jusqu'à 26^3 (" + Str$(Int(26^3)) + ")"

Wend

Titre de la fenêtre Str$(OrdNr&) + " patience - und dir jusqu'à 26^3 (" + Str$(Int(26^3)) + ") fertig!"

Tandis que 1

    WaitInput

Wend

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

23.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 3 -

Nico
Madysa

Glaube je gern. je frage mich aussi à vrai dire, quoi du dir chez qui Si-Abfrage gedacht la hâte.

encore la fois: tu as deux getrennte Dinge trop 1faire: d'abord korrigierst du deine numéro pour dessus, ensuite benutzt du cet numéro dans Jörgs Algorithmus zum Basenwechsel.
alors so quoi comment:

Kompilieren Marque Séparation

proc NumberToLetter

    parameters numéro%
    Korrigiere
    Wechsle_Basis

endproc

"FÜR N=0 BIS (Stellenzahl(numéro,27)-2) TUE X" est:
Du peut N de 0 jusque einer numéro courir et pour jeden Wert führst du X aus.
oui c'est ca cela fait une Whileloop-Boucle:

Kompilieren Marque Séparation

whileloop 0,Obere_Grenze%'pour alle payons de ... jusqu'à ...

    quelque chose'fais quelque chose

Endwhile

dans unserem piège alors:

Kompilieren Marque Séparation

whileloop 0,(Stellenzahl(numéro,27)-2)

    numéro = numéro + (27 ^ &loop)

Endwhile

maintenant musst du pratique seulement encore den Code dans qui richtigen Reihenfolge zusammenpappen. je hoffe, cela schaffst du sans Aider.

XProfan X2
Win7 Home Premium, SP1, AMD Phenom(tm) II N830 Triple-Core Processor
Nico Madysa

18.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Julian
Schmidt

Verflixt trop seulement hab je aussi une Boucle gedacht seulement ensuite hat qui concept einer IF-Condition doch überwiegt.

XProfan X2
Win7 Home Premium, SP1, AMD Athlon(tm) II Neo K125 Processor
˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗˗
Webseite [...]

18.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Julian
Schmidt

Es veux toujours pas so entier.
je vermute cela "-" pas juste 0, mais juste 1 ist.
Weiterhin ensuite A=2, B=3, C=4

Kompilieren Marque Séparation

Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc Stellenzahl

    Paramètres numéro%,la base%
    Retour int(lg(numéro%) / lg(la base%))+1

ENDPROC

proc NumberToLetter

    Paramètres Zahl&
    declare letters$

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

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

    Endwhile

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

endproc

Proc Wechsle_Basis

    Paramètres Zahl&,la base%
    Déclarer Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ la base%
        Rest& = Zahl& Mod la base%

        Si la base% = 27

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

        D'autre

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

        EndIf

        Zahl& = Ergebnis&
        Cas Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Cas Left $(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "0"
    Cas Left $(Wert$,1)="A":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "A"
    Wert$=Del$(Wert$,1,1)
    Retour Wert$

ENDPROC

WhileLoop 1000

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

Endwhile

ListBox$("Ergebnis",2)

18.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Nico
Madysa

Hm, si "-"=0 wäre, ensuite devrait il oui entier dessus aussi chez "-" anfangen et pas chez "A".

je vermute plutôt, dass dans meinen Ausführungen zur Correction un kleiner Denkfehler drin était ... je melde mich, si je ihn trouvé habe.

XProfan X2
Win7 Home Premium, SP1, AMD Phenom(tm) II N830 Triple-Core Processor
Nico Madysa

19.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Jörg
Sellmeyer

je comprends, à vrai dire, cela Problem pas. Meinen Code dessus brauchst Du doch seulement um cela "-" ergänzen et qui 26 par 27 ergänzen. ensuite qui überflüssigen führenden "-" wegmachen:

Kompilieren Marque Séparation

Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc transformer

    Paramètres Zahl&,la base%
    Déclarer Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ la base%
        Rest& = Zahl& Mod la base%

        Si la base% = 27

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

        D'autre

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

        EndIf

        Zahl& = Ergebnis&
        Cas Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Cas Left $(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "0"
    Cas Left $(Wert$,1)="-":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "A"
    Retour Wert$

ENDPROC

Cls
ShowMax
Déclarer l&,d$,z%,s$

WhileLoop 0,26

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

Wend

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

WhileLoop 0,2900'0

    s$ = transformer(&Boucle,27)
    SetText l&,z%,(&Boucle Mod 27),s$
    'ici aussi avec zugehöriger numéro:
    'SetText l&,z%,(& Loop Mod 27),Str$(& Loop ) + " = " + s$

    Si non (&Boucle + 1) Mod 27

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

    EndIf

Wend

Tandis que 1

    WaitInput

Wend

Randomiser
Déclarer Input&

mais peut-être verstehe je De toute façon encore pas, quoi Du eigentlich erreichen veux...

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

19.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

- page 4 -

Nico
Madysa

Ehm ... Denk dir dans deiner Gridbox pratique qui linke Spalte weg et qui la ligne, dans qui un Bindestrich dans qui Mitte steht -- ensuite steht là oui c'est ca cela, quoi Julian avons veux.

chez Word, Excel, Open Ofice, etc. peux on Nummerierungen statt avec payons oui avec Buchstaben durchführen.
1, 2, 3, 4, 5, ... --> A, B, C, D, E, ...
et cet Buchstabierung mets sich ab 24 arrêt so fort:
X, Y, Z, AA, AB, AC, AD, ... ZY, ZZ, AAA, AAB, ...

et Julian veux pratique une Funktion, qui chacun numéro qui entsprechende Buchstabenfolge zuordnet et une, qui cela Gegenteil pouvoir.

Mir den Kode anzusehen, habe je malheureusement encore pas geschafft. justement quelque chose plus trop 1faire, comme je avant un paire Stunden encore erwartet hätte.

XProfan X2
Win7 Home Premium, SP1, AMD Phenom(tm) II N830 Triple-Core Processor
Nico Madysa

19.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Julian
Schmidt

Nico Madysa (19.10.11)

Hm, si "-"=0 wäre, ensuite devrait il oui entier dessus aussi chez "-" anfangen et pas chez "A".

Ist dem den pas so?

Kompilieren Marque Séparation

Es veux toujours encore pas so entier.
je vermute cela "-" pas juste 0, mais juste 1 est.
Weiterhin ensuite A=2, B=3, C=4
[CODE]Def $Werte "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
Def $Alphabet "-ABCDEFGHIJKLMNOPQRSTUVWXYZ"

Proc Stellenzahl

    Paramètres numéro%,la base%
    Retour int(lg(numéro%) / lg(la base%))+1

ENDPROC

proc NumberToLetter

    Paramètres Zahl&
    declare letters$

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

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

    Endwhile

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

endproc

Proc Wechsle_Basis

    Paramètres Zahl&,la base%
    Déclarer Ergebnis&,Rest&,Wert$

    Repeat

        Ergebnis& = Zahl& \ la base%
        Rest& = Zahl& Mod la base%

        Si la base% = 27

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

        D'autre

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

        EndIf

        Zahl& = Ergebnis&
        Cas Rest& = 0:Rest& = Ergebnis&

    Until Rest& = 0

    Cas Left $(Wert$,1)="0":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "0"
    Cas Left $(Wert$,1)="A":Wert$=Del$(Wert$,1,1)
    Cas Wert$ = »:Wert$ = "A"
    Retour Wert$

ENDPROC

WhileLoop 1000

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

Endwhile

ListBox$("Ergebnis",2)

je vois là zumindest "-" marque am Anfang.
Hab beim letzten Posting peut-être. simple oublier qc un Codezeile trop lösche. Hatte cela erste marque abgeschnitten qui Übersichtlichkeit halber

19.10.2011 ▲

Vollständiges citation

Absatzweise Citation Zeilenweise Citation

Jörg
Sellmeyer

Es hat mir aucun Ruhe gelassen et je hab encore weitergetüftelt. maintenant hab ich's raus et c'est letztlich unkomplizierter comme anfangs erwartet.

Kompilieren Marque Séparation

'et renversé
'Jörg Selllmeyer 2011
'zur freien Verwendung
'ici bekommt on très bien erklärt, comment cela Umrechnen de payons dans un autre la base funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm
'qui difficulté hierbei, ist qui fehlende zéro. Alle Nullstellen doit abgefangen volonté, qui
'aktuelle Stelle um une verringert et qui folgende Stelle également um une verringert volonté.
'qui Wert A000 wird ensuite alors sans Nullen trop YYZ. C000 wird trop BYYZ

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            'ici volonté qui Nullstellen abgefangen et umgewandelt
            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Proc ABC2Nr

    Paramètres Text$
    Déclarer numéro!,somme!,B$
    Text$ = Upper$(Text$)

    WhileLoop Len(Text$),1,-1

        B$ = $ Substr(Text$,-&Boucle)
        numéro! = (Ord(B$)-64) * 26^(&Boucle-1)
        somme! = somme! + numéro!

    Wend

    Retour Int(somme!)

ENDPROC

Cls
Titre de la fenêtre "Zahlen dans Buchstaben transformer et umgekehrt"
Imprimer "LQSVOFKGQM =", ABC2Nr("LQSVOFKGQM")
Imprimer "AAAAAA =", ABC2Nr("AAAAAA")
Imprimer "ABCDEFGH =", ABC2Nr("ABCDEFGH")
Imprimer
Imprimer "XPROFAN pouvoir Spass =", ABC2Nr("XPROFAN"),ABC2Nr("macht"),ABC2Nr("Spass")
Imprimer
Déclarer s$
Randomiser

WhileLoop 10

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

Wend

Imprimer s$ + " =",ABC2Nr($ S)
WaitInput
Cls
Randomiser

WhileLoop 0,780,1

    Imprimer Nr2ABC(&Boucle),

Wend

WaitInput
Cls

WhileLoop 00,480,1

    Imprimer Nr2ABC(&Boucle + Tour(345676)),

Wend

WaitInput

ici ist encore un kleines Programme, chez dem on un un peu herumexperimentieren peux:

Kompilieren Marque Séparation

 $H windows.ph
Def DelLast(2) Mid $(@$(1),1,(Len(@$(1)) - @&(2)))
'ici peux on joli nachlesen, comment so une change funktioniert:
'https://www.arndt-bruenner.de/mathe/scripts/Zahlensysteme.htm

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Proc ABC2Nr

    Paramètres Text$
    Déclarer numéro!,somme!,B$

    WhileLoop Len(Text$),1,-1

        B$ = $ Substr(Text$,&Boucle)
        numéro! = Chr$(B$) * 26^(&Boucle-1)
        somme! = somme! + numéro!

    Wend

    Retour somme!

ENDPROC

SubProc Créer.TextR

    Retour @Contrôle("STATIC",@$(2),$50000002,@%(3),@%(4), \
    @%(5),@%(6),@%(1),101, %hInstance)

ENDPROC

Proc Text_setzen

    Paramètres cb&,txt&,txt1&
    Déclarer Text$,Ergebnis!
    Text$ = GetText $(txt&)
    SetText txt1&,Str$((GetCurSel(cb&)) * Val(Text$))
    Claire Text$

    WhileLoop 0,se mettre%-1

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

    Wend

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

ENDPROC

Proc Button_Aktion

    Paramètres btn&

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

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

    D'autre

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

    EndIf

ENDPROC

Proc Alle_Null

    Paramètres btn&

    Si GetText $(btn&) = "alle zéro setzen"

        WhileLoop 0,se mettre%-1

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

        Wend

        SetText btn&,"alle Zufall"

    D'autre

        WhileLoop 0,se mettre%-1

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

        Wend

        SetText btn&,"alle zéro setzen"

    EndIf

ENDPROC

Déclarer se mettre%
Stellen% = 10
Déclarer cb&[se mettre%],txt&[se mettre%],txt1&[se mettre%],A$,x%,b%,focushdl&,focus%,Ergebnis&
Déclarer btn&[se mettre% + 1]
b% = 118
x% = 120
Fenêtre Style 8 | 24 | 512
Fenêtre se mettre% * (b% + 24),300
SetDialogFont ~GetStockObject($11)

WhileLoop 26

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

Wend

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

WhileLoop 0,se mettre%-1

    cb&[&Boucle] = Créer("ChoiceBox",%hwnd,0,5 + &Boucle * x%,40,b%,160)
    Créer("Tooltip",%hwnd,cb&[&Boucle],"26^" + Str$(se mettre%-1 - &Boucle))
    MoveListToHandle(cb&[&Boucle])
    SendMessage(cb&[&Boucle],$014E,0,0)
    txt&[&Boucle] = Créer("TextR",%hwnd,»,5 + &Boucle * x%,10,b%,20)
    txt1&[&Boucle] = Créer("TextR",%hwnd,»,5 + &Boucle * x%,80,b%,20)
    btn&[&Boucle] = Créer("Button",%hwnd,"Zufall",5 + &Boucle * x%,110,b%,20)
    Cas &Boucle = se mettre% - 1:btn&[&Boucle + 1] = Créer("Button",%hwnd,"Zufall",5 + (&Boucle + 1) * x%,110,b%,20)

Wend

Var txt_Alphabet& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,40,b% + se mettre%,20)
Var txt_Ergebnis& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,80,b%,20)
Var txt_Nr2ABC& = Créer("TextR",%hwnd,»,5 + se mettre% * x%,140,b%,20)
Set("Décimal",0)

WhileLoop 0,se mettre%-1

    SetText txt&[se mettre%-1 - &Boucle],Str$(26^&Boucle)

Wend

Randomiser

Tandis que 1

    WaitInput
    focushdl& = %getfocus

    WhileLoop 0,se mettre%-1

        Cas focushdl& = cb&[&Boucle]:focus% = &Boucle

        Si focushdl& = btn&[&Boucle]

            focus% = &Boucle

        EndIf

    Wend

    Si %clé = 2

        Pause

    ElseIf GetFocus(cb&[focus%])

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

    ElseIf Clicked(btn&[focus%])

        Button_Aktion(btn&[focus%])

    ElseIf Clicked(btn&[se mettre%])

        Alle_Null(btn&[se mettre%])

    ElseIf %mousepressed = 2

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

        Si MenuItem(100)

            ClearClip
            PutClip GetText $(txt_Ergebnis&)

        ElseIf MenuItem(101)

            ClearClip
            PutClip GetText $(txt_Alphabet&)

        EndIf

    EndIf

Wend

ici ist encore une Auflistung:

Kompilieren Marque Séparation

Proc Nr2ABC

    Paramètres numéro!
    Déclarer Wert$,reste%

    Tandis que numéro! > 0

        reste% = numéro! Mod 26
        numéro! = numéro! \ 26

        Si reste% = 0

            numéro! = numéro! -1
            reste% = 26

        EndIf

        Cas reste% > 0:Wert$ = Chr$(reste% + 64) + Wert$

    Wend

    Retour Wert$

ENDPROC

Cls
ShowMax
Déclarer se mettre%[6],Wert$[6],n%,a$,b$,OrdNr&,En-tête$,s$
Claire se mettre%[]
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& = Créer("GridBox",%hwnd,s$,0,2,2,Width(%hwnd)-4,Height(%hwnd)-4)

WhileLoop 26^2

    WhileLoop 26

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

    Wend

    AddStrings(l&,Str$(OrdNr&-26) + "|" + b$)
    Claire b$
    Titre de la fenêtre Str$(OrdNr&) + " patience - und dir jusqu'à 26^3 (" + Str$(Int(26^3)) + ")"

Wend

Titre de la fenêtre Str$(OrdNr&) + " patience - und dir jusqu'à 26^3 (" + Str$(Int(26^3)) + ") fertig!"

Tandis que 1

    WaitInput

Wend