Peter Taran
дата публикации 13-11-2000 00:00

---

Версия для печати

TControl

базовый класс всех элементов управления, не имеет виндовского Handle(дескриптора) окна, т.е. данный элемент Windows не считает окном; вся реализация сообщений, отрисовки и пр. выполняется в VCL; (+) -- меньше кушает ресурсов, (-) -- см. TWinControl

TGraphicControl

то же, что и TControl, но имеет свойство Canvas, при помощи которого удобно рисовать и метод Paint, в котором надо рисовать

TWinControl

это полноценное Windows-окно со всеми преимуществами перед TControl: (а) может получать фокус ввода, (б) может содержать "детей" -- другие окна на своей поверхности, (в) -- имеет дескриптор, св-во Handle

TCustomControl

наследник TWinControl, отличия между ними те же, что и между TControl и TGraphicControl

Скачать файл MessMouse.zip (3K)

Peter Taran

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.

Peter Taran