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

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.