Рейтинг@Mail.ru
Menu
Скачать картинки на телефон бесплатно.
Заставки для телефона, аватарки.
(Вырезать из фотографии)

Роза `Гренд Могул` Яхта `Алиса` Лесное озеро Музей `Пирогово` Белочка
Выберите рубрику (тему)

Курсовая работа – игра ‘Тетрис’, ‘Tetris’

Программирование на Паскале

1. Постановка задачи
2. Метод решения задачи
3. Описание алгоритма
4. Описание программы
  4.1. Описание главных структур и переменных программы
  4.2. Описание главных процедур и функций
5. Описание интерфейса
6. Результат работы
7. Листинг программы

1. Постановка задачи


  Разработать алгоритм программы, которая выполняет перемещение фигур по экрану сверху вниз, координацию их местонахождения в соответствии с действиями играющего.
  Фигуры состоят из квадратов одинакового размера, набор фигур - конечный, последовательность выпадения фигур - случайная.
  Игрок должен вкладывать фигуры на дно стакана по возможности с большей плотностью (количество незаполненных квадратов должно быть минимальным). При этом ряд, полностью заполненный квадратами, должен автоматически исчезать со стакану. Квадраты не должны накладываться один на один.
  Игрок может остановить и продолжить игру. Уровень определяет количество квадратов и скорость в начале игры.



2. Метод решения задачи


  Программа написана на языке Паскаль. Используются такие стандартные модули: graph (обработки кодов нажатых клавиш), graph (для работы в графическом видеорежиме), и windos (используется таймер).
  Использованное объектно - ориентированное программирование. Основные объекты - это фигура и стакан.
  Выполняется обработка событий от таймера, нажатых клавиш, выбранных пунктов меню.

3. Описание алгоритма


Курсовая работа – игра ‘Тетрис’, ‘Tetris’. Описание алгоритма. Постановка задачи:  Разработать алгоритм программы, которая выполняет перемещение фигур по экрану сверху вниз, координацию их местонахождения в соответствии с действиями играющего.  Фигуры состоят из квадратов одинакового размера, набор фигур - конечный, последовательность выпадения фигур - случайная.  Игрок должен вкладывать фигуры на дно стакана по возможности с большей плотностью (количество незаполненных квадратов должно быть минимальным). При этом ряд, полностью заполненный квадратами, должен автоматически исчезать со стакану. Квадраты не должны накладываться один на один.  Игрок может остановить и продолжить игру. Уровень определяет количество квадратов и скорость в начале игры.

4. Описание программы


  4.1. Описание главных структур и переменных программы


Типизированные константы

:

Количество клеточек в стакане
:
  max: byte =20;
  max: byte =30;
Размер одной клеточки
:
  size: byte =12;
Уровень сложности - определяет начальную скорость движения и
    заполнение стакана
:
  level: byte =1;
Промежуток времени между перемещениями фигуры вниз
:
  speed: real=0.4

Объекты

:

Фигура
:
  TBlock = object
    mx,my,x,y: byte; Координаты фигуры и количество квадратов по
        высоте и ширине

    matr: TmatrixBlock; Елемнт матрицы равняется единице , если
        есть квадрат .

    t: byte; Тип фигуры
    pos: 1..4; Положение фигуры
    p,p2: pointer; указатель на рисунок квадрата и на состояние
        экрана до того, как была нарисована фигура

    s,s2: word;
    procedure initmatrix; предоставление начального значения
        матрице

    constructor init;
    constructor init2(t1,pos1: byte); инициализация с
        предоставлением полям t, pos соответствующих значений.

    procedure rotate; virtual; поворот фигуры
    procedure draw; virtual; вырисовывание фигуры
    procedure clear; virtual; стирает фигуру
    destructor done;
  end;

Стакан
:
  Tfield = object
    x 1, y 1: integer; координаты поля
    matr: TMatrixField; если соответствующая каморка заполнена,
        содержит единицу

    constructor init(level: byte); Предоставление начальных
        значений в зависимости от уровня level

    procedure draw; Вырисовывание стакана
    procedure clear; Исчезновение стакану из экрана
    function full: boolean; Возвращает true если стакан полный
    function fline(n: byte): boolean; Возвращает true если
        строка n полный

    procedure dline (n: byte); Уничтожает n- й строку
    private
    x2,y2: integer; ширина и высота
  end;

Рамка
:
  tramka = object
    x,y,width,heigth: integer; координаты , ширина и высота
    lighted: boolean; Если true , то рамка подсвечена
    col1,col2,col3: integer; Цвета фона, активной и
        неактивной рамки

    private
    p: pointer; указатель на состояние экрана до того, как было
        выведено окно

    s: word; соответствующий размер памяти
    public
    constructor init(x1,y1,xx,yy: word);
    procedure mkactive; Установка окна на рамку
    procedure light; Подсветка рамки
    procedure unlight; Рамка неактивного цвета
    procedure draw; Вырисовывание рамки
    procedure clear; Возвращает экран к предыдущему состоянию
    destructor done;
  end;

Вертикальное меню
:
  tsubmenu = object(tramka)
    punkts: menutype; массив из названий пунктов меню
    n: byte; количество пунктов
    col4: integer; Цвет пункта меню
    constructor init(const pnk: menutype; n1: byte; x1,y1: word);
    procedure draw;
    function result: byte; Выполняет пермещение между пунктами и
        возвращает номер избранного пункта

    private h: integer; Высота одного пункта
  end;

