Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Satzbau (Lernprogramm)
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| Freeware (proprietär) |  HD |  19.11.2015 |
Wie der Name schon vermuten laesst, bietet das Programm SATZBAU Uebungen im Ordnen von Woertern an. Es verwuerfelt beliebige Texte zeilenweise und kontrolliert die richtige Ordnung, die der Lernende wiederherstellt.'S A T Z B A U
'von HD
'Vorsicht! Die Anzahl der Woerter wird an Hand der
'Luecken zwischen den Woertern festgestellt. Deshalb
'zaehlen Leerstellen wie Woerter. Trennungszeichen
'am Zeilenende werden nicht beruecksichtigt. Bitte
'entfernen Sie sie ebenso wie unsichtbare Leerstellen
'am Zeilenende vor Erstellung des verwuerfelten
'Textes!
#lang "fblite"
#include "dir.bi"
DIM AS INTEGER Breite,hoehe,wo,z1,z2
dim as string aas,aKo,eingabe,er,fi,n,w,za
dim as string auf(400),fbD(3),ink(30)
DECLARE Sub list_files (ByRef filespec As String, ByVal attrib As Integer)
fbD(1)="richtig"
fbD(2)="gut"
fbD(3)="ja"
screeninfo Breite,hoehe
SCREENRES breite-100,hoehe-100
COLOR 7,1:CLS
startSB: CLOSE 1:CLOSE 2
?:?:?SPACE(11);"Text verwuerfeln -> -> Taste V"
wo=0:?:?SPACE(11);"Verwuerfelten Text ordnen -> Taste O"
?:?SPACE(32);"Ende -> Taste E ";
w= INPUT(1):w= UCASE(w)
IF w="E" THEN END ELSE CLS
IF w<>"V" THEN GOTO verwuerfeln
?:?:list_files "*.txt", fbArchive
?:?" Welcher Text soll verwuerfelt werden?"
?:?:INPUT " ";aas
IF aas="E" OR aas="e" THEN END
OPEN aas FOR INPUT AS #1:BEEP
?:?" Unter welchem Namen soll der Einsetztext gespeichert werden?"
?:?" Die Endung ";CHR (34);".SB";CHR (34);
?" wird automatisch hinzugefuegt."
?:?:INPUT " ";fi:fi=fi+".SB"
?:?" Ich trage den neuen Text ein."
OPEN fi FOR OUTPUT AS #2
eintrag:FOR an=1 TO z2+1:ink(an)="":NEXT an:z2=0
IF EOF(1) THEN GOTO AD
LINE INPUT #1, eingabe
Li=LEN(eingabe):x=1
leerz:IF MID (eingabe,x,1)<>" " THEN GOTO z100
wo=wo+1:auf(wo)=LEFT (eingabe,x-1)
z2=z2+1:ink(z2)=LEFT (eingabe,x-1)
LW=LEN(auf(wo))
IF Li <=LW THEN GOTO z100
eingabe=RIGHT (eingabe,(Li-LW-1)):Li=Li-LW-1
x=1:GOTO leerz
z100:x=x+1
IF Li=0 THEN GOTO AD
IF x < Li THEN GOTO leerz
wo=wo+1:auf(wo)= eingabe
z2=z2+1:
ink(z2)= eingabe
IF auf(wo)="" THEN wo=wo-1
FOR an=1 TO z2 STEP 2
IF ink(an+1) <> "" THEN SWAP ink(an),ink(an+1)
NEXT an
n="":FOR an=z2 TO 1 STEP -1
n=n+ink(an)+" ":
NEXT an:? #2,n:n=""
GOTO eintrag
AD:?:?" Der Text enthaelt";wo;" Woerter."
?:?" Den verwuerfelten Text mit"
COLOR 15,1:?:?" eingeschaltetem";:COLOR 7,1
? " Drucker drucken (8 Zeichen Rand), j(a) / n(ein)? ";
w=INPUT(1):? :IF w="j" OR w="J" THEN CLOSE 2 ELSE GOTO startSB
OPEN fi FOR INPUT AS #2
z250:IF EOF(2) THEN GOTO startSB ELSE LINE INPUT #2, eingabe
Lprint " "; eingabe:GOTO z250
verwuerfeln:CLS
?:?:list_files "*.*", fbArchive
?:?" Bitte den Namen des ";:COLOR 15,1:
?"un";:COLOR 7,1:? "verwuerfelten Textes eingeben! ";
LINE INPUT " ";aas:IF UCASE(aas)="E" THEN GOTO startSB
?:?" Name des verwuerfelten Textes ";
COLOR 15,1:? "mit";:COLOR 7,1:? " der Endung .SB? ";
LINE INPUT fi
OPEN aas FOR INPUT AS #1
OPEN fi FOR INPUT AS #2
CLS:?:?:?
eintrag0:IF EOF(2) THEN GOTO z1200
LINE INPUT #2,za:?:?" Bitte ordne:"
?:?" ";za
?:?" ";:LINE INPUT #1,aKo
z1=z1+1:LINE INPUT er:IF UCASE(er)="E" THEN END
IF er=aKo THEN rn=INT(RND(1)*3)+1 ELSE GOTO zF
?:?" ";fbD(rn)
GOTO eintrag0
zF:
F=F+1:?:?" Bitte vergleiche mit meiner Loesung:"
?:?" ";aKo
?:? " Weiter mit jeder Taste!":w=INPUT(1)
CLS:GOTO eintrag0
z1200:CLS :LOCATE 10,12
? "Du warst fleissig. Weiter so! ";z1-F;" von ";z1;" Zeilen richtig."
GOTO startSB
Sub list_files (ByRef filespec As String, ByVal attrib As Integer)
Dim As String filename = Dir(filespec, attrib)
Do While Len(filename) > 0
Print:? tab(30);filename
filename = Dir()
Loop
End SubBeispiel-Text zum Verwuerfeln:
Es war abends und dunkel.
Ich musste in die Kueche.
Da sah ich vor mir einen Geist.
Der Geist flog durch die Luft.
| Zusätzliche Informationen und Funktionen | |||||||
|---|---|---|---|---|---|---|---|
|
|||||||
Bearbeiten
Versionen