Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > IT форум > Помощь студентам
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 28.05.2008, 15:27   #1
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
Смущение Помогите разобраться с тетрисом на Delphi

Вообщем такое дело: я скачалА(да Luden - это мужского рода, просто я вошлА на форум под его ником...вот..) исходник тетриса на delphi...но так как я в нем почти ничего не понимаю, не могли бы вы мне помочь, дорогие форумчане...заранее спасибо...
Luden вне форума Ответить с цитированием
Старый 28.05.2008, 15:34   #2
Dux
Delphi Master
Форумчанин Подтвердите свой е-майл
 
Аватар для Dux
 
Регистрация: 31.03.2008
Сообщений: 803
По умолчанию

Не знаю какой вы скачали и с чем конкретно помочь? Один из вариантов Тетриса можете посмотреть здесь: http://www.delphicode.ru/code/code.htm
Dux вне форума Ответить с цитированием
Старый 28.05.2008, 15:41   #3
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
По умолчанию

Код:
{ Public declarations }
  end;

  TTetr = Array [1..4, 1..4] of Byte;

const
  tetramino: Array [1..11, 1..4] of TTetr =
  (
  (((1,1,0,0),(0,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(1,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(1,0,0,0),(0,0,0,0))),
  (((0,1,1,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,1,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0))),
  (((0,1,0,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,0,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0))),
  (((0,0,0,0),(1,1,1,1),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(0,1,0,0),(0,1,0,0)),
   ((0,0,0,0),(1,1,1,1),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(0,1,0,0),(0,1,0,0))),
  (((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,1,0,0),(0,1,0,0),(0,1,0,0),(0,0,0,0)),
   ((0,0,1,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,0,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,1,1,0),(1,0,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,1,0,0),(1,0,0,0),(1,0,0,0),(0,0,0,0)),
   ((1,1,1,0),(0,0,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,1,0),(0,0,0,0),(0,0,0,0))),
  (((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0))),
  (((1,1,1,0),(1,0,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,1,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,0,1,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,0,0,0),(1,1,0,0),(0,0,0,0))),
  (((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,0,0,0),(1,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)))
  );


я конечно догадываюсь, что это скорее всего для построения фигур, но как это работает..:mad: 



как рисуется клетка я понимаю(ну хоть что-то)
procedure drawsquare(i,j,c : Integer; cnv : TCanvas);
var
  x,y : Integer;
begin
  x := (j-1)*sqrs;
  y := (i-1)*sqrs;
  with cnv do
  begin
    Brush.Color := c;
    FillRect(Bounds(x+2,y+2,sqrs-4,sqrs-4));
    Pen.Color := clLtGray;
    MoveTo(x,y);
    LineTo(x+sqrs,y);
    MoveTo(x,y);
    LineTo(x,y+sqrs);
    Pen.Color := clWhite;
    MoveTo(x+1,y+1);
    LineTo(x+sqrs-2,y+1);
    MoveTo(x+1,y+1);
    LineTo(x+1,y+sqrs-2);
    Pen.Color := clBlack;
    MoveTo(x+sqrs-1,y+sqrs-1);
    LineTo(x,y+sqrs-1);
    MoveTo(x+sqrs-1,y+sqrs-1);
    LineTo(x+sqrs-1,y);
    MoveTo(x+sqrs-2,y+sqrs-2);
    LineTo(x+1,y+sqrs-2);
    MoveTo(x+sqrs-2,y+sqrs-2);
    LineTo(x+sqrs-2,y+1);
  end;
end;


а вот это что???:eek: 
procedure showfigure;
var
  i,j : Integer;
begin
  for i:=1 to 4 do
    for j:=1 to 4 do
      if tetr[i,j]=1 then drawsquare(i+y-1,j+x-1,fcl,Form1.Image1.Canvas);
end;

procedure erasesquare(i,j : Integer);
var x,y : Integer;
begin
  Form1.Image1.Canvas.Brush.Color := clGray;
  x := (j-1)*sqrs;
  y := (i-1)*sqrs;
  Form1.Image1.Canvas.FillRect(Bounds(x,y,sqrs,sqrs));
end;

procedure hidefigure;
var
  i,j: Integer;
begin
  for i:=1 to 4 do
    for j:=1 to 4 do
      if tetr[i,j]=1 then erasesquare(i+y-1,j+x-1);
end;

function canrotate : Boolean;
var i,j,k : Integer; t : TTetr;
begin
  result := true;
  k := num;
  if k < 4 then inc(k) else k := 1;
  t := tetramino[gen,k];
  for i := 1 to 4 do
    for j := 1 to 4 do
      if (t[i,j]=1) and ((stakan[i+y-1,j+x-1]>0)
      or (j-1+x-1<0) or (j+x>stkw+1) or (i+y>stkh+1)) then
      begin
        result := false;
        exit;
      end;
end;

procedure rotatefigure;
begin
  hidefigure;
  if num < 4 then inc(num) else num := 1;
  tetr := tetramino[gen,num];
  showfigure;
end;

Последний раз редактировалось Stilet; 28.05.2008 в 16:03.
Luden вне форума Ответить с цитированием
Старый 28.05.2008, 15:45   #4
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Ну выкладывай код в студию. Глянем.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 28.05.2008, 15:50   #5
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
По умолчанию

ммммм....мне очень стыдно, но ффффффто такое "код" - эта сама прога???
Luden вне форума Ответить с цитированием
Старый 28.05.2008, 16:05   #6
Stilet
Белик Виталий :)
Старожил
 
Аватар для Stilet
 
Регистрация: 23.07.2007
Сообщений: 57,097
По умолчанию

Цитата:
код" - эта сама прога???
Да имеется ввиду исходник.

Теперь по тому что выложила - это недокачаный исходник в нем нет шапки.
I'm learning to live...
Stilet вне форума Ответить с цитированием
Старый 28.05.2008, 16:12   #7
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
По умолчанию

вообщем вот....
Код:
unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ExtCtrls, StdCtrls, Registry;

type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    mnuGame: TMenuItem;
    mnuNew: TMenuItem;
    mnuS1: TMenuItem;
    mnuExit: TMenuItem;
    Timer1: TTimer;
    Label1: TLabel;
    Panel1: TPanel;
    Image1: TImage;
    Panel2: TPanel;
    Image2: TImage;
    Label2: TLabel;
    Label3: TLabel;
    procedure mnuNewClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormCreate(Sender: TObject);
    procedure mnuExitClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TTetr = Array [1..4, 1..4] of Byte;

const
  tetramino: Array [1..11, 1..4] of TTetr =
  (
  (((1,1,0,0),(0,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(1,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(1,0,0,0),(0,0,0,0))),
  (((0,1,1,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,1,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0))),
  (((0,1,0,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,0,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,0,0),(0,1,0,0),(0,0,0,0))),
  (((0,0,0,0),(1,1,1,1),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(0,1,0,0),(0,1,0,0)),
   ((0,0,0,0),(1,1,1,1),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(0,1,0,0),(0,1,0,0))),
  (((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,1,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,1,0,0),(0,1,0,0),(0,1,0,0),(0,0,0,0)),
   ((0,0,1,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,0,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,1,1,0),(1,0,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,1,0,0),(1,0,0,0),(1,0,0,0),(0,0,0,0)),
   ((1,1,1,0),(0,0,1,0),(0,0,0,0),(0,0,0,0)),
   ((0,1,0,0),(0,1,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,1,1,0),(0,0,0,0),(0,0,0,0))),
  (((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0)),
   ((0,1,0,0),(1,1,1,0),(0,1,0,0),(0,0,0,0))),
  (((1,1,1,0),(1,0,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,1,0,0),(1,1,0,0),(0,0,0,0)),
   ((1,0,1,0),(1,1,1,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(1,0,0,0),(1,1,0,0),(0,0,0,0))),
  (((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0))),
  (((1,0,0,0),(1,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,0,0,0),(1,0,0,0),(0,0,0,0),(0,0,0,0)),
   ((1,1,0,0),(0,0,0,0),(0,0,0,0),(0,0,0,0)))
  );

  colors : Array [1..12] of Integer = (clAqua, clBlue, clFuchsia, clGreen,
  clLime, clMaroon, clNavy, clOlive, clPurple, clRed, clTeal, clYellow);

  stkw = 10;
  stkh = 20;
  sqrs = 15;

var
  Form1: TForm1;
  tetr, nexttetr : TTetr;
  num, nextnum : Integer;
  gen, nextgen : Integer;
  fcl,nextfcl : Integer;
  x,y : Integer;
  scores : Integer;
  stakan : Array [-3..stkh, 1..stkw] of Integer;
  reg : TRegistry;


implementation



{$R *.DFM}



procedure setspeed(s : Byte);
begin
  Form1.Label2.Caption := 'Ñêîðîñòü: ' + IntToStr(s);
  Form1.Timer1.Interval := 500 - (s-1) * 100;
end;

procedure drawsquare(i,j,c : Integer; cnv : TCanvas);
var
  x,y : Integer;
begin
  x := (j-1)*sqrs;
  y := (i-1)*sqrs;
  with cnv do
  begin
    Brush.Color := c;
    FillRect(Bounds(x+2,y+2,sqrs-3,sqrs-3));
    Pen.Color := clLtGray;
    MoveTo(x,y);
    LineTo(x+sqrs,y);
    MoveTo(x,y);
    LineTo(x,y+sqrs);
    Pen.Color := clWhite;
    MoveTo(x+1,y+1);
    LineTo(x+sqrs-2,y+1);
    MoveTo(x+1,y+1);
    LineTo(x+1,y+sqrs-2);
    Pen.Color := clBlack;
    MoveTo(x+sqrs-1,y+sqrs-1);
    LineTo(x,y+sqrs-1);
    MoveTo(x+sqrs-1,y+sqrs-1);
    LineTo(x+sqrs-1,y);
    MoveTo(x+sqrs-2,y+sqrs-2);
    LineTo(x+1,y+sqrs-2);
    MoveTo(x+sqrs-2,y+sqrs-2);
    LineTo(x+sqrs-2,y+1);
  end;
end;

procedure showfigure;
var
  i,j : Integer;
begin
  for i:=1 to 4 do
    for j:=1 to 4 do
      if tetr[i,j]=1 then drawsquare(i+y-1,j+x-1,fcl,Form1.Image1.Canvas);
end;

procedure erasesquare(i,j : Integer);
var x,y : Integer;
begin
  Form1.Image1.Canvas.Brush.Color := clGray;
  x := (j-1)*sqrs;
  y := (i-1)*sqrs;
  Form1.Image1.Canvas.FillRect(Bounds(x,y,sqrs,sqrs));
end;

procedure hidefigure;
var
  i,j: Integer;
begin
  for i:=1 to 4 do
    for j:=1 to 4 do
      if tetr[i,j]=1 then erasesquare(i+y-1,j+x-1);
end;

Последний раз редактировалось Stilet; 29.05.2008 в 07:52.
Luden вне форума Ответить с цитированием
Старый 28.05.2008, 16:13   #8
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
По умолчанию

дальше...
Код:
function canrotate : Boolean;
var i,j,k : Integer; t : TTetr;
begin
  result := true;
  k := num;
  if k < 4 then inc(k) else k := 1;
  t := tetramino[gen,k];
  for i := 1 to 4 do
    for j := 1 to 4 do
      if (t[i,j]=1) and ((stakan[i+y-1,j+x-1]>0)
      or (j-1+x-1<0) or (j+x>stkw+1) or (i+y>stkh+1)) then
      begin
        result := false;
        exit;
      end;
end;

procedure rotatefigure;
begin
  hidefigure;
  if num < 4 then inc(num) else num := 1;
  tetr := tetramino[gen,num];
  showfigure;
end;

procedure gennextfigure;
begin
  nextgen := random(11)+1;
  nextnum := random(4)+1;
  nexttetr := tetramino[nextgen,nextnum];
  nextfcl := colors[random(12)+1];
end;

procedure nextfigure;
var i,j : Integer;
label go;
begin
  gen := nextgen;
  num := nextnum;
  tetr := nexttetr;
  fcl := nextfcl;
  for i := 4 downto 1 do
    for j := 1 to 4 do
      if tetr[i,j]=1 then begin y := -3+(4-i); goto go; end;
  go:
  x := 4;
  gennextfigure;
  Form1.Image2.Canvas.Brush.Color := clGray;
  Form1.Image2.Canvas.FillRect(Bounds(0,0,sqrs*4,sqrs*4));
  for i := 1 to 4 do
    for j := 1 to 4 do
      if nexttetr[i,j]=1 then drawsquare(i,j,nextfcl,Form1.Image2.Canvas);
end;

procedure newgame;
var i,j : Integer;
begin
  for i := -3 to stkh do
    for j := 1 to stkw do
      stakan[i,j] := 0;
  Form1.Image1.Canvas.Brush.Color := clGray;
  Form1.Image1.Canvas.FillRect(Bounds(0,0,sqrs*stkw,sqrs*stkh));
  scores := 0;
  Form1.Label1.Caption := 'Î÷êè: ' + IntToStr(scores);
  setspeed(1);
  randomize;
  gennextfigure;
  nextfigure;
  showfigure;
  Form1.Label3.Caption := '';
  Form1.Timer1.Enabled := True;
end;

function canmoveleft : Boolean;
var i,j : Integer;
begin
  result := true;
  for i := 1 to 4 do
    for j := 1 to 4 do
      if (tetr[i,j]=1) and ((stakan[i+y-1,j-1+x-1]>0) or (j-1+x-1=0)) then
      begin
        result := false;
        exit;
      end;
end;

function canmoveright : Boolean;
var i,j : Integer;
begin
  result := true;
  for i := 1 to 4 do
    for j := 1 to 4 do
      if (tetr[i,j]=1) and ((stakan[i+y-1,j+x]>0) or (j+x=stkw+1)) then
      begin
        result := false;
        exit;
      end;
end;

Последний раз редактировалось Stilet; 29.05.2008 в 07:53.
Luden вне форума Ответить с цитированием
Старый 28.05.2008, 16:14   #9
Карась
Участник клуба
 
Аватар для Карась
 
Регистрация: 26.10.2007
Сообщений: 1,244
По умолчанию

Это работает?

То что Вам не понятно - это процедуры.
Они нужны для того чтоб переместить/перевернуть фигуру и т.д.
Умом Россию не понять, пока не выпито ноль пять,
А если выпито ноль пять всё делом кажется не хитрым,
Попытка глубже понимать уже попахивает литром...
Карась вне форума Ответить с цитированием
Старый 28.05.2008, 16:15   #10
Luden
Пользователь
 
Регистрация: 28.05.2008
Сообщений: 10
По умолчанию

Код:
function canmovedown : Boolean;
var i,j : Integer;
begin
  result := true;
  for i := 4 downto 1 do
    for j := 1 to 4 do
      if (tetr[i,j]=1) and ((stakan[i+y,j+x-1]>0) or (i+y=stkh+1)) then
      begin
        result := false;
        exit;
      end;
end;

function gameover : Boolean;
var
  i : Integer;
begin
  Result := False;
  for i := 1 to stkw do
    if stakan[0,i]>0 then
    begin
      Result := True;
      Exit;
    end;
end;

procedure checkstakan;
var i,j,k,l,c : Integer;
begin
  with Form1.Image1.Canvas do
  begin
    l := 0;
    for i := 1 to stkh do
    begin
      c := 0;
      for j := 1 to stkw do if stakan[i,j]>0 then inc(c);
      if c = stkw then
      begin
        Inc(l);
        for k := 1 to stkw do erasesquare(i,k);
        for k := 1 to i-1 do
          for j := 1 to stkw do
          begin
            stakan[i-k+1,j] := stakan[i-k,j];
            if stakan[i-k+1,j]>0 then
              drawsquare(i-k+1,j,stakan[i-k+1,j],Form1.Image1.Canvas);
            stakan[i-k,j] := 0;
            erasesquare(i-k,j);
          end;
      end;
    end;
    scores := scores + l * 10;
    if (scores >= 300)  and (scores < 1000)  then setspeed(2);
    if (scores >= 1000) and (scores < 3000)  then setspeed(3);
    if (scores >= 3000) and (scores < 10000) then setspeed(4);
    if (scores >= 10000) then setspeed(5);
    Form1.Label1.Caption := 'Î÷êè: '+IntToStr(scores);
  end;
end;

procedure fixfigure;
var i,j : Integer;
begin
  for i := 1 to 4 do
    for j := 1 to 4 do
      if tetr[i,j]=1 then stakan[y+i-1,x+j-1] := fcl;
end;

procedure stopmove;
begin
  fixfigure;
  checkstakan;
  if not gameover then
  begin
    nextfigure;
    showfigure;
  end
  else
  begin
    Form1.Timer1.Enabled := False;
    Application.MessageBox(PChar('Game Over!'),PChar('Òåòðèñ'),
    MB_ICONINFORMATION+MB_OK);
  end;
end;

procedure moveleft;
begin
  hidefigure;
  dec(x);
  showfigure;
end;

procedure moveright;
begin
  hidefigure;
  inc(x);
  showfigure;
end;

procedure movedown;
begin
  hidefigure;
  inc(y);
  showfigure;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if not gameover then
  case key of
    37: if Timer1.Enabled and canmoveleft then moveleft;
    38: if Timer1.Enabled and canrotate then rotatefigure;
    39: if Timer1.Enabled and canmoveright then moveright;
    40: if Timer1.Enabled and canmovedown then movedown else stopmove;
    {49..53: setspeed(Key - 48);}
    32: if Timer1.Enabled then
        begin
          while canmovedown do movedown;
          stopmove;
        end;
    19: begin
          if Timer1.Enabled then
          begin                                                                                                                                                                                                                                        
            Label3.Caption := 'Ïàóçà!';
            Timer1.Enabled := False;
          end
          else
          begin
            Label3.Caption := '';
            Timer1.Enabled := True;
          end;
        end;
  end;
end;

procedure TForm1.mnuNewClick(Sender: TObject);
var te : Boolean;
begin
te := Timer1.Enabled;
  if te then Timer1.Enabled := False;
  if Application.MessageBox(PChar('Âû äåéñòâèòåëüíî õîòèòå íà÷àòü íîâóþ èãðó?'),
  PChar('Òåòðèñ'), MB_ICONQUESTION+MB_YESNO) = IDYES then
  newgame
  else
  Timer1.Enabled := te;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if canmovedown then movedown else stopmove;
end;

Последний раз редактировалось Stilet; 29.05.2008 в 07:54.
Luden вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
помогите разобраться Tanuska___:) БД в Delphi 1 04.09.2008 14:56
Помогите разобраться! Holodok Помощь студентам 12 02.05.2008 18:13
Помогите разобраться(с таблицами). Delphi. Vindigo Помощь студентам 7 29.12.2007 08:55
помогите разобраться с Rss Hallo HTML и CSS 0 24.11.2006 18:44