Горизонтальное меню
:
  tmainmenu = object(tsubmenu)
    constructor init(const pnk: menutype; n1: byte);
    procedure draw;
    function result: byte;
    procedure getkoords(i: byte; var x,y: word);
  end;

  4.2. Описание главных процедур и функций



Модуль tetobj

:
  procedure kv(var p: pointer; VAR s: word) - возвращает указатель на рисунок квадрата и соответствующий размер памяти

Модуль Int

:
  procedure drawmenu(var res: longint); Выполняет вывод на экран и обработку меню
  procedure entername(score: longint; var name: string); Ввод имени игрока
  procedure best; Вывод таблицы лучших результатов
  procedure clearbest; Очистка таблицы результатов

Модуль Game

:
  procedure startgame(var bl: tblock; var f: tfield; var score: integer); Основная процедура, которая выполняет движение фигуры по полю, вызывает меню и обрабатывает результаты
  function fall(const bl: tblock; const f: tfield): boolean; Возвращает значение True , если фигура упала на дно стакана
  function left(const bl: tblock; const f: tfield): boolean;
  function right(const bl: tblock; const: tfield): boolean;
  function CanBeRotated(const block: tblock; const field: tfield): boolean; Эти функции возвращает значение true если возможно выполнить, соответственно, движение фигуры влево, вправо, или ее поворот.
  procedure NextFigure(var t1,p1: integer); Выводит следующую фигуру, возвращает ее тип и положение
  procedure OutScore(score: integer); Выводит счет на экран

5. Описание интерфейса


  После запуска программы на экране появляются игровое поле с фигурой, информация о следующем блоке и счет. Игра в начале находится в стане паузы. Вверху экрана - меню.
  Главное меню содержит такие пункты:
    •

Игра ( Game)


    •

Лучшие результаты (Best Results)


    •

Налаживание (Options)


  Выбрать необходимый пункт можно с помощью клавиш-стрелок и клавиши 'enter'. При этом редактируется соответствующее подменю.
  Меню 'Игра' разрешает начать новую игру, продолжить начатую, или выйти из игры.
  Меню 'Лучшие рeзультати' - просмотреть таблицу лучших результатов или очистить ее.
  С помощью меню 'Налаживание', можно изменить размер экрана, или выбрать уровень, из которого начинать игру. На первом уровне в начале игры стакан пустой. На следующих уровнях наиболее низкие горизонтальные ряды игрового поля заполнены.
  Если в любой момент во время игры нажать клавишу Esc, то вызовется меню. Игру будет приостановлено. С помощью пункта Continue ее можно будет продолжить.

6. Результат работы


Курсовая работа – игра ‘Тетрис’, ‘Tetris’. Результат работы (1)

Курсовая работа – игра ‘Тетрис’, ‘Tetris’. Результат работы (2)

Курсовая работа – игра ‘Тетрис’, ‘Tetris’. Результат работы (3)

7. Листинг программы


program main;



