Trang chủ Tin Học Lớp 12 VCT làm trò chơi bằng turbo pascal, DOTs nha câu...

VCT làm trò chơi bằng turbo pascal, DOTs nha câu hỏi 1533825 - hoctapsgk.com

Câu hỏi :

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

Lời giải 1 :

 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 !!!

Thảo luận

-- mình chơi thử rồi hay

Bạn có biết?

Tin học, tiếng Anh: informatics, tiếng Pháp: informatique, là một ngành khoa học chuyên nghiên cứu quá trình tự động hóa việc tổ chức, lưu trữ, xử lý và truyền dẫn thông tin của một hệ thống máy tính cụ thể hoặc trừu tượng (ảo). Với cách hiểu hiện nay, tin học bao hàm tất cả các nghiên cứu và kỹ thuật có liên quan đến việc mô phỏng, biến đổi và tái tạo thông tin.

Nguồn : Wikipedia - Bách khoa toàn thư

Tâm sự 12

Lớp 12 - Năm cuối ở cấp tiểu học, năm học quan trọng nhất trong đời học sinh trải qua bao năm học tập, bao nhiêu kì vọng của người thân xung quanh ta. Những nỗi lo về thi đại học và định hướng tương lai thật là nặng. Hãy tin vào bản thân là mình sẽ làm được rồi tương lai mới chờ đợi các em!

Nguồn : ADMIN :))

Copyright © 2021 HOCTAP247