Hướng dẫn lập trình game bằng pascal năm 2024

CodeLearn is an online platform that helps users to learn, practice coding skills and join the online coding contests.

Links

Learning

Training

Fights

Information

About Us

Terms of Use

Help

Help

Discussion

Powered by CodeLearn © 2024. All Rights Reserved. rev 2/5/2024 5:31:56 PM

Đây là code rất đơn giản cho trò chơi giống flappy bird do mình không sử dụng unit graph nên nhìn hơi xâu .

PROGRAM Flappy; USES CRT; VAR TREN,DUOI,L,tangXDT,tangYDT,tangXNV : BYTE ; XDT,YDT,XNV,F ,DIEM0,DIEM ,TGROI : INTEGER; TEN :STRING; _FILE :TEXT;

procedure TAOCNV(cot,tren,duoi : integer ) ; {-HAM NAY DE TAO CHUONG NGAI VAT.- }

var i: integer;

begin for i := 1 to tren do begin gotoxy(cot,i) ; write(

25) ;

end;

for i:= 21-duoi to 21 do begin gotoxy(cot,i) ; write(

24);

end; end;

procedure VIETDT(x,y: integer); {HAM NAY DUNG DE TAO DOI TUONG.2 BIEN LA TOA DO CUA DOI TUONG-} uses crt,dos; {//vn.myblog.yahoo.com/kien_coi_1997} type quan=(k,xeD,maD,tuongD,hauD,vuaD,totD, xeT,maT,tuongT,hauT,vuaT,totT); nguoi=(Trang,Den); mType=array[1..8,1..8]of quan; his=record xh1,yh1,xh2,yh2:0..8; Old:quan;dirh:0..3; end; const xStart=2; yStart=1; Player:nguoi=trang; {den:darkgray;trang:white} New:mType= ((xeT,MaT,TuongT,HauT,VuaT,TuongT,MaT,XeT) ,(totT,totT,totT,totT,totT,totT,totT,totT) ,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k) ,(k,k,k,k,k,k,k,k),(k,k,k,k,k,k,k,k) ,(totD,totD,totD,totD,totD,totD,totD,totD) ,(xeD,MaD,TuongD,HauD,VuaD,TuongD,MaD,XeD)); function mouseinstalled:boolean; assembler; asm xor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end; function getmousex:word; assembler; asm mov ax,3; int 33h; mov ax,cx end; function getmousey:word; assembler; asm mov ax,3; int 33h; mov ax,dx end; function leftpressed:boolean; assembler; asm mov ax,3; int 33h; and bx,1; mov ax,bx end; function rightpressed:boolean; assembler; asm mov ax,3; int 33h; and bx,2; mov ax,bx end; procedure mousesensetivity(x,y:word); assembler; asm mov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end; function mouserange(x1,y1,x2,y2:word):boolean; begin if (getmousex div 8>=x1) and (getmousex div 8<=x2) and (getmousey div 8>=y1) and (getmousey div 8<=y2) then mouserange:=true else mouserange:=false; end; function getmousexcrt:word; begin getmousexcrt:=trunc(getmousex/8+1); end; function getmouseycrt:word; begin getmouseycrt:=trunc(getmousey/8+1); 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 RangeMouse(x1,y1,x2,y2:word); var regs:registers; begin Regs.AX:=7; Regs.CX:=x1; Regs.DX:=x2; Intr($33,Regs); Regs.AX:=8; Regs.CX:=y1; Regs.DX:=y2; Intr($33,Regs); end; var x1,y1,x2,y2:byte; xMove1,yMove1,xMove2,yMove2:byte; Moving:boolean;c:char; History:array[1..4]of his; dir:0..3;m:mtype; function Lawful(x1,y1,x2,y2:byte):boolean; var z:quan; function NotBlock(x1,y1,x2,y2:byte):boolean; var c,d:byte; begin NotBlock:=true;c:=0;d:=0; if m[x2,y2]=k then d:=1; if (x1>x2)and(y1=y2) then begin c:=x1; x1:=x2; x2:=c; end; if (y1>y2)and(x1=x2) then begin c:=y1; y1:=y2; y2:=c; end; if x1=x2 then begin for c:= y1 to y2 do if m[x1,c]<>k then d:=d+1; end; if y1=y2 then begin for c:= x1 to x2 do if m[c,y1]<>k then d:=d+1; end; if abs(x2-x1)=abs(y2-y1) then begin if x1<x2 then for c:= x1 to x2 do begin if y1<y2 then if m[c,c+y1-x1]<>k then d:=d+1; if y1>y2 then if m[c,x2+y2-c]<>k then d:=d+1; end; if x1>x2 then for c:= x2 to x1 do begin if y1<y2 if m[c,x2+y2-c]<>k then d:=d+1; if y1>y2 then if m[c,c+y2-x2]<>k then d:=d+1; end; end; if d>2then notblock:=false; end; begin z:=m[x1,y1]; textbackground(black); gotoxy(68,7); write(' '); gotoxy(75,5); write(' '); if ((m[x1,y1]in[xeD..totD])and(m[x2,y2]in[xeT..totT]) or (m[x1,y1]in[xeT..totT])and(m[x2,y2]in[xeD..totD]) or (m[x2,y2]=k)) and ((x1<>x2)or(y1<>y2)) then case z of xeT,xeD: Lawful:=((x1=x2)xor(y1=y2))and NotBlock(x1,y1,x2,y2); maT,maD: lawful:=(abs(x1-x2)+abs(y1-y2)=3)and(x1<>x2)and(y1<>y2); tuongT,tuongD: Lawful:=(abs(x2-x1)=abs(y2-y1))and NotBlock(x1,y1,x2,y2); hauT,hauD: Lawful:=(((x1=x2)or(y1=y2))or(abs(x2-x1)=abs(y2-y1))) and NotBlock(x1,y1,x2,y2); vuaT,vuaD: Lawful:=(abs(x2-x1)<2)and(abs(y2-y1)<2) and((x1<>x2)or(y1<>y2)); totT: Lawful:=(((dir=0)and(x2-x1=1)and(y1=y2) or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k) or (x2-x1=2)and(x1=2)and(y1=y2)) or ((dir=1)and(y2-y1=1)and(x1=x2) or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (y2-y1=2)and(y1=2)and(x1=x2)) or ((dir=2)and(x1-x2=1)and(y1=y2) or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (x1-x2=2)and(x1=7)and( y1=y2)) or ((dir=3)and(y1-y2=1)and(x1=x2) or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (y1-y2=2)and(y1=7)and(x1=x2))) and notblock(x1,y1,x2,y2); totD: Lawful:=(((dir=2)and(x2-x1=1)and(y1=y2) or (x2-x1=1)and(abs(y1-y2)=1)and(m[x2,y2]<>k) or (x2-x1=2)and(x1=2)and(y1=y2)) or ((dir=3)and(y2-y1=1)and(x1=x2) or (y2-y1=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (y2-y1=2)and(y1=2)and(x1=x2)) or ((dir=0)and(x1-x2=1)and(y1=y2) or (x1-x2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (x1-x2=2)and(x1=7)and(y1=y2)) or ((dir=1)and(y1-y2=1)and(x1=x2) or (y1-y2=1)and(abs(x1-x2)=1)and(m[x2,y2]<>k) or (y1-y2=2)and(y1=7)and(x1=x2))) and notblock(x1,y1,x2,y2); end else begin Lawful:=false; gotoxy(68,7);textcolor(lightred);textbackground(Red); write('!QuanCungMau'); end; if not notblock(x1,y1,x2,y2) then begin gotoxy(75,5);textcolor(lightred); textbackground(Red);write('! Can'); end; end; procedure clearCell(x,y,z:byte); begin if z =0 then if odd(x+y) then textcolor(black) else textcolor(lightgray) else textcolor(z); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 219, # 219, # 219, # 219, # 219, # 219, # 219, # 219); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 219, # 219, # 219, # 219, # 219, # 219, # 219, # 219); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 219, # 219, # 219, # 219, # 219, # 219, # 219, # 219); textcolor(white); end; procedure qXe(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 32, # 219, # 32, # 219, # 32, # 219, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 32, # 32, # 178, # 178, # 178, # 32, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 219, # 219, # 219, # 219, # 219, # 32, # 32); end; procedure qMa(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 32, # 222, # 223, # 219, # 220, # 32, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 32, # 32, # 222, # 219, # 219, # 221, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 32, # 219, # 219, # 219, # 219, # 32, # 32); end; procedure qTot(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 32, # 32, # 32, # 32, # 254, # 32, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 32, # 32, # 32, # 40, # 42, # 41, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 32, # 220, # 219, # 219, # 219, # 220, # 32); end; procedure qTuong(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 32, # 32, # 32, # 234, # 32, # 32, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 32, # 32, # 222, # 254, # 221, # 32, # 32, # 32); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 220, # 219, # 219, # 219, # 220, # 32, # 32); end; procedure qVua(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 32, # 47, # 92, # 32, # 42, # 32, # 47, # 92); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 32, # 92, # 32, # 221, # 254, # 222, # 32, # 47); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 32, # 219, # 219, # 42, # 219, # 219, # 32); end; procedure qHau(x,y,z,b:byte); begin textcolor(z); if b>0 then textbackground(b) else if odd(x+y+1) then textbackground(white) else textbackground(black); gotoxy(x*8-8+xStart,y*3-3+yStart); write( # 95, # 46, # 61, # 42, # 42, # 61, # 46, # 95); gotoxy(x*8-8+xStart,y*3-3+yStart+1); write( # 92, # 92, # 30, # 30, # 30, # 30, # 47, # 47); gotoxy(x*8-8+xStart,y*3-3+yStart+2); write( # 32, # 176, # 177, # 178, # 178, # 177, # 176, # 32); end;

Chủ đề