Пишу "змейку", не могу сделать управление

SmoceR · #1 23.06.2012, 18:03

Как начинающий программист решил попробовать написать "змейку". Мне нужно сделать так, чтобы прямоугольник-змейка (пока что) просто изменял направление своего движения при нажатии на одну из кнопок-стрелок (тех, что рядом с RCTRL).
Пробовал как через FormKeyDown, так и через FormKeyPress.
Код:

Код:

unit thesnake;

interface

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

type
  TForm1 = class(TForm)
    GameBoard: TPaintBox;
    Timer1: TTimer;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  len, wid, speed, bX, bY, frX, frY : integer;
  SnakeDirR, SnakeDirD, SnakeDirL, SnakeDirU : boolean;

implementation

{$R *.dfm}


procedure TForm1.Button1Click(Sender: TObject);
begin
  wid := 10;
  len := 90;
  bX := 200;
  bY := 50;
  frX := bX + len;
  frY := bY + wid;
  speed := 2;
  GameBoard.Canvas.Brush.Color := rgb(0,0,0);
  GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
  GameBoard.Canvas.Brush.Color := rgb(0,255,8);
  GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  if Timer1.Enabled then Timer1.Enabled := false else Timer1.Enabled := true
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin

  if SnakeDirR then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bX := bX + speed;
    frX := bX + len;
    frY := bY + wid;
  end;

  if SnakeDirD then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bY := bY + speed;
    frX := bX + len;
    frY := bY + wid;
  end;

  if SnakeDirL then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bX := bX - speed;
    frX := bX + len;
    frY := bY + wid;
  end;

  if SnakeDirU then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bY := bY - speed;
    frX := bX + len;
    frY := bY + wid;
  end;

end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case key of
  39 : begin SnakeDirR:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirU:=false; end;
  40 : begin SnakeDirD:=true; SnakeDirL:=false; SnakeDirU:=false; SnakeDirR:=false; end;
  37 : begin SnakeDirL:=true; SnakeDirD:=false; SnakeDirR:=false; SnakeDirU:=false; end;
  38 : begin SnakeDirU:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirR:=false; end;
  end;
end;


procedure TForm1.FormKeyPress(Sender: TObject; var Key: Char);
begin
  case key of
  chr(39) : begin SnakeDirR:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirU:=false; end;
  chr(40) : begin SnakeDirD:=true; SnakeDirL:=false; SnakeDirU:=false; SnakeDirR:=false; end;
  chr(37) : begin SnakeDirL:=true; SnakeDirD:=false; SnakeDirR:=false; SnakeDirU:=false; end;
  chr(38) : begin SnakeDirU:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirR:=false; end;
  end;
end;

end.

ALexandr555 · #2 23.06.2012, 22:57

нажатия не происходит, фокус на кнопках

SmoceR · #3 23.06.2012, 23:08

в смысле? другие коды кнопок должны быть?
Вы не могли бы подсказать, что конкретно надо исправить?

ALexandr555 · #4 23.06.2012, 23:10

да нет, если кнопки убрать и поставить брекпоинт то видно что срабатывает, а так фокус на кнопках двух они ловят клики

ALexandr555 · #5 23.06.2012, 23:18

Может фигню посоветую но вот так у меня заработало, через горячие клавиши, да и у таймера надо тогда по умолчанию поставить Enabled:=False;
а то при запуске формы сразу он работает

Код:

unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls,xpMan;
 
type
  TForm1 = class(TForm)
    Timer1: TTimer;
    GameBoard: TPaintBox;
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
   procedure OnHotKey(var Msg: TWMHotKey); message WM_HOTKEY;
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  len, wid, speed, bX, bY, frX, frY : integer;
  SnakeDirR, SnakeDirD, SnakeDirL, SnakeDirU : boolean;
 
implementation

