Vokabeltrainer + ListMaker von ???
Da ich morgen Französisch SChulaufgabe schreib,wollt ich mir einfach mal ein programm schreiben,mit dem ich die vokabeln lernen kann :wink:
Man braucht einfach ne datei mit namen voks.txt.Dann schreibt an als erstes das französische/englische was auch immer wort hin und darunter die deutsche übersetzung.Mit pfeiltaste links/rechts kann man die seite ändern.
Vielleicht brauchts ja einer :wink:
[code:1:b66f64516a]Graphics 800,600,16,2
SetBuffer BackBuffer()
SeedRnd MilliSecs()

apptitle "Vokabeltrainer 1.00"

;font=LoadFont("french grotesque",24,False,False,False)
;SetFont font

Dim fra$(10000)
Dim deu$(10000)
Dim frapos(10000,2)
Dim deupos(10000,2)

Global cfarbe,cposx,cposy,deltime=MilliSecs(),iput=False
Global eingabe$,name$
Global file$="voks.txt"
Global i,maxvok
Global seite=0
Global y
Global vokabelnr
Global fravok$,loesung$
Global frage_stellen=False
Global vok_aussuchen=False
Global vok_pruefen=False
Global anzahl
Global richtig,falsch
Global versuch,maxversuch=20
Global resultat=False
Global sprache$


;#######################################################################

Function vokeingabe$(x,y,frage$,maxl)
If iput=True Then
a=GetKey()
If a=>32 And a<=255 And Len(name$)<maxl-1 Then name$=name$+Chr$(a)
If KeyHit(28) Then iput=False:frage_stellen=False:vok_pruefen=True:FlushKeys():name$=Lower$(name$):Return name$
If KeyDown(14) And Len(name$)>0 And MilliSecs()-deltime>100 Then
deltime=MilliSecs()
name$=Left(name$,Len(name$)-1)
EndIf

cfarbe=cfarbe+7
If cfarbe>255 Then cfarbe=0
cposx=x+StringWidth(frage$)+StringWidth(name$)
cposy=y
Color cfarbe,cfarbe,cfarbe
Rect cposx,cposy,10,StringHeight(frage$)
Color 255,255,255

Text x,y,frage$+name$
EndIf
End Function

;#######################################################################

Function faerben$(wort$,r,g,b)
Color r,g,b
Write wort$
Color 255,255,255
End Function

Function voks_einlesen()
datei$=OpenFile(file$)
While Not Eof(datei$)
fra$(i)=ReadLine(datei$)
deu$(i)=ReadLine(datei$)
y=y+1
frapos(i,1)=100 ;x
frapos(i,2)=y*20 ;y
deupos(i,1)=500
deupos(i,2)=y*20
i=i+1
If y Mod 20=0 Then y=0
Wend
anzahl=i
i=0
CloseFile datei$
End Function

Text 100,100,"1 - Englisch"
Text 100,150,"2 - Französisch"
Text 100,200,"3 - Spanisch"
Text 100,250,"4 - Italienisch"
auswahl=Input("Welche Sprache:")
FlushKeys()

If auswahl=1 Then sprache$="Englisch"
If auswahl=2 Then sprache$="Französisch"
If auswahl=3 Then sprache$="Spanisch"
If auswahl=4 Then sprache$="Italienisch"

voks_einlesen



While Not KeyHit(1)
Cls



Text 100,0,"Vokabeln auslesen - 1"
Text 100,50,"Vokabeltest starten - 2"
;Text 100,100,"Credits - 3"

If KeyHit(2) Then
Cls
minvok=0
maxvok=19
i=0
Gosub Vokabelliste
EndIf

If KeyHit(3) Then
vok_aussuchen=True
FlushKeys()
EndIf

Gosub vok_aussuchen
Gosub vok_abfragen
Gosub vok_pruefen
Gosub resultat_zeigen

eingabe$=vokeingabe$(100,100,">>",50)


Flip
Wend
End


.Vokabelliste
Repeat
If KeyDown(1) Then FlushKeys():Exit

