unit FlatBtn;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls,
 StdCtrls, Extctrls;

type
 TCustomFlatButton = class(TButton)
 private
   FCanvas: TCanvas;
   FFlat: Boolean;
   fbMouseIn: Boolean;
   procedure SetFlat(const Value: Boolean);
 protected
   procedure CreateParams(var Params: TCreateParams); override;
   procedure SetButtonStyle(ADefault: Boolean); override;
   procedure CNDrawItem(var Message: TWMDrawItem); message CN_DRAWITEM;
   procedure CMMouseEnter(var Msg: TMessage); message CM_MOUSEENTER;
   procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
 public
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
   property  Canvas: TCanvas read FCanvas;
   property  Flat: Boolean read FFlat write SetFlat default True;
 end;

 TFlatButton = class(TCustomFlatButton)
 published
   property  Flat;
 end;

procedure Register;

implementation

constructor TCustomFlatButton.Create(AOwner: TComponent);
begin
 inherited Create(AOwner);
 FCanvas := TControlCanvas.Create;
 FFlat := True;
 fbMouseIn := False;
end;

procedure TCustomFlatButton.CreateParams(var Params: TCreateParams);
begin
 inherited;
 if FFlat and (not (csDesigning in ComponentState)) then
   Params.Style := Params.Style or BS_OWNERDRAW;
end;

destructor TCustomFlatButton.Destroy;
begin
 FreeAndNil(FCanvas);
 inherited Destroy;
end;

procedure TCustomFlatButton.SetButtonStyle(ADefault: Boolean);
const
 BS_MASK = $000F;
var
 Style: Word;
begin
 if FFlat and (not (csDesigning in ComponentState)) then begin
   if HandleAllocated then
   begin
     Style := BS_OWNERDRAW;
     if GetWindowLong(Handle, GWL_STYLE) and BS_MASK <> Style then
       SendMessage(Handle, BM_SETSTYLE, Style, 1);
   end;
 end
 else
   inherited;
end;

procedure TCustomFlatButton.CNDrawItem(var Message: TWMDrawItem);
var
 State: TOwnerDrawState;
 Flags: Integer;
 Buf: array[0..255] of Char;
 TR: TRect;
begin
 with Message.DrawItemStruct^ do
 begin
   State := TOwnerDrawState(LongRec(itemState).Lo);
   FCanvas.Handle := hDC;
   FCanvas.Font.Assign(Font);
   FCanvas.Brush.Assign(Brush);
   FCanvas.Pen.Color := clNone;
   SetBkMode(FCanvas.Handle, TRANSPARENT);
   TR := rcItem;
   FCanvas.FillRect(TR);
   if odSelected in State then
     Frame3D(FCanvas, TR, clBtnShadow, clBtnHighlight, 1)
   else
     if fbMouseIn or (odFocused in State) then
       Frame3D(FCanvas, TR, clBtnHighlight, clBtnShadow, 1);
   TR := rcItem;
   if odFocused in State then
   begin
     InflateRect(TR, -2, -2);
     DrawFocusRect(hDC, TR);
     TR := rcItem;
   end;
   StrPLCopy(Buf, Caption, 255);
   Flags := DT_CENTER or DT_VCENTER or DT_SINGLELINE or DT_NOPREFIX;
   if Enabled then
   begin
     if odSelected in State then
       OffsetRect(TR, 1, 1);
     DrawText(FCanvas.Handle, Buf, StrLen(Buf), TR, Flags);
   end
   else
   begin
     {use shadow text for inactive folder text}
     OffsetRect(TR, 1, 1);
     FCanvas.Font.Color := clBtnHighlight;
     DrawText(FCanvas.Handle, Buf, -1, TR, Flags);
     OffsetRect(TR, -1, -1);
     FCanvas.Font.Color := clBtnShadow;
     DrawText(FCanvas.Handle, Buf, -1, TR, Flags);
     FCanvas.Handle := 0;
   end;
 end;
end;

procedure TCustomFlatButton.CMMouseEnter(var Msg: TMessage);
begin
 fbMouseIn := True;
 Invalidate;
 inherited;
end;

procedure TCustomFlatButton.CMMouseLeave(var Msg: TMessage);
begin
 fbMouseIn := False;
 Invalidate;
 inherited;
end;

procedure TCustomFlatButton.SetFlat(const Value: Boolean);
begin
 FFlat := Value;
 if not (csDesigning in ComponentState) then
   SetButtonStyle(Default);
