Code egg crt program

Code EggCrt.PAS: program EggCrt; {=Can doc=} {! Khong Compile duoc bang Free Pascal !} uses crt,dos; const x1=5;y1=4;x2=77;y2=18; rShift=1; lShift=2; Ctrl=4; Alt=8; ScrLock=16; NumLock=32; CapsLock=64; Insert=128; var EggX,EggY:byte; BedX:1 x2-9; Mark:byte; Lost:Byte; c,d:byte; procedure writexy(x,y:byte;c:string); begin gotoxy(x,y); write(c); end; function SpecialKey(c:byte):boolean; var regs:registers; begin Regs.AH:=2; Intr($16,Regs); if Regs.AL and c = c then SpecialKey:=True else SpecialKey:=False; end; procedure vekhung(x1,y1,x2,y2:word); var z,a,b:word; begin if (x1<>x2) and (y1<>y2) then begin a:=wherex; b:=wherey; if x1>x2 then begin z:=x1; x1:=x2; x2:=z; end; if y1>y2 then begin z:=y1; y1:=y2; y2:=z; end; gotoxy(x1,y1); write(#201); if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205); gotoxy(x2,y1); write(#187); gotoxy(x1,y2); write(#200); if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205); gotoxy(x2,y2); write(#188); if y2-y1>1 then for z:=1 to y2-y1-1 do begin gotoxy(x1,z+y1); write(#186); end; if y2-y1>1 then for z:=1 to y2-y1-1 do begin gotoxy(x2,z+y1); write(#186); end; end; gotoxy(a,b); end; procedure Drawmark; begin gotoxy(x1-1,y2+4); write('Mark: ',mark,'/10'); gotoxy(x1-1,y2+5); write('Lost: ',Lost,'/',mark+Lost); end; Procedure Delay(ms:word); var t: longint; n:real; begin n:=ms/1000; t := meml[0:$46C]; repeat until meml[0:$46C] - t > n*18.2; end; procedure DrawEgg; begin textcolor(yellow); writexy(Eggx+x1,Eggy div 3 + y1-1,#32); writexy(Eggx+x1,Eggy div 3 + y1,#9); textcolor(white); end; procedure DrawBed; begin textcolor(brown); writexy(Bedx+x1-2,y2,#32#32#177#177#177#177#177#177#177#177#177#32#32); textcolor(white); end; procedure init; begin randomize; vekhung(x1-3,y1-2,x2+2,y2+2); vekhung(x1-3,y2+3,x1+15,24); vekhung(x1+18,y2+3,x2+2,24); writexy(x1+20,y2+4,'Dieu khien de trung roi vao o Alt: Tam dung'); writexy(x1+20,y2+5,'Left/Right Shift: di chuyen Ctrl: Di nhanh'); writexy(20,10,'An Alt de tiep tuc '); repeat eggX:=random(60)+3; until specialkey(alt); repeat until not specialkey(alt); writexy(20,10,' '); end; BEGIN textmode(co80); textcolor(white); clrscr; c:=30; writexy(c,11,#75#32#32#75#32#73#32#69#69#69#69#32#78#32#32#78); writexy(c,12,#75#32#75#32#32#73#32#69#32#32#32#32#78#78#32#78); writexy(c,13,#75#75#32#32#32#73#32#69#69#69#32#32#78#32#78#78); writexy(c,14,#75#32#75#32#32#73#32#69#32#32#32#32#78#32#32#78); writexy(c,15,#75#32#75#32#32#73#32#69#69#69#69#32#78#32#32#78); writexy(c,16,#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45); writexy(c,17,#67#32#79#32#73#32#95#32#49#32#57#32#57#32#55#32); writexy(c,5,#71#97#109#101#32#72#117#110#103#32#84#114#117#110#103); writexy(25,9,#66#97#110#32#113#117#121#101#110#58); writexy(37,9,#107#105#101#110#95#99#111#105#95#49#57#57#55); writexy(12,19,'Phong to cua so < Alt+Enter > de chat luong anh tot nhat'); textcolor(lightgray); writexy(c,22,#76#32#79#32#65#32#68#32#73#32#78#32#71); textcolor(yellow); gotoxy(c,22); write(#76#32);delay(1000); write(#79#32);delay(1000); write(#65#32);delay(1000); write(#68#32);delay(1000); write(#73#32);delay(1000); write(#78#32);delay(1000); write(#71);delay(1000); textcolor(white); repeat clrscr; mark:=0; Lost:=0; init;bedx:=20; for c:=1 to 10 do begin Eggx:=random(60)+3; gotoxy(5,14+3); write(' '); for Eggy:=1 to 14*3 do begin drawbed; drawegg; drawmark; if specialkey(lshift) and (bedx>=1) then dec(bedx); if specialkey(rshift) and (bedx+14<x2) then inc(bedx); if specialkey(ctrl or lshift) and (bedx>=1) then dec(bedx); if specialkey(ctrl or rshift) and (bedx+14<x2) then inc(bedx); if specialkey(Alt) then begin repeat until not specialkey(alt); writexy(20,10,'An Alt de tiep tuc '); repeat until specialkey(alt); repeat until not specialkey(alt); writexy(20,10,' '); drawegg; end; if (Eggy=14*3) then begin if abs(-BedX-4+Eggx)<4 then inc(Mark) else inc(Lost); writexy(Eggx+4,18,#32); end; delay(0); end; end; gotoxy(20,7); write('So diem dat duoc: ',mark); gotoxy(20,10); write('So trung bi rot: ',lost); gotoxy(20,13); write('An Shift+Alt de tiep tuc, Ctrl+Alt de thoat'); repeat until specialKey(lshift+alt) or specialkey(ctrl+alt) or specialkey(rshift+alt); until specialkey(Alt+Ctrl); end. program uptowin; uses crt; const dong=5; tocdo=1000; var memory:array[1 dong]of word; vt:shortint;thua,Qexit:boolean;x,y,z:word;{x,y,z la bien nhap} dem,key:byte;c:char; {_} function wall(a:word;b:byte):boolean; begin b:=16-b; if odd(a shr (b)) then wall:=true else wall:=false; end; {_} procedure vekhung(x1,y1,x2,y2:word); var z,a,b:word; begin if (x1<>x2) and (y1<>y2) then begin a:=wherex; b:=wherey; if x1>x2 then begin z:=x1; x1:=x2; x2:=z; end; if y1>y2 then begin z:=y1; y1:=y2; y2:=z; end; gotoxy(x1,y1); write(#201); if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205); gotoxy(x2,y1); write(#187); gotoxy(x1,y2); write(#200); if x2-x1>1 then for z:=1 to x2-x1-1 do write(#205); gotoxy(x2,y2); write(#188); if y2-y1>1 then for z:=1 to y2-y1-1 do begin gotoxy(x1,z+y1); write(#186); end; if y2-y1>1 then for z:=1 to y2-y1-1 do begin gotoxy(x2,z+y1); write(#186); end; end; gotoxy(a,b); end; function rand:word; var a:word;b,c:byte; begin b:=random(14)+1; for c:=1 to b do a:=a+ 1 shl (c-1); a:=a shl random(14); rand:=not a; if (a=0) or (not a=0) then a:=rand; end; {_} procedure run(x:boolean); var e:byte; {\} procedure traiphai(var a:word); var d:boolean; begin if odd(dem+e) then begin if a>maxint then begin d:=true; a:=a-maxint-1; end else d:=false; a:=a shl 1; if d then a:=a+1; if (wall(memory[1],vt)) then vt:=vt-1; end else begin if odd(a) then begin a:=a-1; d:=true; end else d:=false; a:=a shr 1; if d then a:=a+maxint+1; if (wall(memory[1],vt)) then vt:=vt+1; end; end; {/} begin for e:=1 to dong do if x and odd(e) then traiphai(memory[e]) else if not x and not odd(e)then traiphai(memory[e]); end; {_} procedure draw; var x,y:byte; {\} procedure help; begin textcolor(white); vekhung(51,5,70,22); vekhung(8,5,25,22); textcolor(yellow); gotoxy(54,8);write(' W : Up'); gotoxy(54,11);write(' A : Left'); gotoxy(54,14);write(' D : Right'); gotoxy(54,17);write(' Space : Pause'); gotoxy(54,20);write(' Esc : Exit'); vekhung(54,7,58,9); vekhung(54,10,58,12); vekhung(54,13,58,15); vekhung(54,16,62,18); vekhung(54,19,60,21); gotoxy(9,6); write('Go up each floor'); gotoxy(9,7); write(', you will add 1'); gotoxy(9,8); write('bonus. But must'); gotoxy(9,9); write('not passing wall'); gotoxy(11,10); write('Example:'); gotoxy(11,12); write('Can''t go up:'); gotoxy(12,13);write(#219#32#219#219#32#219); gotoxy(12,14);write(#205#205#205#205#205#205); gotoxy(12,15);write(' ',#15,' '); gotoxy(12,17);write('Can go up:'); gotoxy(12,18);write(#219#32#219#219#32#219); gotoxy(12,19);write(#205#205#205#205#205#205); gotoxy(12,20);write(' ',#15,' '); end; {/} begin clrscr; textcolor(white); vekhung(20,1,60,3); gotoxy(30,2); write('*** GO UP TO WIN! ***'); vekhung(28,5,47,22); textcolor(yellow); gotoxy(30,7); writeln(#205#205#205#205#205#205#205#205, #205#205#205#205#205#205#205#205); for x:=dong downto 1 do begin gotoxy(30,8+(dong-x)*2); for y:=1 to 16 do if memory[x] shl (y-1)>maxint-1 then write(#219) else write(' '); writeln; gotoxy(30,8+(dong-x)*2+1); writeln(#205#205#205, #205#205#205#205#205#205#205, #205#205#205#205#205#205); end; help; gotoxy(30,20); write('Lines:',dem,' Key:',key,'/50'); gotoxy(vt+29,16); write(#15); end; procedure pause; begin clrscr; vekhung(15,10,65,15); gotoxy(18,13); write(' Paused! Press any key to continue '); readkey; end; procedure thuchon; begin{+3} c:=readkey; case upcase(c) of{+4} 'D':if not wall(memory[1],vt+1) then vt:=vt+1; 'A':if not wall(memory[1],vt-1) then vt:=vt-1; 'W':if not wall(memory[2],vt) then begin{+5} dem:=dem+1; for z:= 1 to dong-1 do memory[z]:=memory[z+1]; memory[dong]:=rand; end;{-5} ' ': pause; #27:begin qexit:=true; thua:=true; end; end;{-4} if upcase(c) in['D','A','W'] then begin key:=key+1; draw; end; if key=50 then thua:=true; end;{-3} {____Main Program____} begin textbackground(blue); textcolor(yellow); clrscr; randomize; vekhung(15,10,65,15); gotoxy(18,13); write('Press any key to continue '); repeat x:=random(1); until keypressed; window(1,1,80,25); repeat key:=0;thua:=false;Qexit:=false; vt:=8;x:=0;clrscr; for x:=2 to dong do memory[x]:=rand; repeat{+0} draw; for x:=0 to 1000 do begin{+1} if x=0 then run(true); if x=500 then run(false); for y:=0 to tocdo do begin{+2} if keypressed then thuchon; if not (vt in[1 16]) then begin thua:=true; break; end; end;{-2} end;{-1} until thua; gotoxy(1,4); for x:= 1 to 80*21 do begin write(' '); for y:=1 to 1000 do for z:=1 to 600 do; end; textcolor(white); vekhung(15,11,65,15); gotoxy(30,11); write(' Infomation '); textcolor(yellow); gotoxy(19,12); write('Score: ',dem); if not qexit then write(' You are lost!'); gotoxy(19,13); write('Press Enter or Esc to quit!'); gotoxy(19,14); write('Press Space to replay!'); repeat c:=readkey; until c in [#27,#13,#32]; until c in [#27,#13]; end. program GameXepHinh; uses graph,crt; var c,c1:char; x,y:shortint;dem,rd,z:word; lp,lp2:byte; {lp2:dong,lp:cot} mau,maux:array[1 4,1 4]of shortint; Gd,Gm: Integer; {____} function mu(c,e:integer):integer; var l1:integer;n:integer; begin n:=1; if e>0 then for l1:=1 to e do n:=n*c; mu:=n; end; {____} procedure writedem(x,y:word); var a,b:word;d:integer; begin b:=dem; for d:=4 downto 0 do begin a:=b div (mu(10,d)); case a of 0: outtextxy(x+(4-d)*10,y,'0'); 1: outtextxy(x+(4-d)*10,y,'1'); 2: outtextxy(x+(4-d)*10,y,'2'); 3: outtextxy(x+(4-d)*10,y,'3'); 4: outtextxy(x+(4-d)*10,y,'4'); 5: outtextxy(x+(4-d)*10,y,'5'); 6: outtextxy(x+(4-d)*10,y,'6'); 7: outtextxy(x+(4-d)*10,y,'7'); 8: outtextxy(x+(4-d)*10,y,'8'); 9: outtextxy(x+(4-d)*10,y,'9'); 10: outtextxy(x+(4-d)*10,y,'10'); end; b:=b mod mu(10,d); end; end; procedure hcn(x1,y1,x2,y2,mausac:word); var loop:word; begin setcolor(mausac); rectangle(x1,y1,x2,y2); for loop:=1 to y2-y1 do line(x1,y1+loop,x2,y1+loop); end; {_____} procedure draw; begin for lp:=1to 4do for lp2:=1 to 4 do hcn(50*(lp+7),50*(lp2),50*(lp+8),50*(lp2+1),maux[lp,lp2]); setcolor(15); rectangle(400,50,600,250); hcn(40+240,270,120+240,330,lightgray); setcolor(white); writedem(55+240,295); rectangle(45+240,275,115+240,325); end; {____} procedure duoi; var tmp:shortint; begin if y>1 then begin tmp:=maux[x,y]; maux[x,y]:=maux[x,y-1]; maux[x,y-1]:=tmp; dem:=dem+1; y:=y-1; end; end; {____} procedure tren; var tmp:shortint; begin if y<4 then begin tmp:=maux[x,y]; maux[x,y]:=maux[x,y+1]; maux[x,y+1]:=tmp; dem:=dem+1; y:=y+1; end; end; procedure phai; var tmp:shortint; begin if x>1 then begin tmp:=maux[x,y]; maux[x,y]:=maux[x-1,y]; maux[x-1,y]:=tmp; dem:=dem+1; x:=x-1; end; end; {____} procedure trai; var tmp:shortint; begin if x<4 then begin tmp:=maux[x,y]; maux[x,y]:=maux[x+1,y]; maux[x+1,y]:=tmp; dem:=dem+1; x:=x+1; end; end; {ct chinh} begin Gd := Detect; InitGraph(Gd, Gm,' '); if GraphResult <> grOk then Halt(1); repeat cleardevice; dem:=0; {random} randomize; hcn(95,75,500,125,lightgray); setcolor(white); rectangle(100,80,495,120); Outtextxy(100,100,' Nhan phim Enter de tiep tuc'); repeat rd:=random(1000)+1; until keypressed; readln; cleardevice; {ve ket qua} for lp:=1to 4do for lp2:=1 to 4 do begin mau[lp,lp2]:=(lp-1)*4+(lp2); mau[4,4]:=0; hcn(50*(lp),50*(lp2),50*(lp+1),50*(lp2+1),mau[lp,lp2]); end; x:=4;y:=4; {x:cot,y:dong} setcolor(15); rectangle(50,50,250,250); {to vien} {gan maux = mau} for lp:=1 to 4 do for lp2:= 1 to 4 do maux[lp,lp2]:=mau[lp,lp2]; {luat choi} OutTextXY(100,400,'Luat choi:'); OutTextXY(100,420,'Ban hay an cac phim mui ten de xep hinh.'); OutTextXY(105,430,'- : Len tren'); OutTextXY(105,440,'- : Xuong duoi'); OutTextXY(105,450,'- : Sang trai'); OutTextXY(105,460,'- : Sang phai'); OutTextXY(105,470,'- Esc : Thoat'); outtextxy(120,430,#24); outtextxy(120,440,#25); outtextxy(120,450,#26); outtextxy(120,460,#27); [...]... 8>=x1) and (getmousex div 8=y1) and (getmousey div 80) and (y1>0) and (x1 . Code EggCrt. PAS: program EggCrt; {=Can doc=} {! Khong Compile duoc bang Free Pascal !} uses crt,dos; const x1=5;y1=4;x2=77;y2=18; rShift=1;