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