If KeyHit(205) Then
Cls
seite=seite+1
maxvok=maxvok+20
minvok=minvok+20
i=i+20
ElseIf KeyHit(203) Then
If seite>0 Then
Cls
seite=seite-1
maxvok=maxvok-20
minvok=minvok-20
i=i-20
EndIf
EndIf

Line 400,40,400,600
Text 0,0,"Vokabelliste"
Text 0,23,"Anzahl Vokabeln: "+anzahl
Text 400,20,"Seite: "+(seite+1),True,True
Color 0,0,255
Text 100,50,sprache$
Color 255,255,255
Color 0,255,0
Text 500,50,"Deutsch"
Color 255,255,255

Text frapos(i,1),frapos(i,2)+75,fra$(i)
Text deupos(i,1),deupos(i,2)+75,deu$(i)

i=i+1
If i>maxvok Then
i=minvok
EndIf

Flip
Forever


.vok_aussuchen
If vok_aussuchen=True Then

vokabelnr=Rand(0,anzahl-1)
fravok$=fra$(vokabelnr)
loesung$=deu$(vokabelnr):loesung$=Lower$(loesung$)
frage_stellen=True
vok_aussuchen=False
EndIf
Return

.vok_abfragen
If frage_stellen=True Then
Cls
Text 100,50,"Was heisst "
Color 255,0,0
Text 100+StringWidth("Was heisst "),50,fravok$
Color 255,255,255
Text 100+StringWidth("Was heisst ")+StringWidth(fravok$),50," auf deutsch?"
iput=True
EndIf
Return

.vok_pruefen
If vok_pruefen=True Then
Cls
If eingabe$=loesung$ Then
Repeat
Color 0,255,0
Text 400,300,"Richtig !!!",True,True
Color 255,255,255
Text 400,450,"Enter drücken für neue Vokabel",True,True
Text 400,500,"ESC zum Beenden",True,True
If KeyHit(1) Then End
If KeyHit(28) Then
vok_pruefen=False
vok_aussuchen=True
versuch=versuch+1
richtig=richtig+1
name$=""
If versuch=maxversuch Then
resultat=True
versuch=0
vok_pruefen=False
frage_stellen=False
vok_aussuchen=False
FlushKeys()
EndIf
Exit
EndIf
Flip
Forever
Else
Repeat
Color 255,0,0
Text 400,300,"Leider Falsch",True,True
Color 255,255,255
Text 200,350,"Die richtige Antwort wäre "
Color 0,255,0
Text 200+StringWidth("Die richtige Antwort wäre "),350,loesung$
Color 255,255,255
Text 200+StringWidth("Die richtige Antwort wäre ")+StringWidth(loesung$)+8,350," gewesen"
name$=""
Text 400,450,"Enter drücken für neue Vokabel",True,True
Text 400,500,"ESC zum Beenden",True,True
If KeyHit(1) Then End
If KeyHit(28) Then
vok_pruefen=False
vok_aussuchen=True
versuch=versuch+1
falsch=falsch+1
name$=""
If versuch=maxversuch Then
resultat=True
versuch=0
vok_pruefen=False
frage_stellen=False
vok_aussuchen=False
FlushKeys()
EndIf
Exit
EndIf
Flip
Forever
EndIf
EndIf
Return


.resultat_zeigen
If resultat=True Then
Cls
Text 400,300,"Ende",True,True
Text 200,350,"Du hast "+richtig+"/"+(maxversuch)+" Vokabeln richtig beantwortet"
Flip
WaitKey()
End
EndIf
Return
[/code:1:b66f64516a]
===
von ???
Schön! Gut ist, dass du die Vokabeln einlesen lässt und nicht im Programm integriert hast. So kannst du (falls du später neue Versionen machst) die Vokabeln einfach ändern!
===
von ???
yo genau,deswegen hab ich ja noch englisch und was weiss ich was alles am anfang,damits dann schöner aussieht...hehe :wink:
Man kann 500 Seiten an Vokabeln einlesen..macht dann *denk*
500*20=10000 Vokabeln.Dürfte reichen ^^
===
von ???
Hab noch ein kleines Programmchen geschrieben,mit der man sich ne liste erstellen kann.
Bei mir z.B. is es so,dass ich mir die wörter ausm internet hole.
Da des aber manchmal sehr mühsam sein kann,die wörter danach richtig in ner liste zu ordnen,hab ich des geschrieben.
Man liest ne textdatei ein und das programm löscht die ganzen Bindestriche und kommas,lässt aber,falls da mehrere übersetzungen stehen,nur die erste da(is für mich genug :wink: )

