Обработка нажатия и отпускания клавиш

casperock · #1 04.01.2014, 19:28

Доброго времени суток всем.
Есть такой вопрос. К примеру, есть батон на форме, когда на нее нажимаешь - воспроизводиться файл, когда отпускаешь - воспроизведение прекращается. Это в общем не проблема, мышкой я сделал это через события OnMouseDown и OnMouseUp, сделать управление кнопкой через стрелочку на клавиатуре не выходит. Вот пример кода, который почемуто работает при нажатии Ctrl.

Код:

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if GetKeyState(VK_LEFT) <> 0 then
MediaPlayer1.FileName:='1.mp3';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;

Windows 7, Delphi 7.
Заранее благодарю за помощь.

poli-smen · #2 04.01.2014, 21:03

Цитата:

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

Вот пример кода, который почемуто работает при нажатии Ctrl.

Код:

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if GetKeyState(VK_LEFT) <> 0 then
MediaPlayer1.FileName:='1.mp3';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;

Заключи в операторные скобки begin..end всё что должно выполниться при выполнении условия.

casperock · #3 05.01.2014, 22:30

Цитата:

Сообщение от poli-smen

Заключи в операторные скобки begin..end всё что должно выполниться при выполнении условия.

Спасибо, но все равно не помогло. Вот весь код с импровизацией:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    MediaPlayer1: TMediaPlayer;
    procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Button1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MediaPlayer1.FileName:='1.mp3';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
MediaPlayer1.Stop;

end;

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if GetKeyState(VK_LEFT) <> 0 then
begin;
MediaPlayer1.FileName:='1.mp3';
MediaPlayer1.Open;
MediaPlayer1.Play;
end;
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
MediaPlayer1.Stop;
end;

end.

Alegun · #4 06.01.2014, 01:34

Похоже здесь всё дело в повторах нажатия клавиши - даже при отпускании из буфера клавы идёт повтор на запуск, попробуйте вот так

Код:

var flg: boolean = true;
procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if GetKeyState(VK_LEFT) <> 0 then flg:= true;
end;

procedure TForm1.Button1KeyPress(Sender: TObject; var Key: Char);
begin
 if flg then
  begin
   MediaPlayer1.FileName:='1.mp3';
   MediaPlayer1.Open;
   MediaPlayer1.Play;
  end;
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  flg:= false;
 MediaPlayer1.Stop;
end;

не проверял, нечем, но так должно сработать

З.Ы. Косяк только сейчас заметил -

вместо

Код:

if GetKeyState(VK_LEFT) <> 0 then flg:= true;

нужно

Код:

if Key = VK_LEFT then flg:= true;

casperock · #5 06.01.2014, 02:06

Цитата:

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

Похоже здесь всё дело в повторах нажатия клавиши - даже при отпускании из буфера клавы идёт повтор на запуск, попробуйте вот так

Код:

var flg: boolean = true;
procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if GetKeyState(VK_LEFT) <> 0 then flg:= true;
end;

procedure TForm1.Button1KeyPress(Sender: TObject; var Key: Char);
begin
 if flg then
  begin
   MediaPlayer1.FileName:='1.mp3';
   MediaPlayer1.Open;
   MediaPlayer1.Play;
  end;
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  flg:= false;
 MediaPlayer1.Stop;
end;

не проверял, нечем, но так должно сработать

Спасибо, попробовал. К сожалению не подошло, с мышки все работает отлично. А вот если зажать любую стрелочку на клавиатуре во время работы программы, никаких действий не происходит. А как только отпускаешь зажатую стрелочку - вылазит ошибка "No MCI device open". Как я понимаю, то что я отпустил кнопку программа видит и реагирует вот так:

Код:

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
flg:= false;
MediaPlayer1.Stop;
end;

