Вторник, 17.06.2025
Королевство Delphi
Главное меню
Статьи
Наш опрос
Нашли свой исходник?
Всего ответов: 94
Статистика
Онлайн всего: 1
Гостей: 1
Пользователей: 0
Форма входа
Главная » Статьи » Система » Разное

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

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

Получить ссылку на материал

Категория: Разное | Добавил: Барон (09.12.2011)
Просмотров: 642 | Теги: Потомок, мышь, компонент, сообщеня | Рейтинг: 0.0/0
[ Пожертвования для сайта ] [ Пожаловаться на материал ]

Если вам помог материал сайта кликните по оплаченной рекламе размещенной в центре

Поиск
Категории раздела
ActiveX [10]
CORBA и COM [16]
Kol и MCK [23]
WinAPI [28]
Компоненты [27]
Работа с Bluetooth [4]
Железо [8]
Текст [18]
Разное [98]
Королевство Delphi © 2010-2025
Яндекс цитирования