| Lớp 9/2 trường THCS Trưng Vương niên khóa 2008-2009
|
|
|
Tác giả |
Thông điệp |
Dark_phoenix
Chủ tịch
Tổng số bài gửi : 390
Age : 29
Đến từ (Location) : 1 nơi nào đó trên Trái Đất
Job/hobbies : Nhìu lém
Tâm trạng :
Năng lượng : 34
Điểm thưởng : 1
Registration date : 03/03/2008
|
Tiêu đề: Game bằng pascal Tue Aug 12, 2008 10:59 am |
|
|
Audition Offline bằng Pascal: - Code:
-
Program ve_duong_tu_dong; uses crt,graph; type diem = record t_d:byte; x: integer; y:integer; end; var n,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 } begin setcolor(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; begin write('nhap vao cac diem can ve(m< 23 vi file co 23 diem) m= '); readln(m); for i:=1 to m do begin write('b1[',i,']='); readln(b1[i]); end; end; Procedure mang_diem; Begin assign(fv,'d:\nut.txt'); reset(fv); readln(fv,n); begin j:=0; while not(seekeof(fv)) do begin j:=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; Begin gd:=detect; nhap_diem; initgraph(gd,gm,''); If GraphResult <> GrOk Then Halt(1); setbkcolor(white); setcolor(red); mang_diem; i:=1; while i< m do begin j:=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; const edge=0; us=1; them=2; none=3; gridsize=15; maxmoves=200; alphabet=96; null=' '; type squares=edge..none; smallint=0..gridsize; byte=0..255; cardinal=0..65535; line=array[0..9] of squares; var grid: 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 record rowfield, 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; type TPoint=record x,y:byte; end;
ran=array[1..100] of TPoint; {tôi khai báo lai cho d? coi}
var conran:ran; x,y, x1,y1, l, huong :byte; tocdo, diem :integer; kt :char; {k0 dùng} ranchet :boolean; {-------------------------------------------------------} procedure setcusor(bot,top:byte); var regs:registers; begin regs.ah:=1; regs.ch:=bot; regs.cl:=top; intr($10,regs); end; {-------------------------------------------------------} procedure ngaunhien; begin x1:=random(30)+5; y1:=random(20)+2; kt:=chr(random(25)+65); gotoxy(x1,y1); write(kt); end; {-------------------------------------------------------} procedure vekhung; var j:byte; begin clrscr; 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 do begin gotoxy(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; begin if keypressed then {neu an co an phim thi} begin rk:=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 of 80: 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; var j:byte; begin randomize; 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 do begin conran[j].x:=30+j; conran[j].y:=10; end;
ngaunhien; setcusor(32,3); ranchet:=false; end; {-------------------------------------------------------} procedure thuchien; var i:byte; begin init; i:=4; repeat ranchay; 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) then begin diem:=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) then begin l:=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;
{-------------------------------------------------------} BEGIN repeat clrscr; thuchien; kt:=readkey; until kt=#27; clrscr; END.
|
|
|
|
Dark_phoenix
Chủ tịch
Tổng số bài gửi : 390
Age : 29
Đến từ (Location) : 1 nơi nào đó trên Trái Đất
Job/hobbies : Nhìu lém
Tâm trạng :
Năng lượng : 34
Điểm thưởng : 1
Registration date : 03/03/2008
|
Tiêu đề: Re: Game bằng pascal Tue Aug 12, 2008 11:01 am |
|
|
Trò bắn ô vuông: - Code:
-
{$G+}
const vga: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} var bullet: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; 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;
{ video related routines --------------------------------------------------- }
procedure getfont; assembler; asm mov 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; begin for i:=1 to length(txt) do for j:=0 to 7 do for k:=0 to 7 do if ((mem[fseg:fofs+ord(txt[i])*8+j] shl k) and 128) <> 0 then mem[where:(y+j)*320+(i*8)+x+k]:=col; end;
procedure Cls(where:word; col:byte); begin fillchar(mem[where:0],64000,col); end;
procedure flip(src,dst:word); assembler; asm push 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; asm mov es,[Vaddr]; mov ax,[y]; shl ax,6; mov di,ax; shl ax,2 add di,ax; add di,[x]; mov al,[c]; mov [es:di],al; end;
{ shit starts --------------------------------------------------------- }
procedure moveplayer; var i:word; begin px:=getmousex shr 1; py:=getmousey; if px<4 then px:=4 else if px>316 then px:=316; py:=160; if leftpressed then begin i:=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; begin for 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; begin dec(range); if range<0 then begin range:=random(100); case random(8) of 0: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; end else if cx>304 then begin cx:=304; range:=0; end; if cy<0 then begin cy:=0; range:=0; end else if cy>100 then begin cy:=100; range:=0; end; end;
procedure reset; begin fillchar(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; begin i:=0; { player bullets hit target } if penergy>-1 then begin while (i<1) and (x>0) do begin dx:=(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 begin writetxt(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 do for b:=0 to 15 do putpixel(cx+a,cy+b,4); for a:=3 to 12 do for b:=3 to 12 do putpixel(cx+a,cy+b,3); for a:=6 to 9 do for b:=6 to 9 do putpixel(cx+a,cy+b,5);
{ player bullets } for i:=0 to 1 do if x>0 then begin putpixel(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 begin putpixel(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; begin if 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; repeat cls(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 đó.
Caro Cá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
|
|
|
|
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è!
|
|
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
|
|
|
|
|
|
|