Но вылазит ошибка, т.к. программа почему-то не понимает когда я нажимаю клавишу, но отлично понимает когда я её отпускаю и соответственно дает команду компоненту TMediaPlayer прекратить воспроизведение трека, а компонент не понимает что от него хотят и выдает ерорр =((

Alegun · #6 06.01.2014, 02:16

Извнт за ляп, тогда отмена, попробуйте вот так

Код:

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then
  begin
   MediaPlayer1.FileName:='1.mp3';
   MediaPlayer1.Open;
   MediaPlayer1.Play;
  end;
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then MediaPlayer1.Stop;
end;

З.Ы. Тяжело без делфи код под неё собирать, извнт :-)

casperock · #7 06.01.2014, 02:32

Цитата:

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

Извнт за ляп, тогда отмена, попробуйте вот так

Код:

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then
  begin
   MediaPlayer1.FileName:='1.mp3';
   MediaPlayer1.Open;
   MediaPlayer1.Play;
  end;
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then MediaPlayer1.Stop;
end;

З.Ы. Тяжело без делфи код под неё собирать, извнт :-)

Спасибо за старание помочь, но увы((
Сейчас заметил такую штуку, если запустить программу и сразу нажимать стрелочки - вылазит "No MCI device open", а если нажать мышкой, а потом стрелочки - ошибки уже нет. Но и воспроизведения тоже.

Это не может быть из-за того что у меня Window 7?

Alegun · #8 06.01.2014, 02:42

Вот ещё вариант

Код:

procedure mpc (ds: boolean);
begin
 if ds then
begin;
 Form1.MediaPlayer1.FileName:='1.mp3';
 Form1.MediaPlayer1.Open;
 Form1.MediaPlayer1.Play;
end else
 begin
 Form1.MediaPlayer1.Stop;
 Form1.MediaPlayer1.Close;
 end;
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mpc(true)
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mpc(false);
end;

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then mpc(true);
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then mpc(false);
end;

будет работать?

casperock · #9 06.01.2014, 02:56

Цитата:

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

Вот ещё вариант

Код:

procedure mpc (ds: boolean);
begin
 if ds then
begin;
 Form1.MediaPlayer1.FileName:='1.mp3';
 Form1.MediaPlayer1.Open;
 Form1.MediaPlayer1.Play;
end else
 begin
 Form1.MediaPlayer1.Stop;
 Form1.MediaPlayer1.Close;
 end;
end;

procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mpc(true)
end;

procedure TForm1.Button1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 mpc(false);
end;

procedure TForm1.Button1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then mpc(true);
end;

procedure TForm1.Button1KeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then mpc(false);
end;

будет работать?

Так же как и раньше. Только с отличием, теперь ошибка вылазить только на левую стрелку, а не на все стрелки как раньше. Но суть та же, ошибка((

Alegun · #10 06.01.2014, 04:29

Возможное решение
1. Не используйте TButton, лучше напр. ТSpeedButton т.к. у него нет фокуса (по умолчанию Tab и стрелки переключают фокус между визуальными компонентами его имеющими)
2. Используйте процедуры Key/Mouse/Down/App у самой формы, код будет примерно такой

Код:

var flg: boolean = true;
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then
  begin
   if flg then
    begin
     MediaPlayer1.FileName:='1.mp3';
     MediaPlayer1.Open;
     flg:=false;
    end;
   MediaPlayer1.Play;
  end;
end;

procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
 if Key = VK_LEFT then
  begin
   MediaPlayer1.Close;
   flg:=true;
  end;
 end;

procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 MediaPlayer1.FileName:='1.mp3';
 MediaPlayer1.Open;
 MediaPlayer1.Play;
end;

procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 MediaPlayer1.Close;
end;

выходит не нужно каждый раз открывать MCI интерфейс проигрывателя, наверное так

casperock · #11 06.01.2014, 05:20

Огромное спасибо!) Отлично помогло, буквально за 20 минут уже готовое решение.

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

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

Этот пользователь сказал Спасибо Alegun за это полезное сообщение:
casperock (06.01.2014)