Forum | | | | - 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:
In unserem Falle also:
Jetzt musst du praktisch nur noch den Code in der richtigen Reihenfolge zusammenpappen. Ich hoffe, das schaffst du ohne Hilfe. |
| | | | |
| | Julian Schmidt | Verflixt zu erst hab ich auch eine Schleife gedacht nur dann hat die Idee einer IF-Bedingung doch überwiegt. |
| | | | |
| | 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)
|
| | | | |
| | 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. |
| | | | |
| | 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. |
| | | | |
| | 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 |
| | | | |
| | 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 |
| | | | |
| | | Pheeeerfekt! |
| | | | |
| | Julian Schmidt | Das Thema ist ja immernoch aktiv. Muss ich mal schließen |
| | | | |
| | | Also sowas! |
| | | | |
|
AntwortenThemenoptionen | 27.306 Betrachtungen |
ThemeninformationenDieses Thema hat 4 Teilnehmer: |