Компонент, который высвечивается, когда мышь находится над ним

Для работы этого компонента будем использовать сообщения Windows CM_MOUSEENTER и CM_MOUSELEAVE. Управление — белый прямоугольник. Когда мышь появляется над ним, он становится желтым.

Создаем объект, унаследованный от TControl.
Определяем переменную TCanvas для того, чтобы рисовать на ней и переменную Boolean, которая будет иметь значение True, когда мышь будет находиться над управлением.
Определяем процедуры для обработки сообщений CM_MOUSEENTER, CM_MOUSELEAVE и WM_PAINT.

THighLightControl = class(TControl)
  private
    FMouseOver: Boolean;
    FCanvas: TCanvas;
  protected
    procedure CMMouseLeave(
        var msg : TMessage); message CM_MOUSELEAVE;
    procedure CMMouseEnter(
        var msg : TMessage); message CM_MOUSEENTER;
    procedure WMPaint(
        var msg: TMessage); message WM_PAINT;
  public
    constructor Create(Owner: TComponent); override;
    destructor Destroy; override;
end;
 
 
procedure Register;
implementation
 
constructor THighLightControl.Create(Owner: TComponent);
begin
  inherited Create(Owner);
  Width := 100;
  Height := 100;
  FMouseOver := False;
  FCanvas := TControlCanvas.Create;
  TControlCanvas(FCanvas).Control := Self;
  { Объект TControlCanvas унаследован 
     от TCanvas и будет использоваться
     для рисования на  Control Surface. }
end;
 
destructor THighLightControl.Destroy;
begin
  FCanvas.Destroy;
  inherited Destroy;
end;
 
procedure THighLightControl.CMMouseLeave(
    var msg : TMessage);
begin
  FMouseOver := False;
  Invalidate;
  { Установить значение FMouseOver в False, 
    и перерисовать управление }
end;
 
procedure THighLightControl.CMMouseEnter(
    var msg : TMessage);
begin
  FMouseOver := True;
  Invalidate;
  { Установить значение FMouseOver в True, 
    и перерисовать управление }
end;
 
procedure THighLightControl.WMPaint(var msg: TMessage);
begin
  { Процедура для рисования прямоугольника }
  if FMouseOver then begin
    { Мышь переместилась над управлением }
    FCanvas.Brush.Color := clYellow;
  end else begin
    FCanvas.Brush.Color := clWhite;
  end;
  FCanvas.Rectangle(0, 0, Width, Height);
end;
 
procedure Register;
begin
  RegisterComponents('SAMPLES', [THighLightControl]);
end;
 
end.

—

01.09.2016

coder

Компонент, который высвечивается, когда мышь находится над ним

Комментарии