end;

procedure Register;
begin
 RegisterComponents('Sample', [TFlatButton]);
end;

end.

procedure TCustomFlatButton.CNDrawItem(var Message: TWMDrawItem);

procedure TBitBtn.DrawItem(const DrawItemStruct: TDrawItemStruct);
const
 WordBreakFlag: array[Boolean] of Integer = (0, DT_WORDBREAK);
var
 IsDown, IsDefault: Boolean;
 State: TButtonState;
 R: TRect;
 Flags: Longint;
 Details: TThemedElementDetails;
 Button: TThemedButton;
 Offset: TPoint;
begin
 FCanvas.Handle := DrawItemStruct.hDC;
 R := ClientRect;

 with DrawItemStruct do
 begin
   FCanvas.Handle := hDC;
   FCanvas.Font := Self.Font;
   IsDown := itemState and ODS_SELECTED <> 0;
   IsDefault := itemState and ODS_FOCUS <> 0;

   if not Enabled then State := bsDisabled
   else if IsDown then State := bsDown
   else State := bsUp;
 end;

 if ThemeServices.ThemesEnabled then
 begin
   if not Enabled then
     Button := tbPushButtonDisabled
   else
     if IsDown then
       Button := tbPushButtonPressed
     else
       if FMouseInControl then
         Button := tbPushButtonHot
       else
         if IsFocused or IsDefault then
           Button := tbPushButtonDefaulted
         else
           Button := tbPushButtonNormal;

   Details := ThemeServices.GetElementDetails(Button);
   // Parent background.
   ThemeServices.DrawParentBackground(Handle, DrawItemStruct.hDC, @Details, True);
   // Button shape.
   ThemeServices.DrawElement(DrawItemStruct.hDC, Details, DrawItemStruct.rcItem);
   R := ThemeServices.ContentRect(FCanvas.Handle, Details, DrawItemStruct.rcItem);

   if Button = tbPushButtonPressed then
     Offset := Point(1, 0)
   else
     Offset := Point(0, 0);
   TButtonGlyph(FGlyph).Draw(FCanvas, R, Offset, Caption, FLayout, FMargin, FSpacing, State, False,
     DrawTextBiDiModeFlags(0) or WordBreakFlag[WordWrap]);

   if IsFocused and IsDefault then
   begin
     FCanvas.Pen.Color := clWindowFrame;
     FCanvas.Brush.Color := clBtnFace;
     DrawFocusRect(FCanvas.Handle, R);
   end;
 end
 else
 begin
   R := ClientRect;

   Flags := DFCS_BUTTONPUSH or DFCS_ADJUSTRECT;
   if IsDown then Flags := Flags or DFCS_PUSHED;
   if DrawItemStruct.itemState and ODS_DISABLED <> 0 then
     Flags := Flags or DFCS_INACTIVE;

   { DrawFrameControl doesn't allow for drawing a button as the
       default button, so it must be done here. }
   if IsFocused or IsDefault then
   begin
     FCanvas.Pen.Color := clWindowFrame;
     FCanvas.Pen.Width := 1;
     FCanvas.Brush.Style := bsClear;
     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);

     { DrawFrameControl must draw within this border }
     InflateRect(R, -1, -1);
   end;

   { DrawFrameControl does not draw a pressed button correctly }
   if IsDown then
   begin
     FCanvas.Pen.Color := clBtnShadow;
     FCanvas.Pen.Width := 1;
     FCanvas.Brush.Color := clBtnFace;
     FCanvas.Rectangle(R.Left, R.Top, R.Right, R.Bottom);
     InflateRect(R, -1, -1);
   end
   else
     DrawFrameControl(DrawItemStruct.hDC, R, DFC_BUTTON, Flags);

   if IsFocused then
   begin
     R := ClientRect;
     InflateRect(R, -1, -1);
   end;

   FCanvas.Font := Self.Font;
   if IsDown then
     OffsetRect(R, 1, 1);
   TButtonGlyph(FGlyph).Draw(FCanvas, R, Point(0,0), Caption, FLayout, FMargin,
     FSpacing, State, False, DrawTextBiDiModeFlags(0) or WordBreakFlag[WordWrap]);

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

 FCanvas.Handle := 0;
end;

CreateParams(...)
 inherited
   if FFlat then
     ставим BS_FLAT
   else
     убираем BS_FLAT
end;

SetFlat(...)
 if FFlat <> Value then
 begin
   FFlat := Value;
   RecreateWnd;
end;