0
Zahlenratespiel
Der Zauberleerling
Listings
USES CRT;

Procedure CursorOff; Assembler;
Asm
    Push BP
    Xor  AX, AX
    Mov  ES, AX
    Mov  BH, Byte Ptr ES:[462h]  
    Mov  AH, 3
    Int  10h          
    Or   CH, 32
    Mov  AH, 1
    Int  10h        
    Pop  BP
End;

Procedure CursorOn; Assembler;
Asm
    Push BP
    Xor  AX, AX
    Mov  ES, AX
    Mov  BH, Byte Ptr ES:[462h] 
    Mov  AH, 3
    Int  10h          
    And  CH, 31
    Mov  AH, 1
    Int  10h         
    Pop  BP
End;

Var Zahl, Zahl2, Versuche, Max, Punkte: word;
    Name, upstr, dnstr : String;
    pkz : string[5];
    i1,i2 : byte;
    snd1, snd2 : word;
    check : char;
    ende : boolean;
    scores : array[1..10,1..2] of String[15];
    scorefile : text;
    temp, tmp2: word;
    chck : string;

Procedure rscore;
begin
assign(Scorefile,'Hiscore.dat');
{$I-}
reset(Scorefile);
If IOResult <> 0 then
begin
rewrite(scorefile);
If IOResult <> 0 then exit;
for temp:= 1 to 10 do
begin
Writeln(scorefile,'Kein Name');
Writeln(scorefile,'00000');
scores[temp,1]:='Kein Name';
scores[temp,2]:='00000';
end;
close(scorefile);
end;
{$I+}
for temp := 1 to 10 do
begin
readln(scorefile,chck);
scores[temp,1]:=chck;
readln(scorefile,chck);
scores[temp,2]:=chck;
end;
end;

Procedure wscore;
begin
assign(Scorefile,'Hiscore.dat');
{$I-}
rewrite(scorefile);
for temp:= 1 to 10 do
begin
Writeln(scorefile,scores[temp,1]);
Writeln(scorefile,scores[temp,2]);
end;
close(scorefile);
if ioresult <> 0 then;
{$I+}
end;

procedure tick;
begin
sound(500);
delay(15);
nosound;
end;

Procedure Wr(strng: string);
var ch : string; c : word;
begin
for c:=1 to length(strng) do
begin
ch:=copy(strng,c,1);
write(ch);
tick;
delay(75);
end;
Writeln;
end;

Procedure Finish;
begin
halt(1);
end;

procedure actualize;
var x,y:byte;
begin
x:=wherex;
y:=wherey;
Window(1,25,80,25);
textbackground(13);
textcolor(10);
Write(' Versuche: ',Versuche);
textbackground(9);
Window(1,6,80,23);
gotoxy(x,y);
end;