{$R *.dfm}

 
procedure TForm1.Button1Click(Sender: TObject);
begin
  wid := 10;
  len := 90;
  bX := 200;
  bY := 50;
  frX := bX + len;
  frY := bY + wid;
  speed := 10;
  GameBoard.Canvas.Brush.Color := rgb(0,0,0);
  GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
  GameBoard.Canvas.Brush.Color := rgb(0,255,8);
  GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
  Form1.SetFocus;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  if Timer1.Enabled then Timer1.Enabled := false else Timer1.Enabled := true;
  Form1.SetFocus;
end;
 
procedure TForm1.Timer1Timer(Sender: TObject);
begin

  if SnakeDirR then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bX := bX + speed;
    frX := bX + len;
    frY := bY + wid;
  end;
 
  if SnakeDirD then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bY := bY + speed;
    frX := bX + len;
    frY := bY + wid;
  end;
 
  if SnakeDirL then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bX := bX - speed;
    frX := bX + len;
    frY := bY + wid;
  end;
 
  if SnakeDirU then
  begin
    GameBoard.Canvas.Brush.Color := rgb(0,0,0);
    GameBoard.Canvas.Rectangle(0,0,GameBoard.Width,GameBoard.Height);
    GameBoard.Canvas.Brush.Color := rgb(0,255,8);
    GameBoard.Canvas.Rectangle(bX,bY,frX,frY);
    GameBoard.Canvas.Rectangle(bX-1,bY,bX,frY);
    bY := bY - speed;
    frX := bX + len;
    frY := bY + wid;
  end;

end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 RegisterHotKey(Handle,39, 0,39);
 RegisterHotKey(Handle,40, 0,40);
 RegisterHotKey(Handle,37, 0,37);
 RegisterHotKey(Handle,38, 0,38);
end;

procedure TForm1.OnHotKey(var Msg: TWMHotKey);
begin
case msg.HotKey of
  39 : begin SnakeDirR:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirU:=false; end;
  40 : begin SnakeDirD:=true; SnakeDirL:=false; SnakeDirU:=false; SnakeDirR:=false; end;
  37 : begin SnakeDirL:=true; SnakeDirD:=false; SnakeDirR:=false; SnakeDirU:=false; end;
  38 : begin SnakeDirU:=true; SnakeDirD:=false; SnakeDirL:=false; SnakeDirR:=false; end;
  end;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 UnregisterHotKey(Handle,37);
 UnregisterHotKey(Handle,38);
 UnregisterHotKey(Handle,39);
 UnregisterHotKey(Handle,40);
end;

end.

Snake22 · #6 23.06.2012, 23:45

чтоб не заморачиваться с горячими клавишами, я помню использовал для управления стрелками TActionList и там создавал новое действие,и устанавливал в качесвте горячих кнопок кнопки стрелок.для каждой кнопки свое событие.
ну впринципе это тоже хоткеи но не надо париться регистрировать их.
если интересно пример приаттачил

ALexandr555 · #7 24.06.2012, 00:11

Цитата:

Сообщение от Snake22

чтоб не заморачиваться с горячими клавишами, я помню использовал для управления стрелками TActionList и там создавал новое действие,и устанавливал в качесвте горячих кнопок кнопки стрелок.для каждой кнопки свое событие.
ну впринципе это тоже хоткеи но не надо париться регистрировать их.
если интересно пример приаттачил

ну регистрировать то чуток строчек добавить, я думал есть решение не через хоткеи, а с фокусом например мутить что

Bargest · #8 24.06.2012, 01:46

Можно использовать GetKeyState(...).

Pyro · #9 24.06.2012, 08:06

накидал змейку с классами, строчек примерно столько же, но умеет больше
(управление решил через Form.keypreview)

ALexandr555 · #10 24.06.2012, 10:09

Цитата:

Сообщение от Pyro

накидал змейку с классами, строчек примерно столько же, но умеет больше
(управление решил через Form.keypreview)

прикольно, ну тк кнопок нет же вот и нет проблем

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты