Fórum Botão Herdado de TBitBtn ? #312491

unit SColorButton; 

  interface 

  uses 
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
     StdCtrls, Buttons, ExtCtrls; 

  type 
     TDrawButtonEvent = procedure(Control: TWinControl; 
     Rect: TRect; State: TOwnerDrawState) of object; 
     TSColorButton = class(TBitBtn) 
  private 
     FShowBorder: Boolean; 
     FFlat: Boolean; 
     FCanvas: TCanvas; 
     IsFocused: Boolean; 
     FOnDrawButton: TDrawButtonEvent; 
     FBorderColor: TColor; 
     procedure SetBorderColor(value: TColor); 
     procedure SetShowBorder(Value: Boolean); 
     procedure SetFlat(Value: Boolean); 
  protected 
     procedure CreateParams(var Params: TCreateParams); override; 
     procedure SetButtonStyle(ADefault: Boolean); override; 
     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED; 
     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED; 
     procedure CNMeasureItem(var Message: TWMMeasureItem); message CN_MEASUREITEM; 
     procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM; 
     procedure WMLButtonDblClk(var Message: TWMLButtonDblClk); message WM_LBUTTONDBLCLK; 
     procedure DrawButton(Rect: TRect; State: UINT); 
  public 
     constructor Create(AOwner: TComponent); override; 
     destructor Destroy; override; 
     property Canvas: TCanvas read FCanvas; 
     published 
     property OnDrawButton: TDrawButtonEvent read FOnDrawButton write FOnDrawButton; 
     property Color; 
     property ShowBorder: Boolean read FShowBorder write SetShowBorder default False; 
     property Flat: Boolean read FFlat write SetFlat default True; 
     property BorderColor: TColor read FBorderColor write SetBorderColor default clWindowFrame; 
   end; 

procedure Register; 

implementation 

procedure TSColorButton.SetBorderColor(value: TColor); 
begin 
  if Value <> FBorderColor then 
  begin 
    FBorderColor := Value; 
    Repaint; 
  end; 
end; 

procedure TSColorButton.SetShowBorder(value: Boolean); 
begin 
  if Value <> FShowBorder then 
  begin 
    FShowBorder := Value; 
    Repaint; 
  end; 
end; 

procedure TSColorButton.SetFlat(value: Boolean); 
begin 
  if Value <> FFlat then 
  begin 
    FFlat := Value; 
    Repaint; 
  end; 
end; 

procedure Register; 
begin 
 RegisterComponents(´Michelli´, [TSColorButton]); 
end; 

constructor TSColorButton.Create(AOwner: TComponent); 
begin 
 inherited Create(AOwner); 
 FCanvas := TCanvas.Create; 
 Flat:=True; 
end; 

destructor TSColorButton.Destroy; 
begin 
 inherited Destroy; 
 FCanvas.Free; 
end; 

procedure TSColorButton.CreateParams(var Params: TCreateParams); 
begin 
 inherited CreateParams(Params); 
 with Params do Style := Style or BS_OWNERDRAW; 
end; 

procedure TSColorButton.SetButtonStyle(ADefault: Boolean); 
begin 
 if ADefault <> IsFocused then 
  begin 
   IsFocused := ADefault; 
   Refresh; 
  end; 
end; 

procedure TSColorButton.CNMeasureItem(var Message: TWMMeasureItem); 
begin 
 with Message.MeasureItemStruct^ do 
  begin 
   itemWidth := Width; 
   itemHeight := Height; 
  end; 
end; 

procedure TSColorButton.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; 

procedure TSColorButton.CMEnabledChanged(var Message: TMessage); 
begin 
 inherited; 
 Invalidate; 
end; 

procedure TSColorButton.CMFontChanged(var Message: TMessage); 
begin 
 inherited; 
 Invalidate; 
end; 

procedure TSColorButton.WMLButtonDblClk(var Message: TWMLButtonDblClk); 
begin 
 Perform(WM_LBUTTONDOWN, Message.Keys, Longint(Message.Pos)); 
end; 

procedure TSColorButton.DrawButton(Rect: TRect; State: UINT); 
var 
 Flags, OldMode: Longint; 
 IsDown, IsDefault, IsDisabled: Boolean; 
 OldColor: TColor; 
 OrgRect: TRect; 
 TipoFlat: Longint; 
begin 
 OrgRect := Rect; 

 if Flat then //AQUI ELE DIZ O Q FAZER QUANDO É 3D OU NAO 
   Flags := DFCS_ADJUSTRECT or DFCS_FLAT 
 else 
   Flags := DFCS_ADJUSTRECT or DFCS_BUTTONPUSH; 

 IsDown := State and ODS_SELECTED <> 0; 
 IsDefault := State and ODS_HOTLIGHT <> 0; 
 IsDisabled := State and ODS_DISABLED <> 0; 

 if IsDown then Flags := Flags or DFCS_FLAT; 
 if IsDisabled then Flags := Flags or DFCS_INACTIVE; 

 if IsFocused or IsDefault then 
  begin 
   FCanvas.Pen.Color := BorderColor; 
   FCanvas.Pen.Width := 1; 
   FCanvas.Brush.Style := bsClear; 
   FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
   InflateRect(Rect, - 1, - 1); 
  end; 

  if IsDown then 
   begin 
     FCanvas.Pen.Color := clBtnShadow; 
     FCanvas.Pen.Width := 1; 
     FCanvas.Brush.Color := clBtnFace; 
     FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
     InflateRect(Rect, - 1, - 1); 
   end 
  else 
     DrawFrameControl(FCanvas.Handle, Rect, DFC_BUTTON, Flags); 

  if IsDown then OffsetRect(Rect, 1, 1); 

  OldColor := FCanvas.Brush.Color; 
  FCanvas.Brush.Color := Color; 
  FCanvas.FillRect(Rect); 
  FCanvas.Brush.Color := OldColor; 
  OldMode := SetBkMode(FCanvas.Handle, TRANSPARENT); 
  FCanvas.Font.Color := Font.Color; 
  if ShowBorder then 
  begin 
   FCanvas.Pen.Color := BorderColor; 
   FCanvas.Pen.Width := 1; 
   FCanvas.Brush.Style := bsClear; 
   FCanvas.Rectangle(Rect.Left, Rect.Top, Rect.Right, Rect.Bottom); 
   InflateRect(Rect, - 1, - 1); 
  end; 

  if IsDisabled then 
   DrawState(FCanvas.Handle, FCanvas.Brush.Handle, nil, Integer(Caption), 0, 
    ((Rect.Right - Rect.Left) - FCanvas.TextWidth(Caption)) div 2, 
    ((Rect.Bottom - Rect.Top) - FCanvas.TextHeight(Caption)) div 2, 
    0, 0, DST_TEXT or DSS_DISABLED) 
  else 
   DrawText(FCanvas.Handle, PChar(Caption), - 1, Rect, 
   DT_SINGLELINE or DT_CENTER or DT_VCENTER); 
   SetBkMode(FCanvas.Handle, OldMode); 

  if Assigned(FOnDrawButton) then 
   FOnDrawButton(Self, Rect, TOwnerDrawState(LongRec(State).Lo)); 

  if IsFocused and IsDefault then 
    begin 
      Rect := OrgRect; 
      InflateRect(Rect, - 4, - 4); 
      FCanvas.Pen.Color := clWindowFrame; 
      FCanvas.Brush.Color := clBtnFace; 
      DrawFocusRect(FCanvas.Handle, Rect); 
    end; 
end; 

end.