Game Bằng Pascal - Class92

Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009
WELCOME TO CLASS92 FORUM >> Đăng nhập : Bạn đã có tài khoản ở forum click vào để gõ ID và password. >> Đăng ký : Bạn chưa có tài khoản ở forum, đăng ký 1 tài khoản để tham gia thảo luận. =========================================== ^^ CHÚC BẠN MỘT NGÀY VUI VẺ ^^
Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009
WELCOME TO CLASS92 FORUM >> Đăng nhập : Bạn đã có tài khoản ở forum click vào để gõ ID và password. >> Đăng ký : Bạn chưa có tài khoản ở forum, đăng ký 1 tài khoản để tham gia thảo luận. =========================================== ^^ CHÚC BẠN MỘT NGÀY VUI VẺ ^^
Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009
Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.
Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009
PortalTrang ChínhGalleryLatest imagesĐăng kýĐăng Nhập
Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009 :: Tin học (Computers study)
 Game bằng pascal Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down 
Tác giả Thông điệp
Dark_phoenix Chủ tịch Chủ tịchDark_phoenix Nữ Tổng số bài gửi : 390 Age : 31 Đến từ (Location) : 1 nơi nào đó trên Trái Đất Job/hobbies : Nhìu lém Tâm trạng : Game bằng pascal Ngu10 Năng lượng : 34 Điểm thưởng : 1 Registration date : 03/03/2008 Game bằng pascal Vide
Bài gửiTiêu đề: Game bằng pascal   Game bằng pascal Icon_minitimeTue Aug 12, 2008 10:59 am
Audition Offline bằng Pascal: Code: Program ve_duong_tu_dong;uses crt,graph;typediem = recordt_d:byte;x: integer;y:integer;end;varn,i,j,gd,gm,x1,x2,y1,y2,l,m:integer;a:array[1..100] of diem;b,a1,c,b1:array[1..100] of integer;fv:text;procedure linenn(x1,y1,x2,y2:integer); { ve duong }beginsetcolor(9);setlinestyle(0,0,3);settextstyle(4,0,1);line(x1,y1,x2,y2); moveto(x2,y2);moverel(-5,5); linerel(5,-5);moverel(-5,-5);linerel(5,5);delay(4000);end;procedure nhap_diem;beginwrite('nhap vao cac diem can ve(m< 23 vi file co 23 diem) m= '); readln(m);for i:=1 to m dobeginwrite('b1[',i,']='); readln(b1[i]);end;end;Procedure mang_diem;Beginassign(fv,'d:\nut.txt');reset(fv);readln(fv,n);beginj:=0;while not(seekeof(fv)) dobeginj:=j+1;readln(fv,a1[j],b[j],c[j]);a[j].t_d:=a1[j];a[j].x:=b[j];a[j].y:=c[j];end;end;close(fv);End;Begingd:=detect;nhap_diem;initgraph(gd,gm,'');If GraphResult <> GrOk ThenHalt(1);setbkcolor(white);setcolor(red);mang_diem;i:=1;while i< m dobeginj:=i+1;linenn(a[b1[i]].x,a[b1[i]].y,a[b1[j]].x,a[b1[j]].y);i:=j;end;readln;closegraph;End. Caro : Code: uses crt;constedge=0; us=1; them=2; none=3;gridsize=15;maxmoves=200;alphabet=96;null=' ';typesquares=edge..none;smallint=0..gridsize;byte=0..255;cardinal=0..65535;line=array[0..9] of squares;vargrid: array[1..gridsize,1..gridsize] of squares;name: array[squares] of char;icol, irow: array[1..4] of -1..1;play: packed array[1..maxmoves] of recordrowfield, colfield: smallint;end;v, vals: array[1..4] of integer;i,j,r,c: smallint;onboard: set of smallint;move: cardinal;endgame: squares;yourturn: boolean;topvalue: integer;response: char; Rắn săn mồi: Code: program ranbo;uses crt,dos;typeTPoint=recordx,y:byte;end;ran=array[1..100] of TPoint; {tôi khai báo lai cho d? coi}varconran:ran;x,y, x1,y1, l, huong :byte;tocdo, diem :integer;kt :char; {k0 dùng}ranchet :boolean;{-------------------------------------------------------}procedure setcusor(bot,top:byte);varregs:registers;beginregs.ah:=1; regs.ch:=bot; regs.cl:=top;intr($10,regs);end;{-------------------------------------------------------}procedure ngaunhien;beginx1:=random(30)+5; y1:=random(20)+2;kt:=chr(random(25)+65);gotoxy(x1,y1); write(kt);end;{-------------------------------------------------------}procedure vekhung;varj:byte;beginclrscr;textcolor(white);gotoxy(1,1);for j:=1 to 40 do write(#177);gotoxy(1,24);for j:=1 to 40 do write(#177);for j:=2 to 24 dobegingotoxy(1,j); write(#177);gotoxy(40,j);write(#177);end;gotoxy(8,24);textcolor(lightred);writeln('Nhap phim Esc de thoat');end;{-------------------------------------------------------}procedure ranchay;var rk:char;beginif keypressed then {neu an co an phim thi}beginrk:=readkey; {b?n thi?u} {d?c xem phím nào v?a b?m}if rk=#27 then halt(1); {neu la esc thoat}if rk=#0 then rk:=readkey; {neu la phim dieu khien(control key), d?c lai de lay ma}huong:=ord(rk);end;case huong of80: inc(y);72: dec(y);77: inc(x);75: dec(x);end;if (y=1) or(y=24) or(x=40) or(x=1) then ranchet:=true;end;{-------------------------------------------------------}procedure init;varj:byte;beginrandomize;textmode(co40);tocdo:=200;diem:=0;vekhung;l:=3;x:=10;y:=10;huong:=0; {+ nen khoi tao huong}for j:=1 to l+1 dobeginconran[j].x:=30+j; conran[j].y:=10;end;ngaunhien;setcusor(32,3);ranchet:=false;end;{-------------------------------------------------------}procedure thuchien;vari:byte;begininit;i:=4;repeatranchay;dec(i);gotoxy(conran[i].x,conran[i].y);write(' ');conran[i].x:=x; conran[i].y:=y;textcolor(lightred);gotoxy(4,1);write(' DIEM ',diem);if (diem>0) and ( diem mod 200=0) thenbegindiem:=diem+50;gotoxy(6,12);textcolor(white);textbackground(red);writeln('KHA LAM ! = MOI BAN TIEP TUC');repeat until keypressed;textbackground(0);clrscr;vekhung;if tocdo>=100 then tocdo:=tocdo-50;if diem>=400 then l:=3;i:=l;end;if (x=x1) and (y=y1) thenbeginl:=l+1; ngaunhien;diem:=diem+10;end;gotoxy(x1,y1);write(kt);textcolor(lightcyan);gotoxy(conran[i].x,conran[i].y);write(#219);if i=1 then i:=l+1;delay(tocdo);until ranchet;gotoxy(15,11); write(' BAN DA THUA ');gotoxy(5,12);write(' Nhan phim bat ki de choi tiep ');end;{-------------------------------------------------------}BEGINrepeatclrscr;thuchien;kt:=readkey;until kt=#27;clrscr;END.
Về Đầu Trang Go down
https://class92.yoo7.com
Dark_phoenix Chủ tịch Chủ tịchDark_phoenix Nữ Tổng số bài gửi : 390 Age : 31 Đến từ (Location) : 1 nơi nào đó trên Trái Đất Job/hobbies : Nhìu lém Tâm trạng : Game bằng pascal Ngu10 Năng lượng : 34 Điểm thưởng : 1 Registration date : 03/03/2008 Game bằng pascal Vide
Bài gửiTiêu đề: Re: Game bằng pascal   Game bằng pascal Icon_minitimeTue Aug 12, 2008 11:01 am
Trò bắn ô vuông: Code: {$G+}constvga:word=$a000;type tbullet=array[0..1] of byte; {2 places for x,y coords, row and collom}{yeah, i do records too, but this is easier for 'me' to follow}label newgame; {been easier to 0 score, but i was doing other stuff}varbullet:tbullet;x,y:integer; {bullet coords}virscr:pointer;score:integer;fofs,fseg,Vaddr,px,py:word;pbtimer,cenergy,penergy,range,cx,cy:integer;cxd,cyd:shortint;{ mouse routines ----------------------------------------------------------- }function mouseinstalled:boolean; assembler; asmxor ax,ax; int 33h; cmp ax,-1; je @skip; xor al,al; @skip: end;function getmousex:word; assembler; asmmov ax,3; int 33h; mov ax,cx end;function getmousey:word; assembler; asmmov ax,3; int 33h; mov ax,dx end;function leftpressed:boolean; assembler; asmmov ax,3; int 33h; and bx,1; mov ax,bx end;function rightpressed:boolean; assembler; asmmov ax,3; int 33h; and bx,2; mov ax,bx end;procedure mousesensetivity(x,y:word); assembler; asmmov ax,1ah; mov bx,x; mov cx,y; xor dx,dx; int 33h end;{ video related routines --------------------------------------------------- }procedure getfont; assembler; asmmov ax,1130h; mov bh,1; int 10h; mov fseg,es; mov fofs,bp; end;procedure writetxt(x,y:word; txt:string; where:word; col:byte);var i,j,k:byte;beginfor i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 doif ((mem[fseg:fofs+ord(txt[i])*8+j] shl k) and 128) <> 0 thenmem[where:(y+j)*320+(i*8)+x+k]:=col;end;procedure Cls(where:word; col:byte);beginfillchar(mem[where:0],64000,col);end;procedure flip(src,dst:word); assembler; asmpush ds; mov ds,[src]; xor si,si; mov es,[dst]xor di,di; mov cx,320*200/2; rep movsw; pop ds; end;procedure putpixel(x,y:word; c:byte ); assembler; asmmov es,[Vaddr]; mov ax,[y]; shl ax,6; mov di,ax; shl ax,2add di,ax; add di,[x]; mov al,[c]; mov [es:di],al; end;{ shit starts --------------------------------------------------------- }procedure moveplayer;var i:word;beginpx:=getmousex shr 1; py:=getmousey;if px<4 then px:=4 else if px>316 then px:=316;py:=160;if leftpressed then begini:=0; {goes here, resets with ea keypress}if (i<1) and (y=0) then begin inc(i);x:=px; {load bullet coords}y:=py;end;end;end;procedure movebullets;var a:word;beginfor a:=0 to 1 do {why?}if y>0 then begin {y starts at 160, from where players gun is, (x)}dec(y,4); {4 seems to be the magic number}if y=0 then begin {off screen?, then killem}x:=0; y:=0; dec(penergy,4);end;end;if penergy<-1 then begin {get the last shot}writetxt(90,96,' GAME OVER !',vga,1);writetxt(84,116,'click right to replay',vga,15);writetxt(84,126,' press esc to exit',vga,15);end;end;procedure movetarget;var i:word; rx,ry,difx,dify,big:integer;begindec(range);if range<0 then beginrange:=random(100);case random(8) of0:begin cxd:=-1; cyd:=-1; end;1:begin cxd:=0; cyd:=-1; end;2:begin cxd:=1; cyd:=-1; end;3:begin cxd:=1; cyd:=0; end;4:begin cxd:=1; cyd:=1; end;5:begin cxd:=0; cyd:=1; end;6:begin cxd:=-1; cyd:=1; end;7:begin cxd:=-1; cyd:=0; end;end;end;inc(cx,cxd);inc(cy,cyd);if cx<4 then begin cx:=4; range:=0; endelse if cx>304 then begin cx:=304; range:=0; end;if cy<0 then begin cy:=0; range:=0; endelse if cy>100 then begin cy:=100; range:=0; end;end;procedure reset;beginfillchar(bullet,sizeof(bullet),0);cx:=4+random(304); cy:=random(84);range:=0;score:=0;cenergy:=100;penergy:=100;end;procedure checkall;var i:word; dx,dy:integer;begini:=0; { player bullets hit target } if penergy>-1 then beginwhile (i<1) and (x>0) do begindx:=(cx-x)+16; {target area}dy:=(cy-y)+16;if (dx >=0) and (dx <=16) and {start the goofy math!??}(dy >=0) and (dy <=8) then begin {hit target?}inc(score,10);if (dx >=3) and (dx <=12) and(dy >=0) and (dy <=8) then begin {hit target 2nd row?}inc(score,10);if (dx >=6) and (dx <=9) and(dy >=0) and (dy <=8) then begin {hit target center?}inc(score,10);{ rigging here, only way i could make it work right? why?}dec(cenergy,4);if cenergy<0 then beginwritetxt(90,96,'aint this a piece of shit',vga,1);repeat until 5<4;end; end;end; end;inc(i);end;end; end;{ draw all stuff to screen ------------------------------------------------- }procedure drawall;var scorestr:string; lcbx,lcby,i,a,b:word;begin{ player }putpixel(px,py,15);putpixel(px-1,py+1,7);putpixel(px+1,py+1,7);putpixel(px-2,py+2,8);putpixel(px+2,py+2,8);{ target , yeah, i even drew this from the center out, got the same results}for a:=0 to 15 dofor b:=0 to 15 doputpixel(cx+a,cy+b,4);for a:=3 to 12 dofor b:=3 to 12 doputpixel(cx+a,cy+b,3);for a:=6 to 9 dofor b:=6 to 9 doputpixel(cx+a,cy+b,5);{ player bullets }for i:=0 to 1 doif x>0 then beginputpixel(x,y-2,15);putpixel(x,y-1,4);putpixel(x,y,4);end;{ score }str(score,scorestr);writetxt(10,190,scorestr,Vaddr,15);{ penergy-bar }for i:=199 downto (199-penergy) do beginputpixel(1,i,8);putpixel(2,i,14);putpixel(3,i,8);end;while (port[$3da] and 8) <> 0 do;while (port[$3da] and 8) = 0 do;flip(Vaddr,vga);end;{ main --------------------------------------------------------------------- }var i,j:word;beginif not mouseinstalled then begin writeln('Needs mouse!'); halt; end;mousesensetivity(30,30);asm mov ax,13h; int 10h; end;getfont; {this has to go here, after setmode}getmem(virscr,64000); Vaddr:=seg(virscr^);newgame:reset;repeatcls(Vaddr,9);drawall;moveplayer;movetarget; {take this out, and see where i got the crappy math}movebullets;checkall;if rightpressed then Goto newgame; {pure shit, huh?}until port[$60]=1;freemem(virscr,64000);asm mov ax,3; int 10h; end;end. Cách chơi:Vì là Sưu tầm nên không thể giải thích thêm bất kỳ điều gì về lỗi nhé.Audition:Các bạn đánh như dấu mũi tên rồi chờ thanh chạy đến chỗ ô vuông màu đặt trước thì bấm Spacebar là xong một màn. Cẩn thận gặp 1 mũi tên màu đỏ không được bấm mũi tên đó.CaroCác bạn biết chơi rồi nhỉ. 5 con là được.Rắn săn mồi:Dễ quá. Không đụng đuôi và đụng tường. Càng lên lv càng đi nhanh đó. Cẩn thận.Bắn tàu:Di chuyển bằng chuột qua lại. Bấm chuột trái để bắn. Spacebar chơi lại. Khi bắn ô vuông sẽ có điểm. Ô to:.. Ô nhỏ... Ô nhỏ nhất... Không nhớ điểm. Nhớ là có số đạn quy định đó.Nguồn : cuncon4rum
Về Đầu Trang Go down
https://class92.yoo7.com

Thông điệp:

****************Hãy cùng chia sẻ với bạn bè bằng cách ****************

Copy đường link dưới đây gửi đến nick yahoo bạn bè!

Game bằng pascal-https://class92.yoo7.com/t297-topic Gửi cho bạn bè tin này dùm mình nha ( an tâm là không có virus đâu )
Game bằng pascal Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang 
Trang 1 trong tổng số 1 trang
Permissions in this forum: Bạn không có quyền trả lời bài viết
Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009 :: Tin học (Computers study) -
 

Từ khóa » Code Pascal Rắn Săn Mồi