VCT làm trò chơi bằng turbo pascal, DOTs nha

1 câu trả lời

 Program Caro;
 uses crt;
 const
      SizeMax = 10;
      Trong = ' ';
      Cham = '*';
      Ngang = '-';
      Doc = '|';
      CX = 'X';  { Nguoi choi }
      CO = 'O';  { May tinh }
 var
    Banco,BancoAo: array[1..SizeMax*2+2,1..SizeMax*2+2] of char;
    x,y: integer;
    Luot,Choilai: char;
    SoX,SoO: integer;
    An: Boolean;
    Size: integer;
    CheDo: string[2];
 Procedure TaobanCo;
 var x,y: integer;
 Begin
      TextColor(LightGray);
      for x := 1 to Size*2 do
          for y := 1 to Size*2 do
          begin
               Banco[x,y] := Trong;
               if (x mod 2 = 0) and (y mod 2 = 0) then
               begin
                    Gotoxy(x,y);
                    Write(Cham);
                    Banco[x,y] := Cham;
               end;
          end;
 End;
 Procedure InDiem;
 Begin
      TextColor(LightGray);
      Gotoxy(2,Size*2+2);Write('Ban:      May Tinh:');
      TextColor(Red);
      Gotoxy(7,Size*2+2);Write(CX);
      TextColor(Blue);
      Gotoxy(22,Size*2+2);Write(CO);
      TextColor(Brown);
      Gotoxy(2,Size*2+4);
      clreol;
      Write('Ban: ',SoX);
      Gotoxy(12,Size*2+4);
      Write('May tinh: ',SoO);
 End;
 Procedure DoiLuot;
 Begin
      if Luot = CX then Luot := CO else Luot := CX;
 End;
 Procedure KiemTra;
 var x,y: integer;
 Begin
      an := False;
      for x := 2 to Size*2-1 do
          for y := 2 to Size*2-1 do
          begin
               if (Banco[x-1,y] = Doc) and (Banco[x+1,y] = Doc)
               and (Banco[x,y-1] = Ngang) and (Banco[x,y+1] = Ngang)
               and (Banco[x,y] = Trong) then
               begin
                    Gotoxy(x,y);
                    if Luot = CX then textColor(Red) else TextColor(Blue);
                    Write(Luot);
                    Banco[x,y] := Luot;
                    An := True;
                    if Luot = CX then inc(SoX) else Inc(SoO);
               end;
          end;
      if An then DoiLuot;
 End;
 Procedure DanhCo(dx,dy: integer);
 Begin
      TextColor(LightGray);
      if (Banco[dx,dy] = Trong) and (Banco[dx-1,dy] = Cham)
      and (Banco[dx+1,dy] = Cham) then
      begin
           Gotoxy(dx,dy); Write(Ngang);
           Banco[dx,dy] := Ngang;
           KiemTra;
           DoiLuot;
           x := dx;
           y := dy;
      end
      else
      if (Banco[dx,dy] = Trong) and (Banco[dx,dy-1] = Cham)
      and (Banco[dx,dy+1] = Cham) then
      begin
           Gotoxy(dx,dy); Write(Doc);
           BanCo[dx,dy] := Doc;
           KiemTra;
           DoiLuot;
           x := dx;
           y := dy;
      end;
 End;
 Procedure DanhCoAo(dx,dy: integer);
 Begin
      if (BancoAo[dx,dy] = Trong) and (BancoAo[dx-1,dy] = Cham)
      and (BancoAo[dx+1,dy] = Cham) then
      begin
           BancoAo[dx,dy] := Ngang;
      end
      else
      if (BancoAo[dx,dy] = Trong) and (BancoAo[dx,dy-1] = Cham)
      and (BancoAo[dx,dy+1] = Cham) then
      begin
           BanCoAo[dx,dy] := Doc;
      end;
 End;
 Function KiemTraAo: integer;
 var x,y,kt: integer;
 Begin
      Kt := 0;
      for x := 2 to Size*2 do
          for y := 2 to Size*2 do
          begin
               if (BancoAo[x,y] = Trong) and (BancoAo[x-1,y] = Doc)
               and (BancoAo[x+1,y] = Doc) and (BancoAo[x,y-1] = Ngang)
               and (BancoAo[x,y+1] = Ngang) then inc(kt);
          end;
      KiemTraAo := kt;
 End;
 Function BiAn(x,y: integer): Boolean;
 var so: integer;
 Begin
      so := 0;
      if Banco[x,y] = Trong then
      begin
      if BanCoAo[x-1,y] = Doc then inc(so);
      if BanCoAo[x+1,y] = Doc then inc(so);
      if BanCoAo[x,y-1] = Ngang then inc(so);
      if BanCoAo[x,y+1] = Ngang then inc(so);
      end;
      if so = 3 then Bian := True
      else Bian := False;
 End;
 Procedure ResetBanCoAo;
 Begin
      for x := 2 to Size*2 do
          for y := 2 to Size*2 do
          BancoAo[x,y] := BanCo[x,y];
 End;
 Function PhongThu: integer;
 var x,y,so,max: integer;
 Begin
      max := 0;
      x := 1;
      while x <= Size*2 do
      begin
          inc(x);
          y := 1;
          while y <= Size*2 do
          begin
          inc(y);
          if (BancoAo[x,y] = Trong) and ((x+y) mod 2 <> 0) then
          begin
               DanhCoAo(x,y);
               So := KiemTraAo;
               if So > max then
               begin
                    Max := so;
                    x := 1;
                    y := 1;
               end
               else BanCoAo[x,y] := Trong;
          end;
          end;
      end;
      PhongThu := Max;
 End;
 Procedure AI;
 var x,y,min,max,so,lx,ly: integer;
 Begin
      repeat
      Textcolor(white);
      Gotoxy(Size*2 + 5,3);Write('Dang suy nghi....');
      Delay(500);
      Min := SizeMax*SizeMax;
      Max := 0;
      lx := 0;
      ResetBanCoAo;
      for x := Size*2 downto 2 do
          for y := Size*2 downto 2 do
          if (BancoAo[x,y] = Trong) and ((x + y) mod 2 <> 0) then
          begin
               DanhCoAo(x,y);
               So := KiemTraAo;
               if (So = 0) and
               (Bian(x-1,y) or Bian(x+1,y) or Bian(x,y-1) or Bian(x,y+1))
               then So := Max - 1;
               if So >= Max then
               begin
                    Max := So;
                    lx := x;
                    ly := y;
               end;
               BanCoAo[x,y] := Trong;
          end;
      case Chedo[1] of
      '1': if max = 0 then
      repeat
            lx := 2+Random(Size*2-1);
            ly := 2+Random(Size*2-1);
      until (Banco[lx,ly] = Trong) and ((lx + ly) mod 2 <> 0);
      '2':
      if lx = 0 then
      begin
      for x := Size*2 downto 2 do
          for y := Size*2 downto 2 do
          if (BancoAo[x,y] = Trong) and ((x + y) mod 2 <> 0) then
          begin
               ResetBanCoAo;
               DanhCoAo(x,y);
               So := PhongThu;
               if So <= Min then
               begin
                    Min := So;
                    lx := x;
                    ly := y;
               end;
          end;
      end
      else if max = 0 then
      repeat
            ResetBanCoAo;
            lx := 2+Random(Size*2-1);
            ly := 2+Random(Size*2-1);
            DanhCoAo(lx,ly);
            So := 0;
            if Bian(lx-1,ly) or Bian(lx+1,ly) or Bian(lx,ly-1) or
            Bian(lx,ly+1) then So := -1;
            Gotoxy( 60,10);Write(So);
      until (Banco[lx,ly] = Trong) and ((lx + ly) mod 2 <> 0) and (So = 0);
                 end;
          Gotoxy(60,10);Write(lx,' ',ly);
          DanhCo(lx,ly);
          InDiem;
          Gotoxy(Size*2 + 5,3);clreol;
      until (Luot = CX) or (SoX + SoO = sqr(Size - 1));
 End;
 Procedure Dichuyen;
 var k: char;
 var dem: byte;
 Begin
      x := 2;
      y := 2;
      repeat
            k := #0;
            if keypressed then k := readkey;
            case k of
            #75: if x > 2 then inc(x,-1);
            #77: if x < Size*2 then inc(x,1);
            #72: if y > 2 then inc(y,-1);
            #80: if y < Size*2 then inc(y,1);
            #13: begin DanhCo(x,y);if Luot = CO then AI;InDiem; end;
                   end;
            Gotoxy(x,y);
      until (k =#27) or (SoX+SoO = sqr(Size - 1));
      if k <> #27 then
      begin
           TextColor(LightRed);
           Gotoxy(10,5);
           if SoX > SoO then
            begin
             textcolor (yellow);
             repeat
              clrscr;
              delay (200);
              write ('C');
              delay (100);
              write ('O');
              delay (100);
              write ('N');
              delay (100);
              write ('G');
              delay (100);
              write ('R');
              delay (100);
              write ('A');
              delay (100);
              write ('T');
              delay (100);
              write ('U');
              delay (100);
              write ('L');
              delay (100);
              write ('A');
              delay (100);
              write ('T');
              delay (100);
              write ('I');
              delay (100);
              write ('O');
              delay (100);
              writeln ('N');
              delay (300);
             until keypressed;
             clrscr;
              textcolor (green+blink);
              writeln ('CONGRATULATION !!!');
             textcolor (yellow);
             writeln ('YOU WIN');
             readln;
            end
           else if SoO > SoX then
            begin
             clrscr;
             writeln ('YOU LOSE !!!');
             if (SoO-SoX=1) or (SoO-SoX=2) or (SoO-SoX=3) then writeln ('Rang xiu nua la thang roi :(');
            end
           else if SoO = SoX then
            begin
             clrscr;
             textcolor (lightgreen);
             write('khong thang cung khong thua = hoa !!!  -_-');
            end;
           repeat until readkey = #13;
      end;
 End;
 BEGIN
      Randomize;
      repeat
      repeat
      clrscr;
      TextColor(White);
      Write('Chon kich thuoc choi (1x1..',SizeMax,'x',SizeMax,'): '); Readln(Size);
      until (Size in [1..SizeMax]);
      clrscr;
      repeat
      clrscr;
      Writeln('Chon che do: ');
      Writeln('     [1].De');
      Writeln('     [2].Kho');
      Write  ('     ');
      readln(Chedo);
      until (Chedo = '1') or (Chedo = '2');
      clrscr;
      inc(Size);
      InDiem;
      Taobanco;
      SoO := 0;
      SoX := SoO;
      Luot := CX;
      Dichuyen;
      clrscr;
      TextColor(White);
      Write('Ban co muon choi lai khong (k = khong): ');
      repeat until Keypressed;
      Choilai := Readkey;
      until Choilai = 'k';
 END.

không có lỗi nào nhé, turbo pascal !!!

Câu hỏi trong lớp Xem thêm