Одновременное нажатие стрелок

[Андрей19930323]

Пишу графическую программку. Не могу сделать передвижение графического объекта при нажатии двух стрелок одновременно. Подскажите, пожалуйста,как это сделать. Внизу код программы.

unit Unit1;

interface

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

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

var
   Form1: TForm1;
   form,burd,plan: TBitmap;
   x,y: integer;

implementation

{$R *.dfm}

procedure TForm1.Timer1Timer(Sender: TObject);
begin
   form.Canvas.Draw(0, 0, burd);
   form.Canvas.Draw(x, y, plan);
   Form1.Canvas.Draw(0, 0, form);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   Form1.Width := 1280;
   Form1.Height := 800;

   burd:= TBitmap.Create;
   burd.LoadFromFile('burd.bmp');
   burd.Width:= 1280;
   burd.Height:= 800;

   form:= TBitmap.Create;
   form.LoadFromFile('burd.bmp');
   form.Width:= 1280;
   form.Height:= 800;
   Canvas.Draw(0, 0, burd);

   plan:= TBitmap.Create;
   plan.LoadFromFile('plan.bmp');
   plan.Transparent:= True;
   plan.TransparentColor:= plan.Canvas.Pixels[1,1];
   Canvas.Draw(120, 120, plan);
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
const
   n = 5;
begin
   Timer1.Enabled:= true;

   if Key = 37 then
     x:= x - n;

   if Key = 38 then
     y:= y - n;

   if Key = 39 then
     x:= x + n;

   if Key = 40 then
     y:= y + n;

   if Key = ord(' ') then
     y:= y - 666;

   {if ((key=37) and (key=38)) then
     begin
      x:= x - n;
      y:= y - n;
      end; }
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
   Timer1.Enabled:= false;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
      form.Destroy;
      burd.Destroy;
      plan.Destroy;
      Timer1.Enabled:= false;
end;

end.

[Hacker19_90]

Ох... мда точно не скажу
но попробуй так
проверять по VK
типо так

if Key = КОД_СТРЕЛКИ_НА_ВЕРХ(я не помню) and VK_LEFT in Shift then
   обрабатывай вверх на лево

тоже и для VK_DOWN VK_RIGHT VK_UP

[Андрей19930323]

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

Ох... мда точно не скажу
но попробуй так

if Key = КОД_СТРЕЛКИ_НА_ВЕРХ(я не помню) and VK_LEFT in Shift then
   обрабатывай вверх на лево

сделал

   if (key=ord('38')) and VK_LEFT in Shift then
     begin
      y:= y - n;
      x:= x - n;
      end;

компилятор находит какую то ошибку(

[Hacker19_90]

ord(38)

?
да вы шутите! код строки 38 откуда компидятор его знает
как то так

 if (key = 38) and (VK_LEFT in Shift) then
     begin
      y:= y - n;
      x:= x - n;
      end;

[Андрей19930323]

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

ord(38)

?
да вы шутите! код строки 38 откуда компидятор его знает

тупанул что то))

Сообщение от как то так

 if (key = 38) and (VK_LEFT in Shift) then
     begin
      y:= y - n;
      x:= x - n;
      end;

теперь компилятор пишет несовместимые типы

[Hacker19_90]

вы в OnKeyDown или OnKeyPress обрабатываете?

[Андрей19930323]

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

вы в OnKeyDown или OnKeyPress обрабатываете?

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);

[Hacker19_90]

Так всё осинило!
Shift хранит состояние хлавишь Ctrl Shift Alt
Что вам делать
Либо через GetAsyncKeyState/GetKeyState либо делать вот так

var
  Form1: TForm1;
  Old_key: word;
implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Old_Key := 0;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  if Old_Key = 0  then
    Old_Key := Key;
  if (key = VK_UP) and (Old_key = VK_LEFT) then
  begin
    Label1.Caption := 'KEY_DOWn';
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  if Old_Key <> 0 then
  begin
    Old_KEy := 0;
    Label1.Caption := 'Key UP'
  end;

end;

ток соответствеено проверяйте все сочитания клавиш
Ток сработает ли это я не знаю!

[GreenWizard]

procedure tform1.Check;
begin
  if Hi(GetKeyState(VK_LEFT) > 0 then
    // äâèãàåì âëåâî
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift:
  TShiftState);
begin
  Check;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
begin
  Check;
end;

procedure TForm1.tmr1Timer(Sender: TObject);
begin
  Check;
end;

и не паримся, и всем нравимся) только может на GetAsyncKeyState придётся перейти
вообще же, всё это убого, лучше замутить сингелтон KeyboardManager и через его интерфейс получать состояние клавиш... тогда будет легче менять логику взаимодействия с устройствами ввода


все вопросы к хакеру, он же девелопер, а я так, жалкий архитектор =) спать смылся

[EUGY]

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;  Shift: TShiftState);
var tk: TKeyboardState;
begin
 GetKeyboardState(tk);
 if 0 <> tk[VK_LEFT]  then
  // чего_то_там
 if 0 <> tk[VK_RIGHT]  then
  // итд
end;