Проблемы при ручном создании компонента - Delphi - Ответ 3560510

unit ImgListBtnUnit;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, ImgList;
 
type
  TImageListBtn = class(TGraphicControl)
  private
    { Private declarations }
    FImageIndex: Integer;
    FImageList: TImageList;
    FImgIndHover: Integer;
    FImgIndDown: Integer;
    FImgIndDisabled: Integer;
    procedure SetImageIndex(const Value: Integer);
    procedure SetImageList(const Value: TImageList);
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure EvMouseEnter(var Msg: TMessage); message CM_MouseEnter; // мышь в зоне
    procedure EvMouseLeave(var Msg: TMessage); message CM_MouseLeave; // мышь вне зоны
    procedure SetImgIndDisabled(const Value: Integer); 
  protected
    { Protected declarations }
    down: boolean;
    hover: boolean;
    procedure Paint; override;
    procedure EvMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
    procedure EvMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); virtual;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
  published
     property Align;
     property Color;
     property Enabled;
     property ParentColor;
     property Visible;
     property OnClick;
      //property OnContextPopup;
     property OnDblClick;
      //property OnMouseActivate;
      //property OnMouseDown;
      //property OnMouseEnter;
      //property OnMouseLeave;
      //property OnMouseMove;
      //property OnMouseUp;
 
    { Published declarations }
    property ImageList: TImageList read FImageList write SetImageList;
    property ImageIndex: Integer read FImageIndex write SetImageIndex Default -1;
    property ImgIndHover: Integer read FImgIndHover write FImgIndHover Default -1;
    property ImgIndDown: Integer read FImgIndDown write FImgIndDown Default -1;
    property ImgIndDisabled: Integer read FImgIndDisabled write SetImgIndDisabled Default -1;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TImageListBtn]);
end;
 
{ TGlyph }
constructor TImageListBtn.Create(AOwner: TComponent);
begin
  inherited;
  FImageIndex := -1;
  FImgIndHover:= -1;
  FImgIndDown:= -1;
  FImgIndDisabled:= -1;
  hover:=false;
  down:=false;
  self.OnMouseDown:=self.EvMouseDown;
  self.OnMouseUp:=self.EvMouseUp;
  Color:=clBlack;
end;
 
procedure TImageListBtn.EvMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseEnter(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=true;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseLeave(var Msg: TMessage);
begin
  if csDesigning in ComponentState then exit;
  hover:=false;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.EvMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  if csDesigning in ComponentState then exit;
  if Button<>mbLeft then exit;
  down:=false;
  Repaint;
end;
 
procedure TImageListBtn.Paint;
begin
  if Assigned(FImageList) and (FImageIndex>=0) then begin
    with FImageList do
      if Enabled then begin
         if down and (FImgIndDown>=0) then Draw(Self.Canvas, 0, 0, FImgIndDown)
         else
         if hover and (FImgIndHover>=0) then Draw(Self.Canvas, 0, 0, FImgIndHover)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
      end else
         if FImgIndDisabled>=0 then Draw(Self.Canvas, 0, 0, FImgIndDisabled)
         else
         if FImageIndex>=0 then Draw(Self.Canvas, 0, 0, FImageIndex);
  end else // компонент в режиме Desing
    if csDesigning in ComponentState then begin
      Canvas.Brush.Style:=bsClear;
      Canvas.Pen.Style:=psDot;
      Canvas.Pen.Width:=1;
      // color Reverse
      Canvas.Pen.Color:=Color;
      Canvas.Rectangle(0,0,Width,Height);
    end else inherited;
end;
 
procedure TImageListBtn.SetImageIndex(const Value: Integer);
begin
  FImageIndex := Value;
  Repaint;
end;
 
procedure TImageListBtn.SetImageList(const Value: TImageList);
begin
  FImageList := Value;
  if Assigned(FImageList) then
  begin
    Self.Width := FImageList.Width;
    Self.Height := FImageList.Height;
  end;
end;
 
procedure TImageListBtn.SetImgIndDisabled(const Value: Integer);
begin
  FImgIndDisabled := Value;
  Repaint;
end;
 
procedure TImageListBtn.WMSize(var Message: TWMSize);
begin
  if Assigned(FImageList) then
  begin
    if Message.Width > FImageList.Width then
      Message.Width := FImageList.Width;
    if Message.Height > FImageList.Height then
      Message.Height := FImageList.Height;
  end;
  inherited;
end;
 
end.