Свойства компонента VLC в Design- и Run-Time - Delphi - Ответ 5809992

unit MyButton;
 
interface
 
uses
  System.SysUtils, System.Classes, Vcl.Controls, Vcl.StdCtrls, Graphics,
  Messages, Windows;
 
type
  TMyButtonStyle = class(TPersistent)
    private
      fBackgroundColor: TColor;
      fFontColor: TColor;
      FOnChange : TNotifyEvent;
      procedure SetColor(const Value: TColor);
      procedure SetFontColor(const Value: TColor);
    public
      constructor Create;
      property OnChange: TNotifyEvent read fOnChange write fOnChange;
    published
      property BackgroundColor: TColor read fBackgroundColor write SetColor;
      property FontColor: TColor read fFontColor write SetFontColor;
  end;
 
  TMyButton = class(TButton)
  private
    { Private declarations }
    FCanvas: TCanvas;
    IsFocused: Boolean;
    IsHovered: Boolean;
    fNormalButtonStyle: TMyButtonStyle;
    fHoverButtonStyle: TMyButtonStyle;
    fDownButtonStyle: TMyButtonStyle;
    procedure UpdateColors(Sender: TObject);
  protected
    { Protected declarations }
    procedure DrawButton(Rect: TRect; State: UINT);
    procedure WndProc(var Message : TMessage); override;
    procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure SetButtonStyle(Value: Boolean); override;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property NormalButtonStyle: TMyButtonStyle read fNormalButtonStyle write fNormalButtonStyle;
    property HoverButtonStyle: TMyButtonStyle read fHoverButtonStyle write fHoverButtonStyle;
    property DownButtonStyle: TMyButtonStyle read fDownButtonStyle write fDownButtonStyle;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('Samples', [TMyButton]);
end;
 
{ TMyButton }
 
procedure TMyButton.CNDrawItem(var Message: TWMDrawItem);
var
  SaveIndex: Integer;
begin
  with Message.DrawItemStruct^ do
  begin
    SaveIndex := SaveDC(hDC);
    FCanvas.Lock;
    try
      FCanvas.Handle := hDC;
      FCanvas.Font := Font;
      FCanvas.Brush := Brush;
      DrawButton(rcItem, itemState);
    finally
      FCanvas.Handle := 0;
      FCanvas.Unlock;
      RestoreDC(hDC, SaveIndex);
    end;
  end;
  Message.Result := 1;
end;
 
constructor TMyButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FCanvas := TCanvas.Create;
  fNormalButtonStyle := TMyButtonStyle.Create;
  fNormalButtonStyle.OnChange := UpdateColors;
  fNormalButtonStyle.BackgroundColor := clGray;
  fNormalButtonStyle.FontColor := clWhite;
  fHoverButtonStyle := TMyButtonStyle.Create;
  fHoverButtonStyle.OnChange := UpdateColors;
  fHoverButtonStyle.BackgroundColor := clSilver;
  fHoverButtonStyle.FontColor := clBlack;
  fDownButtonStyle := TMyButtonStyle.Create;
  fDownButtonStyle.OnChange := UpdateColors;
  fDownButtonStyle.BackgroundColor := clBlack;
  fDownButtonStyle.FontColor := clWhite;
end;
 
procedure TMyButton.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do Style := Style or BS_OWNERDRAW;
end;
 
destructor TMyButton.Destroy;
begin
  FCanvas.Free;
  FreeAndNil(fNormalButtonStyle);
  FreeAndNil(fHoverButtonStyle);
  FreeAndNil(fDownButtonStyle);
  inherited Destroy;
end;
 
procedure TMyButton.DrawButton(Rect: TRect; State: UINT);
var
  IsDown, IsDefault: Boolean;
  OriginalRect: TRect;
begin
  OriginalRect := Rect;
  IsDown := State and ODS_SELECTED <> 0;
  IsDefault := State and ODS_FOCUS <> 0;
  FCanvas.Brush.Style := bsClear;
  FCanvas.FillRect(Rect);
  InflateRect(Rect, -2, -2);
  if IsDown then begin
    FCanvas.Brush.Color := DownButtonStyle.BackgroundColor;
    FCanvas.Font.Color := DownButtonStyle.FontColor;
  end else begin
    if IsHovered then begin
      FCanvas.Brush.Color := HoverButtonStyle.BackgroundColor;
      FCanvas.Font.Color := HoverButtonStyle.FontColor;
    end else begin
      FCanvas.Brush.Color := NormalButtonStyle.BackgroundColor;
      FCanvas.Font.Color := NormalButtonStyle.FontColor;
    end;
  end;
  FCanvas.Brush.Style := bsSolid;
  FCanvas.FillRect(Rect);
  DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, DT_SINGLELINE or DT_CENTER or DT_VCENTER);
  if IsFocused and IsDefault then begin
    FCanvas.Pen.Color := clWindowFrame;
    FCanvas.Brush.Style := bsClear;
    DrawFocusRect(FCanvas.Handle, OriginalRect);
  end;
end;
 
procedure TMyButton.SetButtonStyle(Value: Boolean);
begin
  if Value <> IsFocused then
  begin
    IsFocused := Value;
    Invalidate;
  end;
end;
 
procedure TMyButton.UpdateColors(Sender: TObject);
begin
  Invalidate;
end;
 
procedure TMyButton.WndProc(var Message: TMessage);
begin
  if (Message.Msg = CM_MOUSELEAVE) then begin
    IsHovered := false;
    invalidate;
  end;
  if (Message.Msg = CM_MOUSEENTER) then begin
    IsHovered := true;
    invalidate;
  end;
  inherited;
end;
 
{ TMyButtonStyle }
 
constructor TMyButtonStyle.Create;
begin
  fBackgroundColor := clBtnFace;
  fFontColor := clBtnText;
end;
 
procedure TMyButtonStyle.SetColor(const Value: TColor);
begin
  if fBackgroundColor = Value then Exit;
  fBackgroundColor:= Value;
  if Assigned(fOnChange) then fOnChange(Self);
end;
 
procedure TMyButtonStyle.SetFontColor(const Value: TColor);
begin
  if fFontColor = Value then Exit;
  fFontColor:= Value;
  if Assigned(fOnChange) then fOnChange(Self);
end;
 
end.

procedure TMyButtonStyle.Assign(Source: TPersistent);
begin
  if (Source is TMyButtonStyle) then begin
    BackgroundColor := (Source as TMyButtonStyle).BackgroundColor;
    FontColor := (Source as TMyButtonStyle).FontColor;
  end else inherited;
end;