home *** CD-ROM | disk | FTP | other *** search
/ PC Action 1998 January / PCA0198.ISO / MENUE / POSTFACH / 98012058.TXT < prev    next >
Text File  |  1997-11-25  |  6KB  |  343 lines
  1. 0
  2. Zahlenratespiel
  3. Der Zauberleerling
  4. Listings
  5. USES CRT;
  6.  
  7. Procedure CursorOff; Assembler;
  8. Asm
  9.     Push BP
  10.     Xor  AX, AX
  11.     Mov  ES, AX
  12.     Mov  BH, Byte Ptr ES:[462h]  
  13.     Mov  AH, 3
  14.     Int  10h          
  15.     Or   CH, 32
  16.     Mov  AH, 1
  17.     Int  10h        
  18.     Pop  BP
  19. End;
  20.  
  21. Procedure CursorOn; Assembler;
  22. Asm
  23.     Push BP
  24.     Xor  AX, AX
  25.     Mov  ES, AX
  26.     Mov  BH, Byte Ptr ES:[462h] 
  27.     Mov  AH, 3
  28.     Int  10h          
  29.     And  CH, 31
  30.     Mov  AH, 1
  31.     Int  10h         
  32.     Pop  BP
  33. End;
  34.  
  35. Var Zahl, Zahl2, Versuche, Max, Punkte: word;
  36.     Name, upstr, dnstr : String;
  37.     pkz : string[5];
  38.     i1,i2 : byte;
  39.     snd1, snd2 : word;
  40.     check : char;
  41.     ende : boolean;
  42.     scores : array[1..10,1..2] of String[15];
  43.     scorefile : text;
  44.     temp, tmp2: word;
  45.     chck : string;
  46.  
  47. Procedure rscore;
  48. begin
  49. assign(Scorefile,'Hiscore.dat');
  50. {$I-}
  51. reset(Scorefile);
  52. If IOResult <> 0 then
  53. begin
  54. rewrite(scorefile);
  55. If IOResult <> 0 then exit;
  56. for temp:= 1 to 10 do
  57. begin
  58. Writeln(scorefile,'Kein Name');
  59. Writeln(scorefile,'00000');
  60. scores[temp,1]:='Kein Name';
  61. scores[temp,2]:='00000';
  62. end;
  63. close(scorefile);
  64. end;
  65. {$I+}
  66. for temp := 1 to 10 do
  67. begin
  68. readln(scorefile,chck);
  69. scores[temp,1]:=chck;
  70. readln(scorefile,chck);
  71. scores[temp,2]:=chck;
  72. end;
  73. end;
  74.  
  75. Procedure wscore;
  76. begin
  77. assign(Scorefile,'Hiscore.dat');
  78. {$I-}
  79. rewrite(scorefile);
  80. for temp:= 1 to 10 do
  81. begin
  82. Writeln(scorefile,scores[temp,1]);
  83. Writeln(scorefile,scores[temp,2]);
  84. end;
  85. close(scorefile);
  86. if ioresult <> 0 then;
  87. {$I+}
  88. end;
  89.  
  90. procedure tick;
  91. begin
  92. sound(500);
  93. delay(15);
  94. nosound;
  95. end;
  96.  
  97. Procedure Wr(strng: string);
  98. var ch : string; c : word;
  99. begin
  100. for c:=1 to length(strng) do
  101. begin
  102. ch:=copy(strng,c,1);
  103. write(ch);
  104. tick;
  105. delay(75);
  106. end;
  107. Writeln;
  108. end;
  109.  
  110. Procedure Finish;
  111. begin
  112. halt(1);
  113. end;
  114.  
  115. procedure actualize;
  116. var x,y:byte;
  117. begin
  118. x:=wherex;
  119. y:=wherey;
  120. Window(1,25,80,25);
  121. textbackground(13);
  122. textcolor(10);
  123. Write(' Versuche: ',Versuche);
  124. textbackground(9);
  125. Window(1,6,80,23);
  126. gotoxy(x,y);
  127. end;
  128.  
  129. procedure intro;
  130. begin
  131. textbackground(9);
  132. i1:=12; i2:=14;
  133. repeat
  134. gotoxy(1,i1);
  135. write(upstr);
  136. clreol;
  137. gotoxy(1,i2);
  138. write(dnstr);
  139. gotoxy(1,wherey-2);
  140. clreol;
  141. inc(i2);
  142. dec(i1);
  143. sound(i1*50);
  144. delay(50);
  145. sound(i2*50);
  146. delay(50);
  147. until i1=1;
  148. nosound;
  149. gotoxy(24,3);
  150. Wr('Wilkommen beim Zahlenratespiel !');
  151. delay(10);
  152. Gotoxy(12,wherey);
  153. Write('Wie hoch soll ihre maximalzahl sein 
  154. (max.: 65000): ');
  155. cursoron;
  156. readln(max);
  157. cursoroff;
  158. if max > 65000 then max := 65000;
  159. if max < 1     then max := 1;
  160. zahl:=random(max-1)+1;
  161. i1:=1;
  162. i2:=80;
  163. gotoxy(i1,wherey); Write('-');
  164. gotoxy(i2,wherey); Write('-');
  165. inc(i1);
  166. dec(i2);
  167. tick;
  168. gotoxy(i1,wherey-1); Write('-');
  169. gotoxy(i2,wherey); Write('-');
  170. inc(i1);
  171. dec(i2);
  172. tick;
  173. repeat
  174. gotoxy(i1,wherey); Write('-');
  175. gotoxy(i2,wherey); Write('-');
  176. inc(i1);
  177. dec(i2);
  178. tick;
  179. delay(100);
  180. until i1 = 41;
  181. Window(1,6,80,23);
  182. end;
  183.  
  184. procedure sccheck;
  185. begin
  186. For temp:= 1 to 10 do
  187. begin
  188. val(scores[temp,2],tmp2,max);
  189. if  tmp2 < Punkte then
  190. begin
  191. if temp <> 10 then for tmp2:=9 downto temp do
  192. begin
  193. scores[tmp2,1]:= scores[tmp2+1,1];
  194. scores[tmp2,2]:= scores[tmp2+1,2];
  195. end;
  196. gotoxy(24,wherey);
  197. Writeln('Dies reicht für die High-Score !');
  198. gotoxy(18,wherey);
  199. Write('Bitte gib deinen Namen ein: 
  200. _______________.');
  201. gotoxy(wherex-16,wherey);
  202. cursoron;
  203. Readln(name);
  204. cursoroff;
  205. scores[temp,1] := name;
  206. scores[temp,2] := pkz;
  207. wscore;
  208. exit;
  209. end;
  210. end;
  211. end;
  212.  
  213. begin
  214. ende:=false;
  215. randomize;
  216. cursoroff;
  217. Punkte:=0;
  218. Versuche:=1;
  219. upstr := 
  220. '_________--------------------------------------
  221. ------------------------_________';
  222. dnstr := 
  223. '---------______________________________________
  224. ________________________---------';
  225. textcolor(10);
  226. textbackground(9);
  227. clrscr;
  228. textbackground(13);
  229. Write('         Das lustige Zahlenratespiel V1.0 
  230. - A production of Empire-Labs         ');
  231. repeat
  232. textbackground(13);
  233. gotoxy(1,25);
  234. clreol;
  235. Write(' VERSUCHE: 0');
  236. rscore;
  237. intro;
  238. repeat
  239. textcolor(14);
  240. Write(' Gib deinen Tip ein: ');
  241. cursoron;
  242. readln(Name);
  243. cursoroff;
  244. if (name = 'ende') or (name = 'ENDE') or (name = 
  245. 'Ende') then finish;
  246. val(Name,zahl2,temp);
  247. if zahl <> zahl2 then inc(versuche);
  248. if zahl <> zahl2 then
  249.  begin
  250.   textcolor(13);
  251.   if zahl > zahl2 then Writeln('  Die gesuchte 
  252. Zahl ist größer als dein Tip.');
  253.   if zahl < zahl2 then Writeln('  Die gesuchte 
  254. Zahl ist kleiner als dein Tip.');
  255.   snd1:=500;
  256.   snd2:=1000;
  257.   repeat
  258.   sound(i1);
  259.   sound(12);
  260.   delay(2);
  261.   dec(i2);
  262.   sound(i1);
  263.   sound(12);
  264.   dec(i2);
  265.   dec(i1);
  266.   delay(2);
  267.   until i1 = 50;
  268.   nosound;
  269.  end;
  270. actualize;
  271. until zahl = zahl2;
  272. snd1:=0;
  273. snd2:=750;
  274. repeat
  275. sound(snd1);
  276. inc(snd1);
  277. delay(1);
  278. until snd1 = 1000;
  279. repeat
  280. sound(snd2);
  281. inc(snd2);
  282. delay(2);
  283. until snd2 = 1000;
  284. nosound;
  285. Writeln;
  286. Writeln;
  287. gotoxy(30,wherey);
  288. Wr('Du hast gewonnen !!!');
  289. Punkte:=max div versuche;
  290. gotoxy(24, wherey);
  291. str(Punkte,name);
  292. pkz:='';
  293. for tmp2 := 1 to 5-length(name) do pkz:=pkz+'0';
  294. pkz:=pkz+name;
  295. Writeln('Deine Punktezahl beträgt: '+pkz);
  296. sccheck;
  297. gotoxy(24,wherey);
  298. Write('Willst du nochmal spielen (j/n):');
  299. repeat
  300. readln(check);
  301. until (check = 'j') or (check = 'n');
  302. if check = 'n' then ende:=true;
  303. window(1,1,80,25);
  304. if not ende then
  305. begin
  306. textbackground(9);
  307. i1:=2; i2:=24;
  308. gotoxy(1,i1);
  309. write(upstr);
  310. gotoxy(1,i2);
  311. write(dnstr);
  312. clreol;
  313. inc(i1);
  314. dec(i2);
  315. sound(i1*50);
  316. delay(50);
  317. sound(i2*50);
  318. delay(50);
  319. repeat
  320. gotoxy(1,i1);
  321. write(upstr);
  322. gotoxy(1,wherey-2);
  323. clreol;
  324. gotoxy(1,i2);
  325. write(dnstr);
  326. clreol;
  327. inc(i1);
  328. dec(i2);
  329. sound(i1*50);
  330. delay(50);
  331. sound(i2*50);
  332. delay(50);
  333. until i1=12;
  334. nosound;
  335. end;
  336. until ende;
  337. textcolor(7);
  338. textbackground(0);
  339. clrscr;
  340. end.
  341.  
  342. {Die Highscore funktioniert nicht richtig!}
  343.