Tin học Game đánh bài viết bằng Pascal

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH
Thành viên
14 Tháng năm 2017
3,974
7,619
744
21
Phú Yên
Trường THPT Lương Văn Chánh
[TẶNG BẠN] TRỌN BỘ Bí kíp học tốt 08 môn
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/
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è:
upload_2019-1-3_21-36-57.png
 

trà nguyễn hữu nghĩa

Cựu Mod Vật Lí |Cây bút Thơ|Thần tượng VH
Thành viên
14 Tháng năm 2017
3,974
7,619
744
21
Phú Yên
Trường THPT Lương Văn Chánh
game xì zách (xì lác nếu là miền trung) nha mn đã test và win :v
Game này mình viết code kiểu như là cho máy biết được bài của mình rồi, nhưng rút bài vẫn là ngẫu nhiên nha, nên cho dù có chút gian lận thì nó vẫn đảm bảo có lúc thắng lúc thua nha
 
Top Bottom