Xin chào mừng các bạn đã đến với thế giới dành cho cộng Teen - Victory Zone Forum !
Xin mời các bạn đăng kí để làm thành viên của diễn đàn , chúng tôi đảm bảo : Thời gian đăng kí chưa đầy 1 phút !
Nếu đã có tài khoản , xin vui lòng đăng nhập !
Lưu Ý *: Những tài khoản trong vòng 1 tháng mà không hoạt động sẽ bị xóa ngày lập tức !Chúng tôi khuyến cáo nên dùng 2 trình duyệt là Google Chrome hoặc Mozila FireFox , khi dùng các trình duyệt khác , có thể các lỗi nhỏ sẽ xảy ra !
Xin chân thành cảm ơn !
Victory Family Zone Forum
Xin chào mừng các bạn đã đến với thế giới dành cho cộng Teen - Victory Zone Forum !
Xin mời các bạn đăng kí để làm thành viên của diễn đàn , chúng tôi đảm bảo : Thời gian đăng kí chưa đầy 1 phút !
Nếu đã có tài khoản , xin vui lòng đăng nhập !
Lưu Ý *: Những tài khoản trong vòng 1 tháng mà không hoạt động sẽ bị xóa ngày lập tức !Chúng tôi khuyến cáo nên dùng 2 trình duyệt là Google Chrome hoặc Mozila FireFox , khi dùng các trình duyệt khác , có thể các lỗi nhỏ sẽ xảy ra !
Xin chân thành cảm ơn !
Victory Family Zone Forum
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.
Đây là một chương trình Pas rất hay : Game kim cương
Code:
program Bejeweled; uses crt; const xSt=4; ySt=2; var m:array[1..8,0..8] of shortint; x,y,z:byte; preMark,mark:word; x1s,y1s,x2s,y2s,xP,yP:byte; timebegin,timepause:longint; level:byte;
procedure writexy(x,y:byte;c:string); begin gotoxy(x,y); write(c); 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 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 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;
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 down; var z:byte; begin for x:=8 downto 1 do for y:=8 downto 1 do while m[x,y]<0 do begin m[x,0]:=random(7)+9; for z:=y downto 1 do m[x,z]:=m[x,z-1]; end; end; function Del:byte; var count:byte; begin count:=0; {row} for x:=1 to 6 do for y:=1 to 8 do begin if (abs(m[x,y])=abs(m[x+1,y])) and (abs(m[x,y])=abs(m[x+2,y])) then begin m[x,y]:=-abs(m[x,y]); m[x+1,y]:=-abs(m[x+1,y]); m[x+2,y]:=-abs(m[x+2,y]); inc(count); end; end; {Columns} for x:=1 to 8 do for y:=1 to 6 do begin if (abs(m[x,y])=abs(m[x,y+1])) and (abs(m[x,y])=abs(m[x,y+2])) then begin m[x,y]:=-abs(m[x,y]); m[x,y+1]:=-abs(m[x,y+1]); m[x,y+2]:=-abs(m[x,y+2]); inc(count); end; end; del:=count; end; procedure rand; begin for x:=1 to 8 do for y:=1 to 8 do m[x,y]:=random(7)+9; repeat down; until del=0; end; procedure init; begin randomize; textmode(co80); textcolor(white); clrscr; x:=30; writexy(x,11,#75#32#32#75#32#73#32#69#69#69#69#32#78#32#32#78); writexy(x,12,#75#32#75#32#32#73#32#69#32#32#32#32#78#78#32#78); writexy(x,13,#75#75#32#32#32#73#32#69#69#69#32#32#78#32#78#78); writexy(x,14,#75#32#75#32#32#73#32#69#32#32#32#32#78#32#32#78); writexy(x,15,#75#32#75#32#32#73#32#69#69#69#69#32#78#32#32#78); writexy(x,16,#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45#45); writexy(x,17,#67#32#79#32#73#32#95#32#49#32#57#32#57#32#55#32); writexy(x,5,#66#32#69#32#74#32#69#32#87#32#69#32#76#32#69#32#68); 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); textcolor(lightgray); writexy(x,22,#76#32#79#32#65#32#68#32#73#32#78#32#71); textcolor(yellow); gotoxy(x,22); write(#76#32);delay(100); write(#79#32);delay(100); write(#65#32);delay(100); write(#68#32);delay(100); write(#73#32);delay(100); write(#78#32);delay(100); write(#71);delay(100); textcolor(white); writexy(x,22,' S T A R T'); vekhung(x-5,20,x+18,24); while not mouseRange(x-5,20,x+19,24) or not leftpressed do m[1,1]:=random(100); rand; end; function x0S:byte; begin x0s:=(GetMouseXcrt-xSt+3)div 4; end; function y0S:byte; begin y0s:=(GetMouseycrt-ySt+3)div 3; end;
procedure draw; begin for x:=1 to 8 do for y:=1 to 8 do begin if m[x,y]<0 then begin textcolor(black); textbackground(black); end else begin if (x=x1S) and (y=y1S) or (x=x2S) and (y=y2S) or (x=xP) and (y=yP) then begin textbackground(m[x,y]-8); textcolor(m[x,y]); end else begin textcolor(m[x,y]-8); textbackground(black); end; writexy(x*4-3+xSt,y*3-3+ySt,#220#220#220); writexy(x*4-3+xSt,y*3-2+ySt,#219#219#219); writexy(x*4-3+xSt,y*3-1+ySt,#223#223#223); end; end; end; procedure time; begin x:=15+mark*2; dec(x,trunc((meml[0:$46C] - timebegin)/18.2)); if x>30 then x:=30; case x of 01..10: begin textcolor(lightred); textbackground(red); end; 11..20: begin textcolor(yellow); textbackground(brown); end; 21..30: begin textcolor(lightgreen); textbackground(green); end; end; for z:=1 to x do writexy(41+z,4,#219); write(' ':30-x+1); gotoxy(45,8); write(mark*100+premark*100); textbackground(black); write('':10); end; procedure GetSelected; begin if leftpressed then begin if abs(xP-x1S)+abs(yP-y1S)=1 then begin x2S:=xP; y2S:=yP; end else begin x1S:=xP; y1S:=yP; x2S:=0; y2s:=0; end; end else begin x1S:=0; x2S:=0; y1S:=0;y2S:=0; end; end; procedure swap(x1,y1,x2,y2:byte); var z:shortint; begin z:=m[x1,y1]; m[x1,y1]:=m[x2,y2]; m[x2,y2]:=z; end; procedure pause; begin textcolor(white); textbackground(black); writexy(43,12,'CONTINUE '); repeat until not leftpressed; timepause:=meml[0:$46C]; repeat until leftpressed and mouserange(40,10,55,12); writexy(43,12,'P A U S E'); timepause:=meml[0:$46C]-timepause; timebegin:=timebegin+timepause; end; procedure last(status:string); begin textbackground(black); textcolor(lightred); for x:=1 to 8*3 do writexy(xst,yst+x-1,' '); writexy(10,10,status); gotoxy(10,12); write('Your score : ',mark+premark:5,'00'); vekhung(8,14,32,16); writexy(12,15,'P l a y A g a i n'); writexy(17,18,'or'); vekhung(8,20,32,22); writexy(12,21,' E X I T '); repeat if mouserange(8,19,32,21) and leftpressed then halt; if mouserange(8,13,32,15) and leftpressed then level:=0; until level=0; mark:=0; for x:=1 to 8 do for y:=1 to 8 do begin writexy(x*4-3+xSt,y*3-3+ySt,#32#32#32#32); writexy(x*4-3+xSt,y*3-2+ySt,#32#32#32#32); writexy(x*4-3+xSt,y*3-1+ySt,#32#32#32#32); end; end; procedure next; begin textbackground(black); for x:=1 to 8*3 do writexy(xst,yst+x-1,' '); writexy(5,8,'C O N G R A T U L A T I O N S ! '); writexy(5,10,'You can come to next level now!'); gotoxy(5,12); write('Your score : ',mark+premark:5,'00'); vekhung(8,14,32,16); writexy(12,15,'N E X T L E V E L'); writexy(17,18,'or'); vekhung(8,20,32,22); writexy(12,21,' E X I T '); repeat if mouserange(8,19,32,21) and leftpressed then halt; until mouserange(8,13,32,15) and leftpressed; preMark:=mark+premark; mark:=0; rand; level:=0; end; BEGIN init; level:=0; repeat inc(level); textcolor(white); textbackground(black); clrscr; for z:=2 to 25 do begin writexy(xSt+33,z,#186); writexy(xSt-1,z,#186); end; writexy(xSt+5,1,#66#32#69#32#74#32#69#32#87#32#69#32#76#32#69#32#68); vekhung(40,3,75,5); writexy(43,3,' Time Trial '); vekhung(40,7,75,9); writexy(43,7,' Score '); vekhung(40,11,55,13); writexy(43,12,'P A U S E'); vekhung(60,11,75,13); writexy(63,12,'E X I T'); vekhung(40,15,55,17); writexy(43,16,' M I X '); vekhung(60,15,75,17); writexy(63,16,'RE - PLAY'); timebegin := meml[0:$46C]; repeat if leftpressed then begin if mouserange(40,10,55,12) then pause else if mouserange(60,10,75,12) then halt else if mouserange(40,14,55,16) then rand else if mouserange(60,14,75,16) then begin last('You played again!'); level:=1; timebegin := meml[0:$46C]; end else getselected; end; xP:=x0S; yP:=y0s; repeat until not leftpressed; if x2s>0 then begin swap(x1S,y1S,x2S,y2S); delay(100); z:=del; draw; delay(100);if z=0 then swap(x1S,y1S,x2S,y2S) else begin mark:=mark+z; down; repeat z:=del; draw; delay(100); mark:=mark+z; down; until z=0; end; x1s:=0; x2s:=0; y1s:=0; y2s:=0; end; draw; repeat time; until leftpressed or (xP<>x0S) or (yP<>y0s) or (meml[0:$46C] - timebegin > (15+mark*2)*18.2) or ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29); until (meml[0:$46C] - timebegin > (15+mark*2)*18.2) or ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29); if ((15+mark*2)-(trunc((meml[0:$46C] - timebegin)/18.2))>29) then next else last('You are lost!'); until level>0; END.
file Download sẽ Up cho các bạn sau :D
bậy giờ mình chỉ cách chạy nó : Cách 1 : Chạy = file tự tạo : b1: Các bạn chạy Notepad b2: Copy cái code mình đưa bỏ vào b3: Lưu với đuôi .pas trong thư mục Pascal mà mình cài đặt b4: Mở chương trình pascal và mở file mìh đã tạo b5: Run và chạy b6: Khi đã chạy dc thì Chương trình pas sẽ tự tạo 1 số file có như sau: tên bạn đã đặt.pas ; tên bạn đã đặt .bak ; bạn hãy chọn 1 file để chạy ; file đó có hình vuông để chạy ! b7 :chạy file và cảm nhận
Tất cả các thắc mắt xin liên hệ nick Y!:ducduyvippr0 Thân !