Обработка сообщений от мыши потомками собственного компонента
Проблема: имеем свой собственный компонент, который может содержать несколько объектов с собственным внешним видом, каждый из которых должен реагировать на перемещение мыши.
Например -- подсвечиваться.
Для гуру: ничего интересного вы здесь не найдёте, примерчик это не более, чем пропаганда использования стандартного оконного механизма в противовес различным самоизобретённым велосипедам.
Классы: класс 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 перебирались элементы некоторой коллекции, которые кроме смысловых данных хранили свой контур, координаты и пр. и ручками всё это рисовалось... Жуть! Собственно, мой пример -- антиреклама описанного подхода
Скачать файл (3K)
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.
