Консультации Портала - Консультация #174009

Задать вопрос Консультации Пользователи Форум

Задать вопрос экспертам

Консультация № 174009

06.11.2009, 11:42

0.00 руб.

0 10 0

Компьютеры Программирование

Уважаемые эксперты помогите с задачей.
Есть графический компонент TMyGraph = class(TGraphicControl)
Понадобилась добавить функционал. Обработка нажатых клавиш.
Пробовала вставить обработчики
procedure WMChar(var Message: TWMChar); message WM_CHAR;
procedure WMKeyUp(var Message: TWMKeyUp); message WM_KEYUP;
procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
сообщения от клавиатуры не приходят
Если мы переприсвоим обработчик WindowProc := MyWndProc;
в него также сообщения от клавиатуры не приходят
Если переопределить

procedure WndProc(var Message: TMessage); override;
begin
if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
begin
Тут тоже не приходит сообщения.
end;
inherited WndProc(Message);
end;

Как отлавить нажатия клавиш в компоненте являющемся наследником от TControl
унаследовать от TWinControl - не предлагать.

Обсуждение

давно

Евгений/Genia007/

Профессионал
153662
1070

06.11.2009, 17:07

общий

Можно поподробнее, что это за компонент, какие функции он выполняет, в какой среде разрабатывался и работает?

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

06.11.2009, 20:41

общий

Используется Delphi 2009. Компонет работает нормально. Нужно только добавить фукционал.
Не могу отловить события от клавиатуры.

давно

Евгений/Genia007/

Профессионал
153662
1070

06.11.2009, 20:51

общий

Нужен сам компонент для исследования или он идёт в поставки с Delphi 2009.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

07.11.2009, 13:19

общий

Вот тестовое приложение

Код:


unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure KeyEvent ( ch: Char);
    procedure MessageEvent ( cMes: Integer);
  private
    MyGraphic :TMyGraphic;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyGraphic := TMyGraphic.Create(Self);
  MyGraphic.Parent := self;
  MyGraphic.Align  := alClient;
  MyGraphic.OnKeyEvent := KeyEvent;
  MyGraphic.OnMessageEvent := MessageEvent;
end;

procedure TForm1.KeyEvent(ch: Char);
begin
  Caption := ch;
end;

procedure TForm1.MessageEvent(cMes: Integer);
begin
   Caption := IntToStr(cMes);
end;

end.

И сам компонент

Код:

unit GraphicControl1;

interface

uses
  SysUtils, Classes, Controls, Graphics, Messages;

type

  TOnKeyEvent      = procedure( ch: Char) of object;
  TOnMessageEvent  = procedure( cMes: Integer) of object;

  TMyGraphic = class(TGraphicControl)
  private
    FLastKeyPress: Char;
    FOnKeyEvent: TOnKeyEvent;
    FOnMessageEvent: TOnMessageEvent;

  protected
    procedure Paint; override;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WndProc(var Message: TMessage); override;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
  public
    constructor Create (AOwner:TComponent);override;
  published
   property LastKeyPress :Char read  FLastKeyPress write  FLastKeyPress;
   property OnKeyEvent: TOnKeyEvent  read FOnKeyEvent write FOnKeyEvent;
   property OnMessageEvent: TOnMessageEvent  read FOnMessageEvent write FOnMessageEvent;

  end;

implementation

constructor TMyGraphic.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  Width:=60;
  Height:=40;
end;

procedure TMyGraphic.Paint;
begin
   inherited;
    with Canvas do
    begin
      Brush.Color := clBlue;
      FillRect(Rect(10, 10, Width - 14, Height-14));
    end;
end;

procedure TMyGraphic.WMChar(var Message: TWMChar);
begin
   with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMKeyDown(var Message: TWMKeyDown);
begin
  with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMSysKeyDown(var Message: TWMSysKeyDown);
begin
    with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WndProc(var Message: TMessage);
begin
  if assigned (OnMessageEvent)then FOnMessageEvent(Message.Msg);

  if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
  begin
     FLastKeyPress := 'A';
   end;
  inherited WndProc(Message);
end;

end.

Как видим при запуске приложения при нажатии кнопок сообщения не отрабатываются

давно

Евгений/Genia007/

Профессионал
153662
1070

07.11.2009, 14:00

общий

По крайнем мере вот сюда
procedure WndProc(var Message: TMessage); override;
begin
if (Message.Msg >= WM_KEYFIRST) and (Message.Msg <= WM_KEYLAST) then
begin
Тут тоже не приходит сообщения.
end;
inherited WndProc(Message);
end;
сообщения не приходят потому что не выполняется условие проверки.
Да и эта процедура
procedure TForm1.KeyEvent(ch: Char);
begin
Caption := ch;
end;
тоже не получает сообщения от клавиатуры.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

07.11.2009, 15:04

общий

Каким метом в TMyGraphic. отловить нажатия клавишь?

давно

Евгений/Genia007/

Профессионал
153662
1070

07.11.2009, 16:03

общий

Вот что я могу Вам предложить как пример.

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure KeyEvent ( ch: Char);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    MyGraphic :TMyGraphic;
    procedure ProcessFormMessages(var Msg: tMsg; var Handled: Boolean);  //  Новая процедура
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
  { Делаем ссылку на нового обработчика сообщений }
  Application.OnMessage := ProcessFormMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyGraphic := TMyGraphic.Create(Self);
  MyGraphic.Parent := self;
  MyGraphic.Align  := alClient;
  MyGraphic.OnKeyEvent := KeyEvent;
end;

procedure TForm1.KeyEvent(ch: Char);
begin
  Caption := ch; 
end;

procedure TForm1.ProcessFormMessages(var Msg: tMsg;
  var Handled: Boolean);
begin
  { проверка наличия системного сообщения KeyDown }
  case Msg.Message of
    WM_KEYDOWN: begin
                  MyGraphic.KEYDOWN(Msg.wParam);
                  { сообщаем о том, что сообщение обработано }
                  Handled := True;
                end;
  end;
end;

end.

в компоненте

Код:

unit GraphicControl1;

interface

uses
  SysUtils, Classes, Controls, Graphics, Messages;

type

  TOnKeyEvent      = procedure( ch: Char) of object;
  TOnMessageEvent  = procedure( cMes: Integer) of object;

  TMyGraphic = class(TGraphicControl)
  private
    FLastKeyPress: Char;
    FOnKeyEvent: TOnKeyEvent;
    FOnMessageEvent: TOnMessageEvent;

  protected
    procedure Paint; override;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
  public
    constructor Create (AOwner:TComponent);override;
  published
   property LastKeyPress :Char read  FLastKeyPress write  FLastKeyPress;
   property OnKeyEvent: TOnKeyEvent  read FOnKeyEvent write FOnKeyEvent;
   property OnMessageEvent: TOnMessageEvent  read FOnMessageEvent write FOnMessageEvent;
   procedure KEYDOWN(i: integer);  //  Новая процедура
  end;

implementation

constructor TMyGraphic.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  Width:=60;
  Height:=40;
end;

procedure TMyGraphic.Paint;
begin
   inherited;
    with Canvas do
    begin
      Brush.Color := clBlue;
      FillRect(Rect(10, 10, Width - 14, Height-14));
    end;
end;

procedure TMyGraphic.WMChar(var Message: TWMChar);
begin
   with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMKeyDown(var Message: TWMKeyDown);
begin
  with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMSysKeyDown(var Message: TWMSysKeyDown);
begin
    with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.KEYDOWN(i: integer);  //  Новая процедура
begin
  FLastKeyPress := CHR(i);
  if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
end;

end.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Неизвестный

07.11.2009, 19:40

общий

Такой вариант не подходит.
Если бы компонент был один. А он вызывается и создается в разных формах.

Поэтому нужно именно в компоненте такую обработку сделать.

давно

Евгений/Genia007/

Профессионал
153662
1070

08.11.2009, 14:59

общий

Тогда появляется вопрос как определить что именно он должен получить сообщения от клавы если у него нет возможности на него перевести фокус?

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

давно

Евгений/Genia007/

Профессионал
153662
1070

08.11.2009, 15:14

общий

Вот так можно получать сообщения от клавиатуры в компонент и работать с другими компонентами на форме одновременно:
Компонент

Код:

unit GraphicControl1;

interface

uses
  SysUtils, Classes, Controls, Graphics, Messages, Windows;

type

  TOnKeyEvent      = procedure( ch: Char) of object;
  TOnMessageEvent  = procedure( cMes: Integer) of object;

  TMyGraphic = class(TGraphicControl)
  private
    FLastKeyPress: Char;
    FOnKeyEvent: TOnKeyEvent;
    FOnMessageEvent: TOnMessageEvent;

  protected
    procedure Paint; override;
    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
  public
    constructor Create (AOwner:TComponent);override;
  published
   property LastKeyPress :Char read  FLastKeyPress write  FLastKeyPress;
   property OnKeyEvent: TOnKeyEvent  read FOnKeyEvent write FOnKeyEvent;
   property OnMessageEvent: TOnMessageEvent  read FOnMessageEvent write FOnMessageEvent;
   procedure KEYDOWN(i: integer);
   procedure ProcessFormMessages(var Msg: tMsg; var Handled: Boolean);
  end;

implementation

constructor TMyGraphic.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  Width:=200;
  Height:=100;
end;

procedure TMyGraphic.Paint;
begin
   inherited;
    with Canvas do
    begin
      Brush.Color := clBlue;
      FillRect(Rect(10, 10, Width - 14, Height-14));
    end;
end;

procedure TMyGraphic.WMChar(var Message: TWMChar);
begin
   with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMKeyDown(var Message: TWMKeyDown);
begin
  with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMSysKeyDown(var Message: TWMSysKeyDown);
begin
    with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.KEYDOWN(i: integer);
begin
  FLastKeyPress := CHR(i);
  if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
end;

procedure TMyGraphic.ProcessFormMessages(var Msg: tMsg;
  var Handled: Boolean);
begin
  { проверка наличия системного сообщения KeyDown }
  case Msg.message of
    WM_KEYDOWN: begin
                  KEYDOWN(Msg.wParam);
                end;
  end;
end;

end.

Форма

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure KeyEvent ( ch: Char);
    procedure FormActivate(Sender: TObject);
  private
    { Private declarations }
    MyGraphic :TMyGraphic;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormActivate(Sender: TObject);
begin
  { Делаем ссылку на нового обработчика сообщений }
  Application.OnMessage := MyGraphic.ProcessFormMessages;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyGraphic := TMyGraphic.Create(Self);
  MyGraphic.Parent := self;
  {MyGraphic.Align  := alClient;}
  MyGraphic.OnKeyEvent := KeyEvent;
end;

procedure TForm1.KeyEvent(ch: Char);
begin
  Caption := ch; 
end;

end.

Или с несколькими формами

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure FormCreate(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
    MyGraphic :TMyGraphic;
  public
    { Public declarations }
    procedure ProcessFormMessages(var Msg: tMsg; var Handled: Boolean);
  end;

var
  Form1: TForm1;

implementation

uses Unit2;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  { Делаем ссылку на нового обработчика сообщений }
  Application.OnMessage := Form2.ProcessFormMessages1; 
  form2.show;
end;

procedure TForm1.FormActivate(Sender: TObject);
begin
  { Делаем ссылку на нового обработчика сообщений }
  Application.OnMessage := ProcessFormMessages; 
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  MyGraphic := TMyGraphic.Create(Self);
  MyGraphic.Parent := self;
  {MyGraphic.Align  := alClient;}
end;

procedure TForm1.ProcessFormMessages(var Msg: tMsg;
  var Handled: Boolean);
begin
  { проверка наличия системного сообщения KeyDown }
  case Msg.message of
    WM_KEYDOWN: begin
                  MyGraphic.KEYDOWN(Msg.wParam);
                  MyGraphic.Paint;
                  { сообщаем о том, что сообщение обработано }
                  {Handled := True; }
                end;
  end;
end;

end.

unit GraphicControl1;

interface

uses
  SysUtils, Classes, Controls, Graphics, Messages, Windows;

type

  TOnKeyEvent      = procedure( ch: Char) of object;
  TOnMessageEvent  = procedure( cMes: Integer) of object;

  TMyGraphic = class(TGraphicControl)
  private
    FLastKeyPress: Char;
    FOnKeyEvent: TOnKeyEvent;
    FOnMessageEvent: TOnMessageEvent;

  protected

    procedure WMSysKeyDown(var Message: TWMSysKeyDown); message WM_SYSKEYDOWN;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
    procedure WMChar(var Message: TWMChar); message WM_CHAR;
  public
    constructor Create (AOwner:TComponent);override;
  published
   property LastKeyPress :Char read  FLastKeyPress write  FLastKeyPress;
   property OnKeyEvent: TOnKeyEvent  read FOnKeyEvent write FOnKeyEvent;
   property OnMessageEvent: TOnMessageEvent  read FOnMessageEvent write FOnMessageEvent;
   procedure KEYDOWN(i: integer);
   procedure Paint; override;
  end;

implementation

constructor TMyGraphic.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  Width:=200;
  Height:=100;
end;

procedure TMyGraphic.Paint;
begin
   inherited;
    with Canvas do
    begin
      Brush.Color := random(256);
      FillRect(Rect(10, 10, Width - 14, Height-14));
    end;
end;

procedure TMyGraphic.WMChar(var Message: TWMChar);
begin
   with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMKeyDown(var Message: TWMKeyDown);
begin
  with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.WMSysKeyDown(var Message: TWMSysKeyDown);
begin
    with Message do
    begin
      FLastKeyPress := Char(CharCode);
      if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
  end;
end;

procedure TMyGraphic.KEYDOWN(i: integer);
begin
  FLastKeyPress := CHR(i);
  if assigned (OnKeyEvent)then FOnKeyEvent(FLastKeyPress);
end;

end.

unit Unit2;

interface

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

type
  TForm2 = class(TForm)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    MyGraphic :TMyGraphic;
  public
    { Public declarations }
    procedure ProcessFormMessages1(var Msg: tMsg; var Handled: Boolean);
  end;

var
  Form2: TForm2;

implementation

{$R *.dfm}

procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  { Делаем ссылку на нового обработчика сообщений }
  Application.OnMessage := form1.ProcessFormMessages; 
end;

procedure TForm2.FormCreate(Sender: TObject);
begin
  MyGraphic := TMyGraphic.Create(Self);
  MyGraphic.Parent := self;
end;

procedure TForm2.ProcessFormMessages1(var Msg: tMsg;
  var Handled: Boolean);
begin
  { проверка наличия системного сообщения KeyDown }
  case Msg.message of
    WM_KEYDOWN: begin
                  MyGraphic.KEYDOWN(Msg.wParam);
                  MyGraphic.Paint;
                  { сообщаем о том, что сообщение обработано }
                  {Handled := True; }
                end;
  end;
end;

end.

Об авторе:
Мои программы со статусом freeware для Windows на моём сайте jonix.ucoz.ru

Форма ответа

Отправка постов/ответов доступна только зарегистрированным и подтвержденным пользователям.

Если Вы уже зарегистрированы на Портале - войдите в систему, если Вы еще не регистрировались - пройдите простую процедуру регистрации.