Tag: delphi

Here is a Tetris for Delphi example which used buffered GDI graphics.

Controls:

• LEFT, RIGHT flash arrows – moves
• DOWN arrow – speed up the block
• ESC – exit

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls;

type
  TForm1 = class(TForm)
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
const
  n = 10; // количество строк
  m = 5;  // количество столбцов
  z = 50; // длина стороны квадрата ячейки на поле
  normal_timer = 600; // значение интервала таймера по умолчанию
  speed_timer = 100;   // значение интервала таймера при ускорении
type
  player = record
              x:integer;
              y:integer;
            end;
            // тип запись, для фиксирования положения кубика игрока
var
  cols: array [1..n, 1..m] of boolean; // матрица состояний ячеек поля
                                    // true - кубик есть
                                    // false - кубика нет
  p: player; // летящий вниз кубик
  i,j: integer; // счетчики
  counter: integer;

procedure verify_line;
var
  last_line_full: boolean;
begin
  last_line_full := true; // флаг указывающий на заполнение последней линии

  for i:=1 to m do
  begin
    // проверяем последнюю линию (строку)
    if not cols[n,i] then // если какого-то кубика в линии нет, то говорим, что линия не заполнена и выходим из цикла
    begin
      last_line_full := false;
      break;
    end;
  end;


  // если поледняя линия заполнена, то необходимо сдвинуть все строки на одну ниже
  if last_line_full then
  begin
    counter := counter + 1; // раз заполнили линию , добавляем очки
    for i:=n downto 2 do
    begin
      for j:=1 to m do
      begin
        cols[i,j] := cols[i-1, j]; // заменяем строки которые ниже, строками которые выше
      end;
    end;

    // первую строку очищаем
    for i:=1 to m do
      cols[1, i] := false;
  end;

  Form1.Caption := 'Tetris. count = ' + IntToStr(counter); // выводим результат игрока в заголовок

  // т.к. у нас кубик 1 на 1 клетку, то достаточно проверить заполненность линии 1 раз
  // были бы другие объекты большей высоты, не обходимо было бы проверять, до тех пор
  // пока последняя линия не стала бы незаполненной
end;

procedure new_player;
begin
  // если было ускорение, и даже если его не было
  // возвращаем значение интервала таймера в исходное
  Form1.Timer1.Interval := normal_timer;

  // т.к. процедура new_player не объявлена в классе TForm1,
  // то, чтобы обратиться к объектам на форме
  // нужно перед ними писать Form1.

  // начальное положение игрока
  randomize;
  p.x := Random(m-1)+1; // случайное число от 1 до m
  p.y := 1; // первая строка сверху
end;

procedure  verify_player;
begin
  // проверяем, чтобы кубик не вылетел за границы поля
  if (p.x <= 1) then p.x := 1 else if (p.x >= m) then p.x := m;

  if (cols[p.y, p.x]) then
  begin
    Form1.Timer1.Enabled := false;
    ShowMessage('Игра Окончена!');
  end;

  // если кубик упал до самого низа или если кубик упал на другой кубик
  if (p.y >= n) or (cols[p.y+1, p.x]) then begin
    cols[p.y, p.x] := true;  // отмечаем упавший кубик на поле
    new_player; // возвращаем падающий кубик в начало пути
  end;
end;

//отображает игровое поле
procedure print_m;
var
  b: TBitmap;   // будем использовать двойную буфферизацию
                // поэтому создаем переменную типа TBitmap
                // смысл в том, что сначало рисуем "в памяти",
                // а потом выводим на экран

begin

  verify_line;  // проверим последнюю линию ( строку ) на заполненность
  verify_player; // проверяем координаты игрока
  b := TBitmap.Create; // создаем объект заданного типа


  b.Width := Form1.Width; // устанавливаем ширину рисунка в памяти
  b.Height := Form1.Height; // устанавливаем высоту рисунка в памяти

  // рисуем кубики которые уже упали
  for i:=1 to n do
    for j:=1 to m do
    begin
      if cols[i,j] then
      begin
        b.Canvas.Brush.Color := clRed;  // если есть, то рисуем красным
      end
      else
      begin
        b.Canvas.Brush.Color := clWhite; // если нет, то рисуем белым
      end;

      b.Canvas.FillRect(Rect((j-1)*z,(i-1)*z, (j-1)*z+z, (i-1)*z+z)); // отображаем ячейку
      // обращаем внимание j - это столбцы, оно меняет координату x
      // i - строки, меняет координату y
    end;

  b.Canvas.Brush.Color := clRed; // цвет падающего кубика
  b.Canvas.FillRect(Rect((p.x-1)*z,(p.y-1)*z, (p.x-1)*z+z, (p.y-1)*z+z)); // отображаем ячейку

  // из всех координат на поле вычитаем единичку
  // потому что размер поля например 5 на 10, но в графике это 250 на 500 (потомучто если кубик будет со стороной 1 пиксель его никто не увидит)
  // и в графике координаты начинаються с нуля, т.е. кубик с координатами на поле 1,1 , это прямоугольник (Rect(0,0,50,50))

  // копируем картинку из памяти в картинку на экране,
  // по человечески говоря - отображаем
  Form1.Canvas.CopyRect(Rect(0,0, Form1.Width, Form1.Height), b.Canvas, Rect(0,0,b.Width, b.Height));

  // если не использовать двойной буфер, то все b заменили бы на Form1 (или Image1)
  // удалили бы строки связанные с TBitmap.Create, b.Width, b.Height, Form1.CopyRect

  b.Free; // очищаем память, от временной картинки
end;



procedure TForm1.FormCreate(Sender: TObject);
begin
  // в этой процедуре всегда все сбрасываем на исходные позиции



  counter := 0; // счетчик очков в ноль
  new_player;

  // очищаем поле
  for i:=1 to n do
    for j:=1 to m do
      cols[i,j] := false;

  // устанавливаем размеры окна
  Form1.ClientWidth := m * z;
  Form1.ClientHeight := n * z;
  // используються размеры с приставкой Client потомучто, без неё это размер окна
  // с учетом всех рамок, отступов и в зависимости от установленного стиля
  // графической оболочки виндовс просто размеры Width и Height разные!
  // а ClientWidth и    ClientHeight постоянны всегда и гарантируют нам нужный размер рабочего поля

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if ( not Timer1.Enabled ) then // если игра окончена
  begin
    exit; // то - не обрабатываем клавиши
  end;

  // если была нажата клавиша влево
  if (Key = VK_LEFT) then
  begin
    p.x := p.x - 1;
    print_m; // если что-то поменялось, сразу отображаем изменения
  end
  // иначе если нажата клавиша вправо
  else if (Key = VK_RIGHT) then
  begin
    p.x := p.x + 1;
    print_m;
  end
  // если нажата клавиша вниз, делаем ускорение
  else if (Key  = VK_DOWN) then
  begin
    Timer1.Interval := speed_timer;
  end
  // если пользователь нажал ESC, то выходим
  else if (Key = VK_ESCAPE) then
    close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  p.y := p.y + 1; // опускаем кубик вниз
  print_m; // отображаем игровое поле
end;

end.