C помощью знаков «*» нарисовать 2 фигуры близнецов — Pascal(Паскаль)

uses crt;

type
  fig = array [1 .. 3, 1 .. 3] of char;

const
  f1: fig = (('*', '*', '*'), ('*', '*', '*'), ('*', '*', '*'));
  f2: fig = (('/', '-', '\'), ('|', '+', '|'), ('|', '-', '/'));

procedure Draw(var a: fig; x, y: byte);
var
  i, j: byte;
begin
  for i := 1 to 3 do
  begin
    gotoXY(x, y + i - 1);
    for j := 1 to 3 do
      write(a[i, j]);
  end;
end;

var
  x, y: byte;
  k: integer;

begin
  clrscr;
  x := 1;
  y := 12;
  k := 0;
  repeat
    while (x < 76) and not keypressed do
    begin
      x := x + 3;
      k := k + 1;
      if odd(k) then
        Draw(f1, x, y)
      else
        Draw(f2, x, y);
      delay(500);
      clrscr;
    end;
    while (x > 3) and not keypressed do
    begin
      x := x - 3;
      k := k + 1;
      if odd(k) then
        Draw(f1, x, y)
      else
        Draw(f2, x, y);
      delay(500);
      clrscr;
    end;
  until keypressed;
  writeln('Программа завершена, нажмите Enter.');
  readln

end.
program m1;

uses crt;

type
  mas = array [1 .. 34] of string;

var
  a: mas;
  i, j, k: integer;

begin
  textbackground(14);
  a[1] := '          ***';
  a[2] := '        *     *';
  a[3] := '       *       *';
  a[4] := '       *       *';
  a[5] := '        *     *';
  a[6] := '          ***';
  a[7] := '     *************';
  a[8] := '     * * *   * * *';
  a[9] := '     * * * * * * *';
  a[10] := '     * * *   * * *';
  a[11] := '     ***       ***';
  a[12] := '      * ******* * ';
  a[13] := '      *  * * *  * ';
  a[14] := '        * * * *';
  a[15] := '       * *   * *';
  a[16] := '       ***   ***';
  a[17] := '        *     *';
  a[18] := '          ***';
  a[19] := '        *     *';
  a[20] := '       *       *';
  a[21] := '       *       *';
  a[22] := '        *     *';
  a[23] := '          ***';
  a[24] := '     *************';
  a[25] := '     * * *   * * *';
  a[26] := '     * * * * * * *';
  a[27] := '     * * *   * * *';
  a[28] := '     ***       ***';
  a[29] := '      * ******* * ';
  a[30] := '      *  * * *  * ';
  a[31] := '         * * *';
  a[32] := '         * * *';
  a[33] := '         *****';
  a[34] := '          * *';

  repeat
    for j := 1 to 60 do
    begin
      clrscr;
      textcolor(37);
      if j mod 2 = 1 then
      begin
        for i := 1 to 17 do
        begin
          gotoxy(j, 5 + i);
          writeln(a[i]);
        end;
      end;
      if j mod 2 = 0 then
      begin
        for k := 18 to 34 do
        begin
          gotoxy(j, k - 12);
          writeln(a[k]);
        end;
      end;
      delay(200);
    end;
    for j := 60 downto 1 do
    begin
      clrscr;
      textcolor(18);
      if j mod 2 = 1 then
      begin
        for i := 1 to 17 do
        begin
          gotoxy(j, 5 + i);
          writeln(a[i]);
        end;
      end;
      if j mod 2 = 0 then
      begin
        for k := 18 to 34 do
        begin
          gotoxy(j, k - 12);
          writeln(a[k]);
        end;
      end;
      delay(200);
    end;
  until keypressed = true;

end.

Leave a Comment

+ 73 = 77