beispiel:
[quote:35e1cc245c]
;das steht z.B. in ner text datei
to arrive - ankommen,eintreffen,erscheinen[/quote:35e1cc245c]
dann schreibt das prog das da in die neue txt-datei(name: list.txt)

[quote:35e1cc245c]to arrive ankommen[/quote:35e1cc245c]

Eigentlich nix besonderes am Code,aber erspart mir ungemein arbeit...also...wers braucht,bitte schön :wink:

[code:1:35e1cc245c]Graphics 800,600,16,2

Dim list$(1000)

file$=ReadFile("list.txt")
While Not Eof(file$)
Text 0,0,"Lese Datei..."
list$(i)=ReadLine(file$)
If Instr(list$(i),"-") Then
list$(i)=Replace$(list$(i),"-","")
EndIf
If Instr(list$(i),",") Then
list$(i)=Left(list$(i),Instr(list$(i),",")-1)
EndIf
i=i+1
Wend
anzahl=i-1
i=0
CloseFile file$

;datei schreiben
newfile$=WriteFile("list2.txt")
For i=0 To anzahl
Text 0,0,"Schreibe Datei..."
WriteLine newfile$,list$(i)
Next
CloseFile newfile$

End
[/code:1:35e1cc245c]

Wenn ich jetz noch wüsste,wie man nen zeilenumbruch hinbekommt wärs perfekt :wink:
===
von ???
so,das is jetz vorerst die letzte änderung die ich mach.
Also,man muss jetz nix mehr an der liste umändern.Sie wird fertig in ne textdatei geschrieben,dass man se nur noch mit dem vokabeltrainer einlesen muss

Wiedern Beispiel :wink:
also aus
[quote:91d90235e4]to arrive - ankommen[/quote:91d90235e4]
wird
[quote:91d90235e4]to arrive
ankommen[/quote:91d90235e4]

Hab mir viel mühe gegeben,euch arbeit zu sparen :wink:

[code:1:91d90235e4]Graphics 800,600,16,2

Dim a$(1000)
Dim b$(1000)
Dim c$(1000)



file$=ReadFile("list.txt")
While Not Eof(file$)
a$(i)=ReadLine(file$)
If Instr(a$(i),"-") Then
b$(i)=Mid$(a$(i),1,Instr(a$(i),"-")-1):b$(i)=Trim$(b$(i))
c$(i)=Mid$(a$(i),Instr(a$(i),"-")+1):c$(i)=Trim$(c$(i))
EndIf
i=i+1
Wend
anzahl=i-1
i=0
CloseFile file$

For i=0 To anzahl
If Instr(c$(i),",") Then
c$(i)=Left$(c$(i),Instr(c$(i),",")-1):c$(i)=Trim$(c$(i))
EndIf
Next

i=0

file$=WriteFile("list2.txt")
For i=0 To anzahl
WriteLine file$,b$(i)
WriteLine file$,c$(i)
Next
CloseFile file$

End [/code:1:91d90235e4]

EDIT: Hab mir grad ne Liste mit 2004 englischen Wörtern(inklusive deutscher übersetzung :wink: ) gemacht.
Hier könnt ihr se runterladen:
[url=http://www.free.pages.at/unraveling/voks.rar]Englisch Vokabelliste[/url]
===
von ???
@JRQ
danke fürs feedback :wink: ,leider funktioniert das "listensortierprog" nur bei solchen sachen
[quote:22dcedf30f]englisch - deutsch[/quote:22dcedf30f]

sollte aber fürn anfang reichen :wink:
===
von ???
Ich hatte auch mal einen geschrieben (auch für griechisch :wink: ). Werds mal auch hier posten. Der Code ist aber net so toll, war mein zweiters Programm.



Suche:
(unterstützt mySQL Wildcards ala %)
Titel:
Text:
Autor: