[_anger]

Добрый день!
В одном старом проекте, который мне было поручено доработать, есть поле типа TScrollBox, выполняющее роль контейнера графических примитивов:

Код:

FScroll   : TScrollBox;

Чтобы иметь возможность обрабатывать события кнопок навигации(вверх/вниз/вправо/влево чтобы двигать примитивы на FScroll), класс должен содержать обработчик сообщения WM_GETDLGCODE. Поэтому я создал новый класс:

Код:

TScrollBoxArrowBtn = class(TScrollBox)
protected
  procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
end;

procedure TScrollBoxArrowBtn.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

И заменил TScrollBox на TScrollBoxArrowBtn:

Код:

FScroll   : TScrollBoxArrowBtn;

Компонент начал реагировать на нажатие кнопок стрелок. Но методы копирования, удаления, SelectAll перестали работать. Это произошло потому, что предыдущий разработчик добавил к методам проверки типа:

Код:

"VariableName".ClassType = TScrollBox;

Я заменил их на:

Код:

"VariableName" is TScrollBox;

После этого методы редактирования стали отрабатывать. Но я не уверен, что такие проверки типа "ClassType =" не встретятся где-нибудь еще. Поэтому я решил оставить:

Код:

FScroll   : TScrollBox;

И сделал TScrollBoxArrowBtn классом-хелпером:

Код:

TScrollBoxArrowBtn = class helper for TScrollBox
protected
  procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
end;

Но это не сработало - реакция на нажатия стрелок пропала. Это я в чем-то ошибся описывая хелпер или же в хелперах принципиально нельзя добавлять методы-обработчики сообщений?

[dr. F.I.N.]

Я консервативен в плане Delphi. Наша дружба остановилась на D7. Поэтому про хелперы я ничего сказать не могу.
Но по Вашему вопросу могу предложить "Шаманский метод GEO". Если задача условно "разовая" и в рамках одного модуля, то вполне хорошее решение.

Код:

unit Unit1;

interface

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

type
  TScrollBox = class(Forms.TScrollBox)
  protected
    procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
    procedure WMKeyDown(var Message: TWMKey); message WM_KEYDOWN;
  end;

  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TScrollBox }

procedure TScrollBox.WMGetDlgCode(var Message: TWMGetDlgCode);
begin
  Message.Result := DLGC_WANTARROWS;
end;

procedure TScrollBox.WMKeyDown(var Message: TWMKey);
begin
  case Message.CharCode of
    VK_UP:
      VertScrollBar.Position := VertScrollBar.Position - 10;
    VK_DOWN:
      VertScrollBar.Position := VertScrollBar.Position + 10;
  end;
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.VertScrollBar.Range := 1000;
end;

end.

[_anger]

Спасибо за помощь, коллега, но почему-то у меня ваш пример не срабатывает. Компилится без ошибок, но на нажатия стрелок, да и вообще любых кнопок на клавиатуре, никак не реагирует((
Я решил использовать подмену оконной процедуры у ScrollBox1:

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    ScrollBox1: TScrollBox;
    procedure FormCreate(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  private
    OldScrollBoxWinProc: TWndMethod;
    procedure NewScrollBoxWinProc(var Message: TMessage);
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ScrollBox1.VertScrollBar.Range := 1000;
  OldScrollBoxWinProc := ScrollBox1.WindowProc;
  ScrollBox1.WindowProc := NewScrollBoxWinProc;
end;

procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_UP:
      ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position - 10;
    VK_DOWN:
      ScrollBox1.VertScrollBar.Position := ScrollBox1.VertScrollBar.Position + 10;
  end;
end;

procedure TForm1.NewScrollBoxWinProc(var Message: TMessage);
begin
  if Message.Msg = WM_GETDLGCODE then
    Message.Result := DLGC_WANTARROWS
  else OldScrollBoxWinProc(Message);
end;

end.

Идея подсмотрена здесь

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

[_anger]

Извиняюсь за вчерашнее заявление по поводу вашего примера. Сегодня еще раз посмотрел внимательно и нашел причину. Дело в том, что ScrollBox не получает фокус ввода если по нему кликнуть мышью. Добавил программно перевод фокуса и все заработало. Спасибо.