procedure intro;
begin
textbackground(9);
i1:=12; i2:=14;
repeat
gotoxy(1,i1);
write(upstr);
clreol;
gotoxy(1,i2);
write(dnstr);
gotoxy(1,wherey-2);
clreol;
inc(i2);
dec(i1);
sound(i1*50);
delay(50);
sound(i2*50);
delay(50);
until i1=1;
nosound;
gotoxy(24,3);
Wr('Wilkommen beim Zahlenratespiel !');
delay(10);
Gotoxy(12,wherey);
Write('Wie hoch soll ihre maximalzahl sein 
(max.: 65000): ');
cursoron;
readln(max);
cursoroff;
if max > 65000 then max := 65000;
if max < 1     then max := 1;
zahl:=random(max-1)+1;
i1:=1;
i2:=80;
gotoxy(i1,wherey); Write('-');
gotoxy(i2,wherey); Write('-');
inc(i1);
dec(i2);
tick;
gotoxy(i1,wherey-1); Write('-');
gotoxy(i2,wherey); Write('-');
inc(i1);
dec(i2);
tick;
repeat
gotoxy(i1,wherey); Write('-');
gotoxy(i2,wherey); Write('-');
inc(i1);
dec(i2);
tick;
delay(100);
until i1 = 41;
Window(1,6,80,23);
end;

procedure sccheck;
begin
For temp:= 1 to 10 do
begin
val(scores[temp,2],tmp2,max);
if  tmp2 < Punkte then
begin
if temp <> 10 then for tmp2:=9 downto temp do
begin
scores[tmp2,1]:= scores[tmp2+1,1];
scores[tmp2,2]:= scores[tmp2+1,2];
end;
gotoxy(24,wherey);
Writeln('Dies reicht fr die High-Score !');
gotoxy(18,wherey);
Write('Bitte gib deinen Namen ein: 
_______________.');
gotoxy(wherex-16,wherey);
cursoron;
Readln(name);
cursoroff;
scores[temp,1] := name;
scores[temp,2] := pkz;
wscore;
exit;
end;
end;
end;

begin
ende:=false;
randomize;
cursoroff;
Punkte:=0;
Versuche:=1;
upstr := 
'_________--------------------------------------
------------------------_________';
dnstr := 
'---------______________________________________
________________________---------';
textcolor(10);
textbackground(9);
clrscr;
textbackground(13);
Write('         Das lustige Zahlenratespiel V1.0 
- A production of Empire-Labs         ');
repeat
textbackground(13);
gotoxy(1,25);
clreol;
Write(' VERSUCHE: 0');
rscore;
intro;
repeat
textcolor(14);
Write(' Gib deinen Tip ein: ');
cursoron;
readln(Name);
cursoroff;
if (name = 'ende') or (name = 'ENDE') or (name = 
'Ende') then finish;
val(Name,zahl2,temp);
if zahl <> zahl2 then inc(versuche);
if zahl <> zahl2 then
 begin
  textcolor(13);
  if zahl > zahl2 then Writeln('  Die gesuchte 
Zahl ist gr”įer als dein Tip.');
  if zahl < zahl2 then Writeln('  Die gesuchte 
Zahl ist kleiner als dein Tip.');
  snd1:=500;
  snd2:=1000;
  repeat
  sound(i1);
  sound(12);
  delay(2);
  dec(i2);
  sound(i1);
  sound(12);
  dec(i2);
  dec(i1);
  delay(2);
  until i1 = 50;
  nosound;
 end;
actualize;
until zahl = zahl2;
snd1:=0;
snd2:=750;
repeat
sound(snd1);
inc(snd1);
delay(1);
until snd1 = 1000;
repeat
sound(snd2);
inc(snd2);
delay(2);
until snd2 = 1000;
nosound;
Writeln;
Writeln;
gotoxy(30,wherey);
Wr('Du hast gewonnen !!!');
Punkte:=max div versuche;
gotoxy(24, wherey);
str(Punkte,name);
pkz:='';
for tmp2 := 1 to 5-length(name) do pkz:=pkz+'0';
pkz:=pkz+name;
Writeln('Deine Punktezahl betr„gt: '+pkz);
sccheck;
gotoxy(24,wherey);
Write('Willst du nochmal spielen (j/n):');
repeat
readln(check);
until (check = 'j') or (check = 'n');
if check = 'n' then ende:=true;
window(1,1,80,25);
if not ende then
begin
textbackground(9);
i1:=2; i2:=24;
gotoxy(1,i1);
write(upstr);
gotoxy(1,i2);
write(dnstr);
clreol;
inc(i1);
dec(i2);
sound(i1*50);
delay(50);
sound(i2*50);
delay(50);
repeat
gotoxy(1,i1);
write(upstr);
gotoxy(1,wherey-2);
clreol;
gotoxy(1,i2);
write(dnstr);
clreol;
inc(i1);
dec(i2);
sound(i1*50);
delay(50);
sound(i2*50);
delay(50);
until i1=12;
nosound;
end;
until ende;
textcolor(7);
textbackground(0);
clrscr;
end.

{Die Highscore funktioniert nicht richtig!}