{ http://nataliya.kiev.ua/?id=114 }



uses


  tetobj,
  game,
  crt,
  graph,
  ramki,
  int;

var


  bl: tblock;
  f: tfield;
  score: integer;
  s: string;

 

procedure myinitgraph;


 
var

    gd, gm: integer;

 
begin

    gd := Detect;
    InitGraph(gd, gm, 'c:/bp/bgi');
    if GraphResult <> 0 then
      begin
        WriteLn('Graphic Error');
        ReadKey;
        Halt;
      end;
  end;

begin


  Release(heaporg);
  Randomize;
  myinitgraph;
  repeat
    startgame(bl, f, score)
  until 1 = 2;
  entername(score, s);
  CloseGraph;
end.

Print  

Печатать текст программы!

(program main;)

Source code: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’».

Редактировать, копировать

(WYSIWYG редактор «NicEdit»)
Загрузить файл с текстом программы: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’». Печатать текст программы!

Загрузить файл с текстом программы

(main.pas - Windows-1251)


unit TetObj;



{ http://nataliya.kiev.ua/?id=114 }



interface



uses crt, graph;


const

  maxX: byte = 20;
  maxY: byte = 30;
  size: byte = 12;
  level: byte = 1;
  speed: real = 0.4;

type

  TMatrixField = array[0..31, 1..45] of 0..1;
  TMatrixBlock = array[1..4, 1..4] of 0..1;

  TBlock = object

    mx, my, x, y: byte;
    matr: TmatrixBlock;
    t: byte;
    pos: 1..4;
    p, p2: pointer;
    s, s2: word;
    procedure initmatrix;
    constructor init;
    constructor init2(t1, pos1: byte);
    procedure rotate; virtual;
    procedure draw; virtual;
    procedure Clear; virtual;
    destructor done;
  end;

  Tfield = object

    x1, y1: integer;
    matr: TMatrixField;
    constructor init(level: byte);
    procedure draw;
    procedure Clear;
    function full: boolean;
    function fline(n: byte): boolean;
    procedure dline(n: byte);
  private
    x2, y2: integer;
  end;

implementation



constructor tfield.init;

var

  i, j: byte;
begin

  for i := 1 to maxX do
    for j := 1 to maxY do
      matr[i, j] := 0;
  for i := 0 to maxX + 1 do
    matr[i, maxY + 1] := 1;
  for j := 1 to maxY do
    begin
      matr[0, j] := 1;
      matr[maxX + 1, j] := 1;
    end;
  Randomize;
  for i := 1 to level - 1 do
    for j := 1 to maxX div 2 do
      matr[Random(maxX - 2) + 1, maxY - i + 1] := 1;
  x1 := 20;
  y1 := 40;
  x2 := size * maxX;
  y2 := size * maxY;
  SetViewPort(x1, y1, x1 + x2, y1 + y2, True);
end;

procedure tblock.initmatrix;

var

  i, j: byte;
begin

  for i := 1 to 4 do
    for j := 1 to 4 do
      matr[i, j] := 0;
  case t of
    1: case pos of
        1, 3:
        begin
          mx := 4;
          my := 1;
          for j := 1 to mx do
            matr[j, 1] := 1;
        end;
        2, 4:
        begin
          mx := 1;
          my := 4;
          for j := 1 to my do
            matr[1, j] := 1;
        end;
      end;
    2: case pos of
        1, 3:
        begin
          mx := 3;
          my := 2;
          matr[1, 1] := 1;
          matr[2, 1] := 1;
          matr[2, 2] := 1;
          matr[3, 2] := 1;
        end;
        2, 4:
        begin
          mx := 2;
          my := 3;
          matr[1, 2] := 1;
          matr[1, 3] := 1;
          matr[2, 1] := 1;
          matr[2, 2] := 1;
        end;
      end;
    3: case pos of
        1:
        begin
          mx := 3;
          my := 2;
          matr[2, 1] := 1;
          matr[1, 2] := 1;
          matr[2, 2] := 1;
          matr[3, 2] := 1;
        end;
        2:
        begin
          mx := 2;
          my := 3;
          matr[1, 1] := 1;
          matr[1, 2] := 1;
          matr[1, 3] := 1;
          matr[2, 2] := 1;
        end;
        3:
        begin
          mx := 3;
          my := 2;
          matr[2, 2] := 1;
          matr[1, 1] := 1;
          matr[2, 1] := 1;
          matr[3, 1] := 1;
        end;
        4:
        begin
          mx := 2;
          my := 3;
          matr[2, 1] := 1;
          matr[2, 2] := 1;
          matr[2, 3] := 1;
          matr[1, 2] := 1;
        end;
      end;
    4: case pos of
        1, 3:
        begin
          mx := 3;
          my := 2;
          matr[2, 1] := 1;
          matr[3, 1] := 1;
          matr[1, 2] := 1;
          matr[2, 2] := 1;
        end;
        2, 4:
        begin
          mx := 2;
          my := 3;
          matr[1, 1] := 1;
          matr[1, 2] := 1;
          matr[2, 2] := 1;
          matr[2, 3] := 1;
        end;
      end;
    5:
    begin
      mx := 2;
      my := 2;
      for i := 1 to 2 do
        for j := 1 to 2 do
          matr[i, j] := 1;
    end;
    6: case pos of
        1:
        begin
          mx := 2;
          my := 3;
          matr[2, 1] := 1;
          matr[2, 2] := 1;
          matr[2, 3] := 1;
          matr[1, 3] := 1;
        end;
        2:
        begin
          mx := 3;
          my := 2;
          matr[1, 1] := 1;
          matr[2, 1] := 1;
          matr[3, 1] := 1;
          matr[3, 2] := 1;
        end;
        3:
        begin
          mx := 2;
          my := 3;
          matr[1, 1] := 1;
          matr[1, 2] := 1;
          matr[1, 3] := 1;
          matr[2, 1] := 1;
        end;
        4:
        begin
          mx := 3;
          my := 2;
          matr[1, 1] := 1;
          matr[1, 2] := 1;
          matr[2, 2] := 1;
          matr[3, 2] := 1;
        end;
      end;
    7: case pos of
        1:
        begin
          mx := 2;
          my := 3;
          matr[1, 1] := 1;
          matr[1, 2] := 1;
          matr[1, 3] := 1;
          matr[2, 3] := 1;
        end;
        2:
        begin
          mx := 3;
          my := 2;
          matr[1, 2] := 1;
          matr[2, 2] := 1;
          matr[3, 2] := 1;
          matr[3, 1] := 1;
        end;
        3:
        begin
          mx := 2;
          my := 3;
          matr[2, 1] := 1;
          matr[2, 2] := 1;
          matr[2, 3] := 1;
          matr[1, 1] := 1;
        end;
        4:
        begin
          mx := 3;
          my := 2;
          matr[1, 2] := 1;
          matr[1, 1] := 1;
          matr[2, 1] := 1;
          matr[3, 1] := 1;
        end;
      end;
  end;
end;

procedure kv(var p: pointer; var s: word);

var

  p2: pointer;
  S2: word;
begin

  s := ImageSize(0, 0, size, size);
  GetMem(p2, s);
  GetImage(0, 0, size, size, p2^);
  SetFillStyle(1, 4);
  SetColor(12);
  Bar(0, 0, size, size);
  Rectangle(2, 2, size - 1, size - 2);
  GetMem(p, s);
  GetImage(0, 0, size, size, p^);
  PutImage(0, 0, p2^, NormalPut);
  FreeMem(p2, s);
  p2 := nil;
end;

constructor tblock.init;

var

  x1, y1, x2, y2, i, j: integer;
begin

  Randomize;
  t := Random(100) mod 7 + 1;
  pos := Random(3) + 1;
  initmatrix;
  x := (maxX - mx) div 2;
  y := 2;
  kv(p, s);
  p2 := nil;
end;

constructor tblock.init2;

begin

  t := t1;
  pos := pos1;
  initmatrix;
  x := (maxX - mx) div 2;
  y := 2;
  kv(p, s);
  p2 := nil;
end;

procedure tblock.draw;

var

  i, j: byte;
begin

  s2 := ImageSize(0, 0, mx * size, my * size);
  GetMem(p2, s2);
  GetImage((x - 1) * size, (y - 1) * size, (x - 1 + mx) * size, (y - 1 + my) * size, p2^);
  for i := 1 to mx do
    for j := 1 to my do
      if matr[i, j] <> 0 then
        PutImage((x + i - 2) * size, (y + j - 2) * size, p^, NormalPut);
end;

procedure tblock.clear;

var

  x1, x2, y1, y2: integer;
begin

  PutImage((x - 1) * size, (y - 1) * size, p2^, NormalPut);
  FreeMem(p2, s2);
  p2 := nil;
end;

procedure tblock.rotate;

begin

  if pos < 4 then
    Inc(pos)
  else
    pos := 1;
  x := x + ((mx + 1) div 2);
  y := y + ((my + 1) div 2);
  x := x - ((mx + 1) div 2);
  y := y - ((my + 1) div 2);
  initmatrix;
end;

procedure tfield.draw;

var

  i, j: byte;
  p: pointer;
  s, r, a, b: word;
  col: word;
  ar: array [1..5, 1..4] of word;
begin

  SetFillStyle(1, blue);
  Bar(0, 0, x2, y2);
  SetColor(3);
  for i := 1 to maxX - 1 do
    Line(size * i, 0, size * i, y2);
  for i := 1 to maxY - 1 do
    Line(0, size * i, x2, size * i);

  ar[1, 1] := 75 * maxX * size div 100 + 4;
  ar[1, 2] := 35 * maxY * size div 150 - 4;
  ar[1, 3] := 12;
  ar[1, 4] := maxX * size div 6;

  ar[2, 1] := 7 * maxX * size div 10 + 3;
  ar[2, 2] := 75 * maxY * size div 150 - 2;
  ar[2, 3] := 14;
  ar[2, 4] := maxX * size div 8;

  ar[3, 1] := 3 * maxX * size div 10 - 6;
  ar[3, 2] := 1 * maxY * size div 10 - 4;
  ar[3, 3] := 13;
  ar[3, 4] := maxX * size div 10;

  for i := 1 to 3 do
    begin
      SetColor(ar[i, 3]);
      a := ar[i, 1];
      b := ar[i, 2];
      r := ar[i, 4];
      {1}Line(a, b, a + (r * 3 div 10), b - (r * 95) div 100);
      Line(a - (r * 3 div 10), b - (r * 95) div 100, a, b);
      Line(a + (r * 3 div 10), b - (r * 95) div 100, a - (r * 3 div 10), b - (r * 95) div 100);
      {2}Line(a, b, a + (r * 3 div 10), b + (r * 95) div 100);
      Line(a - (r * 3 div 10), b + (r * 95) div 100, a, b);
      Line(a - (r * 3 div 10), b + (r * 95) div 100, a + (r * 3 div 10), b + (r * 95) div 100);
      {3}Line(a, b, a - (r * 95) div 100, b + (r * 3 div 10));
      Line(a - (r * 95) div 100, b - (r * 3 div 10), a, b);
      Line(a - (r * 95) div 100, b - (r * 3 div 10), a - (r * 95) div 100, b + (r * 3 div 10));
      {4}Line(a, b, a + (r * 95) div 100, b + (r * 3 div 10));
      Line(a + (r * 95) div 100, b - (r * 3 div 10), a, b);
      Line(a + (r * 95) div 100, b - (r * 3 div 10), a + (r * 95) div 100, b + (r * 3 div 10));
      {5}Line(a + (45 * r) div 100, b - (88 * r) div 100, a, b);
      Line(a + (88 * r) div 100, b - (45 * r) div 100, a, b);
      Line(a + (45 * r) div 100, b - (88 * r) div 100, a + (88 * r) div 100, b - (45 * r) div 100);
      {6}Line(a - (45 * r) div 100, b - (88 * r) div 100, a, b);
      Line(a - (88 * r) div 100, b - (45 * r) div 100, a, b);
      Line(a - (45 * r) div 100, b - (88 * r) div 100, a - (88 * r) div 100, b - (45 * r) div 100);
      {7}Line(a - (45 * r) div 100, b + (88 * r) div 100, a, b);
      Line(a - (88 * r) div 100, b + (45 * r) div 100, a, b);
      Line(a - (45 * r) div 100, b + (88 * r) div 100, a - (88 * r) div 100, b + (45 * r) div 100);
      {8}Line(a + (45 * r) div 100, b + (88 * r) div 100, a, b);
      Line(a + (88 * r) div 100, b + (45 * r) div 100, a, b);
      Line(a + (45 * r) div 100, b + (88 * r) div 100, a + (88 * r) div 100, b + (45 * r) div 100);
    end;
  kv(p, s);
  for i := 1 to maxX do
    for j := 1 to maxY do
      if matr[i, j] = 1 then
        PutImage((i - 1) * size, (j - 1) * size, p^, NormalPut);
  FreeMem(p, s);
  p := nil;
end;

procedure tfield.clear;

begin

  SetViewPort(x1, y1, x1 + x2, y1 + y2, True);
  SetFillStyle(1, 0);
  Bar(0, 0, x2, y2);
end;

function tfield.full;

var

  i: byte;
begin

  full := False;
  for i := 1 to maxX do
    if matr[i, 2] <> 0 then
      full := True;
end;

function tfield.fline;

var

  i: byte;
  t: boolean;
begin

  t := True;
  for i := 1 to maxX do
    if matr[i, n] = 0 then
      t := False;
  fline := t;
end;

procedure tfield.dline;

var

  i, j: byte;
  pr: ^pointer;
  sz: word;
begin

  for j := n downto 2 do
    for i := 1 to maxX do
      matr[i, j] := matr[i, j - 1];
end;

destructor tblock.done;

begin

  if p <> nil then
    FreeMem(p, s);
  if p2 <> nil then
    FreeMem(p2, s2);
  p := nil;
  p2 := nil;
end;

begin


end.

Print  

Печатать текст программы!

(unit TetObj;)

Source code: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’».

Редактировать, копировать

(WYSIWYG редактор «NicEdit»)
Загрузить файл с текстом программы: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’». Печатать текст программы!

Загрузить файл с текстом программы

(TetObj.pas - Windows-1251)


unit ramki;



{ http://nataliya.kiev.ua/?id=114 }



interface



uses graph, crt;


type

  menutype = array[1..10] of string[15];

  tramka = object

    x, y, Width, heigth: integer;
    lighted: boolean;
    col1, col2, col3: integer;
  private

    p: pointer;
    s: word;
  public

    constructor init(x1, y1, xx, yy: word);
    procedure mkactive;
    procedure light;
    procedure unlight;
    procedure draw;
    procedure Clear;
    destructor done;
  end;

  tsubmenu = object(tramka)

    punkts: menutype;
    n: byte;
    col4: integer;
    constructor init(const pnk: menutype; n1: byte; x1, y1: word);
    procedure draw;
    function result: byte;
  private
    h: integer;
  end;

  tmainmenu = object(tsubmenu)

    constructor init(const pnk: menutype; n1: byte);
    procedure draw;
    function result: byte;
    procedure getkoords(i: byte; var xI, yI: word);
  end;

implementation



constructor tramka.init;

begin

  x := x1;
  y := y1;
  Width := xx;
  heigth := yy;
  lighted := False;
  col1 := 2;
  col2 := 4;
  col3 := 14;
end;

procedure tramka.mkactive;

begin

  SetViewPort(x, y, x + Width, y + heigth, True);
end;

procedure tramka.light;

begin

  if not lighted then
    begin
      mkactive;
      SetColor(red);
      SetLineStyle(0, $11, 1);
      Rectangle(1, 1, Width - 1, heigth - 1);
      lighted := True;
    end;
end;

procedure tramka.unlight;

begin

  if lighted then
    begin
      mkactive;
      SetColor(14);
      SetLineStyle(0, $11, 1);
      Rectangle(1, 1, Width - 1, heigth - 1);
      lighted := False;
    end;
end;

procedure tramka.draw;

begin

  mkactive;
  s := ImageSize(0, 0, Width, heigth);
  GetMem(p, s);
  GetImage(0, 0, Width, heigth, p^);
  SetFillStyle(1, green);
  Bar(0, 0, Width, heigth);
  light;
end;

destructor tramka.done;

begin

  if p <> nil then
    FreeMem(p, s);
  p := nil;
end;

procedure tramka.clear;

begin

  mkactive;
  unlight;
  PutImage(0, 0, p^, NormalPut);
  if p <> nil then
    FreeMem(p, s);
  p := nil;
end;

constructor tsubmenu.init;

var

  i: byte;
begin

  n := n1;
  h := 15;
  tramka.init(x1, y1, 80, n * h + 4);
  for i := 1 to n do
    punkts[i] := pnk[i];
  col4 := 14;
end;

procedure tsubmenu.draw;

var

  i: byte;
begin

  tramka.draw;
  SetFillStyle(1, col4);
  for i := 1 to n do
    begin
      Bar(3, (i - 1) * h + 3, Width - 3, (i) * h);
      SetColor(col4);
      Rectangle(3, (i - 1) * h + 3, Width - 3, (i) * h);
      SetColor(0);
      OutTextXY(4, (i - 1) * h + h div 2, punkts[i]);
    end;
  SetColor(red);
  OutTextXY(4, h div 2, punkts[1]);
  Rectangle(3, 3, Width - 3, h);

end;

function tsubmenu.result;

var

  c: char;
var

  i: byte;
begin

  c := 'q';
  draw;
  i := 1;
  repeat
    c := ReadKey;
    case c of
      #72:
      begin
        SetColor(0);
        OutTextXY(4, (i - 1) * h + h div 2, punkts[i]);
        SetColor(col4);
        Rectangle(3, (i - 1) * h + 3, Width - 3, (i) * h);
        if i = 1 then
          i := n
        else
          i := i - 1;
        SetColor(red);
        OutTextXY(4, (i - 1) * h + h div 2, punkts[i]);
        Rectangle(3, (i - 1) * h + 3, Width - 3, (i) * h);
      end;
      #80:
      begin
        SetColor(0);
        OutTextXY(4, (i - 1) * h + h div 2, punkts[i]);
        SetColor(col4);
        Rectangle(3, (i - 1) * h + 3, Width - 3, (i) * h);
        if i = n then
          i := 1
        else
          i := i + 1;
        SetColor(red);
        OutTextXY(4, (i - 1) * h + h div 2, punkts[i]);
        Rectangle(3, (i - 1) * h + 3, Width - 3, (i) * h);
      end;
    end;
  until (c = #13) or (c = #27);
  if (c = #13) then
    Result := i
  else
    Result := 0;
  while KeyPressed do
    ReadKey;
end;

constructor tmainmenu.init;

var

  i: byte;
begin

  n := n1;
  heigth := 20;
  Width := GetMaxX - 4;
  h := Width div n;
  tramka.init(2, 2, Width, heigth);
  for i := 1 to n do
    punkts[i] := pnk[i];
  col4 := 14;
end;

procedure tmainmenu.draw;

var
  i: byte;
begin

  tramka.draw;
  SetFillStyle(1, col4);
  SetLineStyle(0, $aa, 1);
  for i := 1 to n do
    begin
      Bar((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
      SetColor(col4);
      Rectangle((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
      SetColor(black);
      OutTextXY((i - 1) * h + 5, heigth div 2, punkts[i]);
    end;
  SetColor(red);
  OutTextXY(5, heigth div 2, punkts[1]);
  Rectangle(3, 3, h - 1, heigth - 3);
end;

function tmainmenu.result;

var

  c: char;
var

  i: byte;
begin

  c := 'q';
  draw;
  i := 1;
  repeat
    c := ReadKey;
    case c of
      #75:
      begin
        SetColor(0);
        OutTextXY((i - 1) * h + 5, heigth div 2, punkts[i]);
        SetColor(col4);
        Rectangle((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
        if i = 1 then
          i := n
        else
          i := i - 1;
        SetColor(red);
        OutTextXY((i - 1) * h + 5, heigth div 2, punkts[i]);
        Rectangle((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
      end;
      #77:
      begin
        SetColor(0);
        OutTextXY((i - 1) * h + 5, heigth div 2, punkts[i]);
        SetColor(col4);
        Rectangle((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
        if i = n then
          i := 1
        else
          i := i + 1;
        SetColor(red);
        OutTextXY((i - 1) * h + 5, heigth div 2, punkts[i]);
        Rectangle((i - 1) * h + 3, 3, i * h - 1, heigth - 3);
      end;
    end;
  until (c = #13);
  if c = #13 then
    Result := i
  else
    Result := n + 1;
end;

procedure tmainmenu.getkoords;

begin

  yI := heigth + 2;
  xI := x + (i - 1) * h;
end;

begin


end.

Print  

Печатать текст программы!

(unit ramki;)

Source code: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’».

Редактировать, копировать

(WYSIWYG редактор «NicEdit»)
Загрузить файл с текстом программы: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’». Печатать текст программы!

Загрузить файл с текстом программы

(ramki.pas - Windows-1251)


unit int;



{ http://nataliya.kiev.ua/?id=114 }



interface



uses
ramki, graph, crt, tetobj;

procedure drawmenu(var res: longint);

procedure entername(score: longint; var name: string);

procedure best;

procedure clearbest;


implementation



procedure drawmenu;

var

  xI, yI: word;
  i, j, k: byte;
  C, d: char;
  block: tblock;
  field: tfield;
  x1, y1, x2, y2: integer;
  smenu, op: tsubmenu;
  mmenu: tmainmenu;
const

  men: menutype = ('Game', 'Best Results', 'Options', '', '', '', '', '', '', '');
  smen1: menutype = ('Start', 'Continue', 'Exit', '', '', '', '', '', '', '');
  smen3: menutype = ('Size', 'Level', '', '', '', '', '', '', '', '');
  smen2: menutype = ('Results', 'Clear', '', '', '', '', '', '', '', '');
  speed: menutype = ('Level1', 'Level2', 'Level3', 'Level4', 'Level5', '', '', '', '', '');
  sz: menutype = ('Small', 'Normal', 'Large', '', '', '', '', '', '', '');
begin

  mmenu.init(men, 3);
  i := mmenu.result;
  mmenu.unlight;
  mmenu.getkoords(i, xI, yI);
  case i of
    1:
    begin
      smenu.init(smen1, 3, xI, yI);
      j := smenu.result;
      smenu.clear;
      if j = 1 then
        res := 1;
      if j = 2 then
        res := 2;
      if j = 3 then
        res := -3;
      smenu.done;
    end;
    2:
    begin
      smenu.init(smen2, 2, xi, yi);
      j := smenu.result;
      smenu.clear;
      if j = 1 then
        res := -1;
      if j = 2 then
        res := -2;
      smenu.done;
    end;
    3:
    begin
      smenu.init(smen3, 2, xI, yI);
      j := smenu.result;
      smenu.unlight;
      if j = 1 then
        begin
          op.init(sz, 3, smenu.x + smenu.Width, smenu.y + 3);
          k := op.result;
          op.clear;
          op.done;
          if k = 1 then
            res := 3;
          if k = 2 then
            res := 4;
          if k = 3 then
            res := 5;
        end;
      if j = 2 then
        begin
          op.init(speed, 5, smenu.x + smenu.Width, smenu.y + 3);
            k := op.result;
          op.clear;
          op.done;
          if (k >= 1) and (k <= 5) then
            res := 5 + k;
        end;
      smenu.clear;
      smenu.done;
    end;
  end;
end;

procedure entername;

type

  t = record
    name: string;
    score: longint;
  end;
  tf = file of t;
var

  a, b: tf;
  c, d, t1: t;
  ram: tramka;
  i: byte;
  bool: boolean;
begin

  bool := False;
  Assign(a, 'file.txt');
  Reset(a);
  Assign(b, 'temp.txt');
  ReWrite(b);
  t1.score := score;
  i := 0;
  while (not EOF(a)) and (i <= 12) do
    begin
      i := i + 1;
      Read(a, c);
      Write(b, c);
    end;
  Close(a);
  Close(b);
  ReWrite(a);
  Reset(b);
  c.score := 1000000;
  Read(b, d);
  Write(a, c);
  while not EOF(b) do
    begin
      c := d;
      Read(b, d);
      if (d.score = score) then
        begin
          ram.init((GetMaxX - 300) div 2, (GetMaxY - 200) div 2, 300, 200);
          ram.draw;
          SetTextJustify(1, 1);
          OutTextXY(ram.Width div 2, 30, 'Enter your nane:');
          SetTextJustify(0, 2);
          SetFillStyle(1, 10);
          Bar((ram.Width - 150) div 2, 115, (ram.Width + 150) div 2, 135);
          GotoXY(33, 17);
          TextColor(red);
          TextBackground(1);
          ReadLn(name);
          t1.name := name;
          Write(a, t1);
          ram.clear;
          ram.done;
          bool := True;
        end;
      Write(a, d);
    end;
  Close(a);
  Close(b);
  if bool then
    best;
end;

procedure best;

type

  t = record
    name: string;
    score: longint;
  end;
  tf = file of t;
var

  a: tf;
  i: byte;
  x: t;
  ram: tramka;
  st: string;
begin

  ram.init((GetMaxX - 400) div 2, (GetMaxY - 300) div 2, 400, 300);
  ram.draw;
  Assign(a, 'file.txt');
  Reset(a);
  Read(a, x);
  for i := 1 to 10 do
    if not EOF(a) then
      begin
        GotoXY(100, 100);
        Read(a, x);
        str(x.score, st);
        OutTextXY(20, 50 + i * 15, x.name);
        OutTextXY(200, 50 + i * 15, st);
      end;
  while KeyPressed do
    ReadKey;
  ReadKey;
  ram.clear;
  ram.done;
end;

procedure clearbest;

type

  t = record
    name: string;
    score: longint;
  end;
  tf = file of t;
var
  f: tf;
  tt: t;
  i: byte;
begin

  Assign(f, 'file.txt');
  ReWrite(f);
  tt.score := 100000;
  Write(f, tt);
  for i := 1 to 50 do
    begin
      tt.name := 'noname';
      tt.score := 5;
      Write(f, tt);
    end;
  Close(f);
end;

begin


end.

Print  

Печатать текст программы!

(unit int;)

Source code: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’».

Редактировать, копировать

(WYSIWYG редактор «NicEdit»)
Загрузить файл с текстом программы: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’». Печатать текст программы!

Загрузить файл с текстом программы

(int.pas - Windows-1251)


unit game;



{ http://nataliya.kiev.ua/?id=114 }



interface



uses
graph, crt, windos, tetobj, ramki, int;

procedure startgame(var bl: tblock; var f: tfield; var score: integer);

function time: real;


implementation



var

  ramka, r: tramka;
  ng: boolean;

const

  cont: boolean = False;
  ch: char = #27;

function time;

var

  h, m, s, ms: word;
begin

  Gettime(h, m, s, ms);
  time := 3600 * h + 60 * m + s + ms / 100;
end;

function fall(const bl: tblock; const f: tfield): boolean;

var

  t: boolean;
  i, j: byte;
begin

  t := False;
  for i := 1 to bl.mx do
    for j := bl.my downto 1 do
      if (bl.matr[i, j] <> 0) and (f.matr[bl.x + i - 1, bl.y + j] <> 0) then
        t := True;
  fall := t;
end;

function left(const bl: tblock; const f: tfield): boolean;

var

  t: boolean;
  i, j: byte;
begin

  t := False;
  for j := 1 to bl.my do
    for i := bl.mx downto 1 do
      if (bl.matr[i, j] <> 0) and (f.matr[bl.x + i - 2, bl.y + j - 1] <> 0) then
        t := True;
  left := t;
end;

function right(const bl: tblock; const f: tfield): boolean;

var

  t: boolean;
  i, j: byte;
begin

  t := False;
  for j := 1 to bl.my do
    for i := bl.mx downto 1 do
      if (bl.matr[i, j] <> 0) and (f.matr[bl.x + i, bl.y + j - 1] <> 0) then
        t := True;
  right := t;
end;

procedure AddBlock(const b: tblock; var f: tfield);

var

  i, j: byte;
begin

  for i := 1 to b.mx do
    for j := 1 to b.my do
      if b.matr[i, j] = 1 then
        f.matr[b.x + i - 1, b.y + j - 1] := 1;
  b.done;
end;

procedure NextFigure(var t1, p1: integer);

var

  bb: tblock;
begin

  ramka.clear;
  ramka.draw;
  ramka.light;
  OutTextXY(10, 10, 'Next:');
  bb.init;
  bb.x := 4 - (bb.mx div 2);
  bb.y := 5 - (bb.my div 2);
  bb.draw;
  t1 := bb.t;
  p1 := bb.pos;
  bb.done;
end;

function CanBeRotated(const block: tblock; const field: tfield): boolean;

var

  m, i, j: byte;
  t: boolean;
begin

  if block.mx > block.my then
    m := block.mx
  else
    m := block.my;
  t := True;
  for i := 1 to m do
    for j := 1 to m do
      if field.matr[block.x + i - 1, block.y + j - 1] <> 0 then
        t := False;
  CanBeRotated := t;
end;

procedure OutScore(score: integer);

var

  strsc: string;
begin

  r.clear;
  r.draw;
  r.light;
  str(score, strsc);
  OutTextXY(5, 10, 'Score:');
  OutTextXY(5, 25, strsc);
end;

procedure changeoptions(k: byte; var speed: real);

begin

  if k = 1 then
   begin
     size := 15;
     maxX := 15;
     maxY := 24;
   end;
  if (k = 2) then
   begin
     size := 12;
     maxX := 20;
     maxY := 30;
   end;
  if k = 3 then
   begin
     size := 12;
     maxX := 25;
     maxY := 35;
   end;

  if k = 4 then
    speed := 0.5;
  if k = 5 then
    speed := 0.45;
  if k = 6 then
    speed := 0.4;
  if k = 6 then
    speed := 0.37;
  if k = 7 then
    speed := 0.33;
  if (k >= 4) and (k <= 8) then
    level := k - 3;
end;

procedure StartGame;

var

  i, j: byte;
  tm, sc: real;
  k1, k2: integer;
  re: longint;
  stt: string;
begin

  re := 0;
  score := 0;
  sc := score;
  f.init(level);
  f.draw;
  ramka.init(350, 50, 6 * size, 7 * size);
  ramka.draw;
  r.init(350, 200, 50, 50);
  r.draw;
  nextfigure(k1, k2);
  Outscore(score);
  SetViewPort(f.x1, f.y1, f.x1 + size * maxX, f.y1 + size * maxY, False);
  while (not f.full) do
    begin
      tm := time;
      bl.init2(k1, k2);
      nextfigure(k1, k2);
      SetViewPort(f.x1, f.y1, f.x1 + size * maxX, f.y1 + size * maxY, False);
      bl.draw;
      { ch := '/'; }
      while (not fall(bl, f)) do
        begin
          delay(1000);
          if KeyPressed then
            begin
              ch := ReadKey;
              if ch = #0 then
                ch := ReadKey;
              bl.clear;
              case ch of
                #75: if not left(bl, f) then
                    bl.x := bl.x - 1;
                #77: if not right(bl, f) then
                    bl.x := bl.x + 1;
                #72: if canberotated(bl, f) then
                    bl.rotate;
              end;
              bl.draw;
            end;
          if (time >= tm + speed) or (ch = #80) then
            begin
              bl.clear;
              bl.y := bl.y + 1;
              tm := time;
              bl.draw;
            end;
          if (ch = #27) then
            begin
              ramka.unlight;
              r.unlight;
              repeat
                cont := True;
                drawmenu(re);
                ch := '?';
                if re = -1 then
                  best;
                if re = -2 then
                  begin
                    clearbest;
                    best;
                  end;
                if (re >= 3) or (re = 1) or (re = -3) then
                  begin
                    if cont then
                      begin
                        entername(score, stt);
                        bl.done;
                        f.clear;
                        ramka.clear;
                        r.clear;
                        ramka.done;
                        r.done;
                        changeoptions(re - 2, speed);
                      end;
                    if re = -3 then
                      Halt;
                    exit;
                  end;
              until RE = 2;
              ch := '?';
              ramka.light;
              r.light;
              SetViewPort(f.x1, f.y1, f.x1 + size * maxX, f.y1 + size * maxY, False);
            end;
        end;
      addblock(bl, f);
      bl.done;
      for j := 1 to maxY do
        begin
          if f.fline(j) then
            begin
              f.dline(j);
              f.clear;
              f.draw;
              score := score + 10;
              outscore(score);
              SetViewPort(f.x1, f.y1, f.x1 + size * maxX, f.y1 + size * maxY, True);
              if score >= sc + 50 then
                begin
                  sc := score;
                  speed := 0.8 * speed;
                end;
            end;
          CH := ' ';
        end;
    end;
  cont := False;
  bl.done;
  f.clear;
  ramka.clear;
  r.clear;
  ramka.done;
  r.done;
  entername(score, stt);
  drawmenu(re);
end;

begin


  CONT := False;
end.

Print  

Печатать текст программы!

(unit game;)

Source code: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’».

Редактировать, копировать

(WYSIWYG редактор «NicEdit»)
Загрузить файл с текстом программы: «Курсовая работа – игра ‘Тетрис’, ‘Tetris’». Печатать текст программы!

Загрузить файл с текстом программы

(game.pas - Windows-1251)


Download free

: Tetris.zip (46Kb)
( MAIN.EXE, main.pas, TetObj.pas, ramki.pas, int.pas, game.pas, FILE.TXT, TEMP.TXT, TETOBJ.TPU, RAMKI.TPU, INT.TPU, GAME.TPU, info )


$text_date: 2007-12-22   Автор: Admin
Случайный анекдот

Спрашивает дочка у мамы:
- Мам, а кто этот волосатый дядя с красными глазками?
- Это твой папа, доченька.
- А он что, заболел?
- Нет, он к интеpнету подключился...
Дата: 24-12-2004   Автор: Admin   Подрубрика: Компьютеры и дети