- 14 Tháng năm 2017
- 3,974
- 7,619
- 744
- 21
- Phú Yên
- Trường THPT Lương Văn Chánh
Chắc suất Đại học top - Giữ chỗ ngay!! ĐĂNG BÀI NGAY để cùng trao đổi với các thành viên siêu nhiệt tình & dễ thương trên diễn đàn.
Game đã được viết lại hoàn toàn thay thế phiên bản cũ nha
Link Code cũ nha https://diendan.hocmai.vn/threads/game-danh-bai-bang-pascal.617171/
Demo cho thèm chơi nè:
Link Code cũ nha https://diendan.hocmai.vn/threads/game-danh-bai-bang-pascal.617171/
Mã:
Program danh_bai;
uses crt,dos;
const may = 1;nguoi = 2;
QB: array[1..13] of string[2] = ('A','2','3','4','5','6','7','8','9','10',
'J','Q','K');
CQB: array[1..4] of char = (#6,#5,#4,#3);
type Tbai = record
gtri: integer;
chat: integer;
end;
TNGuoiChoi = object
NC: integer;
diem: integer;
soqbai: integer;
Qbai: array[1..5] of TBai;
Procedure RutBai;
Procedure TinhDiem;
Function Xilat: Boolean;
Function Xivang: Boolean;
end;
TMenu = object
Procedure TaoNutBam;
Procedure Batdau;
Procedure HuongDan;
Procedure Menu;
end;
var
bai: array[1..10] of Tbai;
NC: array[1..2] of TNguoiChoi;
sobai: integer;
Ketthuc: Boolean;
Menu: TMenu;
procedure setcusor(bot,top: byte);
var regs : registers;
begin
regs.ah :=1;
regs.ch:=bot;
regs.cl:=top;
intr($10,regs);
end;
function mousex:word;assembler;asm
mov ax,3; int 33h; mov ax,cx end;
function mousey:word;assembler;asm
mov ax,3; int 33h; mov ax,dx end;
function leftclick:boolean;assembler;asm
mov ax,3; int 33h; and bx,1; mov ax,bx end;
function MouseArea(x1,y1,x2,y2:word):boolean;
begin
if (LeftClick)
and (mousex div 8 + 1 >=x1)
and (mousex div 8 + 1 <=x2)
and (mousey div 8 + 1 >=y1)
and (mousey div 8 + 1 <=y2)
then mousearea:=true
else mousearea:=false;
end;
Function InitMouse : boolean;
var r: registers;
Begin
r.ax:=$00;intr($33,r);
if r.ax<>0 then InitMouse:=true
else InitMouse:=false;
End;
Procedure ShowMouse;
Var r: registers;
begin
r.ax:=$01;intr($33,r);
End;
Procedure HideMouse;
Var r:registers;
Begin
r.ax:=$002;
intr($33,r);
End;
Procedure TaoNutBam;
Begin
{Nut ket thuc}
TextColor(black);
Gotoxy(40,6);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(40,7);Write('³ ³');
Gotoxy(40,8);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(44,7);TextColor(Brown);
write('THEM BAI');
{Nut ket thuc}
TextColor(black);
Gotoxy(40,10);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(40,11);Write('³ ³');
Gotoxy(40,12);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(44,11);TextColor(Red);
write('KET THUC');
{Nut menu}
TextColor(black);
Gotoxy(40,14);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(40,15);Write('³ ³');
Gotoxy(40,16);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(46,15);TextColor(Blue);
write('MENU');
{Nut choi lai}
TextColor(black);
Gotoxy(60,10);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(60,11);Write('³ ³');
Gotoxy(60,12);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(64,11);TextColor(Green);
write('CHOI LAI');
End;
Procedure KhoiTao;
var i,j: integer;
Begin
for j := 1 to 10 do
begin
bai[j].gtri := 0;
bai[j].chat := 0;
end;
for i := 1 to 2 do
begin
NC[i].Diem := 0;
NC[i].Soqbai := 0;
NC[i].nc := i;
end;
sobai := 0;
KetThuc := False;
TaoNutBam;
ShowMouse;
End;
Function TrungLap(gt,ch,so: integer): Boolean;
var i: integer;
ex: Boolean;
Begin
ex := False;
for i := 1 to 10 do
if i <> so then
if (bai[i].gtri = gt) and (bai[i].chat = ch) then
ex := True;
TrungLap := ex;
End;
Procedure XocBai;
var i: integer;
Begin
for i := 1 to 10 do
begin
repeat
bai[i].gtri := 1 + random(12);
bai[i].chat := 1 + random(3);
until not Trunglap(bai[i].gtri,bai[i].chat,i);
end;
End;
Procedure VeBai(x,y: integer;gtri,chat: string;mat: string);
Begin
Textcolor(White);
gotoxy(x,y);
write('ÚÄÄÄÄ¿');
gotoxy(x,y+1);
write('³ÛÛÛÛ³');
gotoxy(x,y+2);
write('³ÛÛÛÛ³');
gotoxy(x,y+3);
write('³ÛÛÛÛ³');
gotoxy(x,y+4);
write('ÀÄÄÄÄÙ');
TextColor(Black);
gotoxy(x+2,y+2);write(gtri);
if (CQB[3] = chat) or (CQB[4] = chat) then TextColor(Red) else TextColor(Blue);
write(chat);
if mat = 'sau' then
begin
textcolor(LightRed);
gotoxy(x+1,y+1);
write('²²²²');
gotoxy(x+1,y+2);
write('²²²²');
gotoxy(x+1,y+3);
write('²²²²');
end;
End;
Procedure TNguoiChoi.RutBai;
Begin
inc(sobai);
inc(Soqbai);
QBai[soqbai] := Bai[sobai];
if QBai[soqbai].Gtri > 10 then inc(diem,10)
else
Inc(diem,QBai[soqbai].Gtri);
if nc = nguoi then
VeBai(Soqbai*6,20,QB[QBai[soqbai].Gtri],CQB[QBai[soqbai].Chat],'truoc')
else
VeBai(Soqbai*6,1,'','','sau');
End;
Function TNguoiChoi.Xilat: Boolean;
Begin
if (diem = 11) and ((QBai[1].gtri = 1) or (QBai[2].Gtri = 1)) then
Xilat := True
else Xilat := False;
End;
Function TNguoiChoi.Xivang: Boolean;
Begin
if Diem = 2 then Xivang := True
else Xivang := False;
End;
Procedure TNguoiChoi.TinhDiem;
Begin
if diem > 21 then diem := 0
else
if (Soqbai = 5) then diem := 100
else
if Xilat then diem := 100
else
if Xivang then diem := 150;
End;
Procedure Chiabai;
var i,j: integer;
Begin
HideMouse;
textcolor(Black);
gotoxy(20,12);Write('Dang chia bai...');
for j := 1 to 2 do
for i := 1 to 2 do
begin
Delay(500);
NC[i].RutBai;
Delay(500);
end;
gotoxy(20,12);Write(' ');
textcolor(Black);
gotoxy(15,12);Write('Luot rut bai cua ban...');
ShowMouse;
End;
Procedure ThongBao;
Begin
TextColor(Red);
gotoxy(20,12);
if NC[nguoi].diem = NC[may].diem then write('Ban va toi hoa!')
else
if NC[nguoi].diem < NC[may].diem then write('Ban thua roi!')
else Write('Ban thang roi!');
KetThuc := True;
End;
Procedure KhuiBai;
var i: integer;
Begin
gotoxy(15,12);Write(' ');
Textcolor(Black);
gotoxy(20,12);Write('Dang khui bai...');
for i := 1 to NC[May].Soqbai do
begin
VeBai(i*6,1,QB[NC[may].QBai[i].Gtri],
CQB[NC[may].QBai[i].Chat],'truoc');
Delay(1000);
end;
NC[nguoi].Tinhdiem;
NC[may].TinhDiem;
gotoxy(20,12);Write(' ');
ThongBao;
End;
Procedure May_ThemBai;
var kt: Boolean;
Begin
{Khi bam nut Ket thuc}
if Mousearea(41,11,55,11) and
((NC[nguoi].Diem >= 15) or (NC[nguoi].Soqbai = 5)) and not KetThuc then
begin
HideMouse;
kt := false;
repeat
textcolor(Black);
gotoxy(15,12);Write('Luot rut bai cua may...');
if NC[nguoi].diem > 21 then
begin
while (NC[may].diem < 15) and (NC[may].Soqbai < 5) do
begin
NC[may].Rutbai;
delay(1000);
end;
kt := true;
end
else
begin
while (NC[may].diem < NC[nguoi].diem)
and (NC[may].Soqbai < 5) do
begin
NC[may].Rutbai;
delay(1000);
end;
kt := true;
end;
until kt;
Khuibai;
InitMouse;
ShowMouse;
end;
if NC[may].Xilat or NC[may].Xivang then
begin
HideMouse;
KhuiBai;
InitMouse;
ShowMouse;
end;
End;
Procedure ThemBai;
Begin
if MouseArea(41,7,55,7) and (NC[nguoi].Soqbai < 5)
and not NC[nguoi].Xivang and not NC[nguoi].Xilat then
begin
HideMouse;
NC[nguoi].RutBai;
InitMouse;
ShowMouse;
end;
End;
Procedure ChoiMoi;
Begin
HideMouse;
clrscr;
ShowMouse;
SetCusor(32,0);
InitMouse;
Randomize;
KhoiTao;
XocBai;
ChiaBai;
End;
Procedure TMenu.TaoNutBam;
Begin
HideMouse;
{Nut bat dau}
TextColor(black);
Gotoxy(20,8);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(20,9);Write('³ ³');
Gotoxy(20,10);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(24,9);TextColor(Brown);
write('BAT DAU');
{Nut huong dan}
TextColor(black);
Gotoxy(20,12);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(20,13);Write('³ ³');
Gotoxy(20,14);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(24,13);TextColor(Red);
write('HUONG DAN');
{Nut thoat}
TextColor(black);
Gotoxy(20,16);Write('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Gotoxy(20,17);Write('³ ³');
Gotoxy(20,18);Write('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Gotoxy(26,17);TextColor(Blue);
write('THOAT');
ShowMouse;
End;
Procedure TMenu.batdau;
Begin
Choimoi;
repeat
Thembai;
May_thembai;
if MouseArea(61,11,75,11) then ChoiMoi;
until Mousearea(41,15,55,15) {Click nut menu};
Menu;
End;
Procedure TMenu.HuongDan;
Begin
HideMouse;
clrscr;
textcolor(Black);
Gotoxy(5,2);write('Ban co the rut toi da 5 la bai, so diem se duoc tinh');
writeln(' bang tong so diem cua');
writeln(' cac la bai. ');
writeln(' Thang thua duoc tinh nhu sau: ');
writeln(' Xi vang > Xi lat = Di linh > diem binh thuong > vach');
writeln(' Voi: ');
writeln(' Xi vang = A + A');
writeln(' Xi lat = A + 10 ( hoac J,Q,K)');
writeln(' Di linh = 5 la co tong diem <= 21');
writeln(' Diem binh thuong la diem >= 15 va <= 21');
writeln(' Vach la diem > 21');
Textcolor(Red + Blink);
Write(' Bam phim bat ky (khac ESC) de thoat...');
Showmouse;
repeat
until Keypressed and (readkey <> #27);
Menu;
End;
Procedure TMenu.Menu;
Begin
Hidemouse;
TextBackGround(Cyan);
clrscr;
TaoNutBam;
InitMouse;
textcolor(2);
Gotoxy(30,2);Write('GAME DANH BAI BANG PASCAL');
Textcolor(Blue);
Gotoxy(10,7);write('M E N U');
ShowMouse;
repeat
if Mousearea(21,9,35,9) then Batdau;
if Mousearea(21,13,35,13) then HuongDan;
until mousearea(21,17,35,17) or (keypressed and (readkey = #27));
End;
BEGIN
clrscr;
SetCusor(32,0);
KhoiTao;
Menu.Menu;
END.
Demo cho thèm chơi nè: