Обработка сообщений от мыши потомками собственного компонента

Новая страница 1

Источник - Королевство Делфи http://www.delphikingdom.com

Обработка сообщений от мыши потомками собственного компонента

Проблема: имеем свой собственный компонент, который может содержать несколько объектов с собственным внешним видом, каждый из которых должен реагировать на перемещение мыши.
Например -- подсвечиваться.
Для гуру: ничего интересного вы здесь не найдёте, примерчик это не более, чем пропаганда использования стандартного оконного механизма в противовес различным самоизобретённым велосипедам.
Классы: класс
TMyControl -- основной компонент; TMySubControl -- класс того объекта, который будет лежать на TMyControl и подсвечиваться.

 

Наследование от TGraphicControl необязательно. Фактически, можно выбирать из четырёх вариантов:
TControl
базовый класс всех элементов управления, не имеет виндовского Handle(дескриптора) окна, т.е. данный элемент Windows не считает окном; вся реализация сообщений, отрисовки и пр. выполняется в VCL; (+) -- меньше кушает ресурсов, (-) -- см. TWinControl
TGraphicControl
то же, что и TControl, но имеет свойство Canvas, при помощи которого удобно рисовать и метод Paint, в котором надо рисовать
TWinControl
это полноценное Windows-окно со всеми преимуществами перед TControl: (а) может получать фокус ввода, (б) может содержать "детей" -- другие окна на своей поверхности, (в) -- имеет дескриптор, св-во Handle
TCustomControl
наследник TWinControl, отличия между ними те же, что и между TControl и TGraphicControl

Выбран TGraphicControl по причине отсутствия "детей" и наличия Canvas.

 

Данные, составляющие компонент: FItem: TCollectionItem входит в какую-либо коллекцию и, собственно, содержат смысловое наполнение элемента. Я встречал вариант, когда у TMyControl не определялись "дети", а в качестве реакции на WM_PAINT перебирались элементы некоторой коллекции, которые кроме смысловых данных хранили свой контур, координаты и пр. и ручками всё это рисовалось... Жуть! Собственно, мой пример -- антиреклама описанного подхода

 

unit Unit1;



interface



uses

  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

  StdCtrls, Buttons, ComCtrls;



type

 

  TMySubControl = class(TGraphicControl)

  private

    FSelected: Boolean; //флаг, отмечающий подсвеченность

    FItem: TCollectionItem;    



    procedure SetMouseOver(Val: Boolean);

    procedure MsMove(var M: TWMMouseMove); message WM_MOUSEMOVE;

      { Реакция на перемещение мыши }

  protected

    procedure Paint(); override; //по этому сообщению надо перерисовывать

  public

    constructor Create(AOwner: TComponent); override;

    destructor Destroy(); override;

    property IsSelected: Boolean read FSelected write SetMouseOver;

      { Свойство, отмечащее факт "подсвеченности" }

  end;



  { "Главный" элемент управления. Собственную процедуру отрисовки я

    не определял, а "дети" есть. Поэтому -- TWinControl }

  TMyControl = class(TWinControl)

  private

    procedure MsMove(var M: TWMMouseMove); message WM_MOUSEMOVE;

  public

    constructor Create(AOwner: TComponent); override;

  end;



  { Класс основной формы. Ничего интересного }

  TMain = class(TForm)

    CloseButt: TBitBtn;

    Label1: TLabel;

    Label2: TLabel;

    procedure CloseWndExecute(Sender: TObject);

    procedure FormCreate(Sender: TObject);

  private

  public

  end;



var

  Main: TMain;



implementation



{$R *.DFM}



{ По кнопочке "Закрыть" }

procedure TMain.CloseWndExecute(Sender: TObject);

begin

  Close();

end;



{ Создание элементов вручную. Главное: вызвать конструктор,

  задать размеры и положение, назначить "родителя". Поскольку

  пакеты не используются, то на автомате создать их не выйдет. }

procedure TMain.FormCreate(Sender: TObject);

var

  c: TMyControl;

begin

  c := TMyControl.Create(Self);

  with c do begin

    SetBounds(8, 8, 240, 180);

    Color := clTeal;

    Parent := Self; //"родитель" -- формочка

  end;



  with TMySubControl.Create(Self) do begin

    SetBounds(3, 7, 49, 11);

    Parent := c; //у всех TMySubControl родитель -- TMyControl

  end;

  with TMySubControl.Create(Self) do begin

    SetBounds(140, 53, 94, 25);

    Parent := c;

  end;

  with TMySubControl.Create(Self) do begin

    SetBounds(38, 100, 88, 70);

    Parent := c;

  end;

end;



{ Мониторинг перемещений мыши по основному control-у.

  Отметьте, что когда курсор над "детьми", control не получает

  данное сообщение. }

procedure TMyControl.MsMove(var M: TWMMouseMove);

begin

  inherited;

  Main.Label1.Caption :=

    Format('%d:%d', [M.XPos, M.YPos]);

end;



{ Добавляем стиль 3D-рамки. Её отрисовка производится стандартными

  средствами винды. }

constructor TMyControl.Create(AOwner: TComponent);

begin

  inherited;

  ControlStyle := ControlStyle + [csFramed];

end;



{ Перерисовка. Простой прямоугольник. Цвет -- стандартный или

  подсвеченный, в зависимости от IsSelected }

procedure TMySubControl.Paint();

const

  a: array[Boolean] of TColor = (clWindow, clHighlight);

begin

  inherited;

  Canvas.Brush.Color := a[IsSelected];

  Canvas.FillRect(Canvas.ClipRect);

  with Canvas.ClipRect do

    //показываем -- какая именно часть перерисовывается

    Main.Label2.Caption := Format('(%d:%d) - (%d:%d)',

       [Left, Top, Right, Bottom]);

end;



{ Смена значения свойства. Только один из TMySubControl может быть

  подсвеченным }

procedure TMySubControl.SetMouseOver(Val: Boolean);

var

  i: Integer;

begin

  if Val <> FSelected then begin

    Invalidate(); //если изменилась подсветка, то надо перерисоваться

    if Val then //нас подсветили (Val = TRUE)

      for i := Parent.ControlCount - 1 downto 0 do

        //среди "братьев" ищем другие TMySubControl и снимаем им подсветку

        if (Parent.Controls[i] <> Self) and (Parent.Controls[i] is TMySubControl)

        then

          TMySubControl(Parent.Controls[i]).IsSelected := FALSE;

    FSelected := Val;

  end;

end;



procedure TMySubControl.MsMove(var M: TWMMouseMove);

begin

  IsSelected := TRUE; //над нами переместили мышку -- значит подсветили

end;



constructor TMySubControl.Create(AOwner: TComponent);

begin

  inherited;

  FItem := TCollectionItem.Create(nil {тут произвольный объект-коллекция,

     например его можно указать в параметрах конструктора});

end;



destructor TMySubControl.Destroy();

begin

  FItem.Free();

  inherited;

end;



end.


Опубликовал admin
11 Июн, Среда 2003г.



Программирование для чайников.