UxPanel.pas

unit UxPanel;

interface

uses
  Windows, Messages, SysUtils, Types, Classes, Controls, Graphics, Forms,
  AppEvnts, UITypes, Generics.Collections, StdCtrls, ExtCtrls, Rux, ActnList;

type
  TUxPanel = class(TCustomControl)
  strict private
  var
    FCaptionSize: Integer;
    FCaptionColor: TColor;
    FInactiveCaptionColor: TColor;
    FAlignment: TAlignment;
    y0, y1, W, Indent: Integer;
    FCaptionRect, FTextRect, FFreeArea: TRect;
    FBorderWidth: Integer;
    FActivePanel: Boolean;
    FAppEvents: TApplicationEvents;
    FCaptionFont: TFont;
    function GetDisplayCaption: string; inline;
    procedure SetCaptionSize(ACaptionSize: Integer);
    procedure SetCaptionColor(ACaptionColor: TColor);
    procedure SetInactiveCaptionColor(AInactiveCaptionColor: TColor);
    procedure SetAlignment(AAlignment: TAlignment);
    procedure SetBorderWidth(ABorderWidth: Integer);
    procedure UpdateMetrics;
    procedure NeedMetrics;
    procedure AppActivate(Sender: TObject);
    procedure AppDeactivate(Sender: TObject);
    procedure CaptionFontChange(Sender: TObject);
  strict private
    class var FInstances: TList<TUxPanel>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
    class procedure ActiveFormChange;
  protected
    procedure Paint; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
    procedure Loaded; override;
    procedure Resize; override;
    procedure DoEnter; override;
    procedure DoExit; override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property CaptionRect: TRect read FCaptionRect;
    property TextRect: TRect read FTextRect;
    property DisplayCaption: string read GetDisplayCaption;
    class procedure UxThemeUpdate; static;
    property CaptionColor: TColor read FCaptionColor write SetCaptionColor;
    property InactiveCaptionColor: TColor read FInactiveCaptionColor write SetInactiveCaptionColor;
  published
    property Align;
    property Alignment: TAlignment read FAlignment write SetAlignment
      default taLeftJustify;
    property Anchors;
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth;
    property Caption;
    property CaptionSize: Integer read FCaptionSize write SetCaptionSize;
    property Color;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    property StyleElements;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TUxSplitter = class(ExtCtrls.TSplitter)
  strict private
    class var FInstances: TList<TUxSplitter>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class procedure UxThemeUpdate; static;
    property Align;
    property AutoSnap;
    property Beveled;
    property Cursor;
    property Color;
    property Constraints;
    property MinSize;
    property ParentColor;
    property PopupMenu;
    property ResizeStyle;
    property Visible;
    property Width;
    property StyleElements;
    property OnCanResize;
    property OnMoved;
    property OnPaint;
  end;

  TUxClient = class(TCustomControl)
  strict private
    FMousePassthrough: Boolean;
    FSizeGrip: Boolean;
    FSizeGripSize: Integer;
    class var FInstances: TList<TUxClient>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
    procedure SetSizeGrip(const Value: Boolean);
  protected
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class procedure UxThemeUpdate; static;
    property SizeGripSize: Integer read FSizeGripSize;
  published
    property Align;
    property Anchors;
    property Caption;
    property Constraints;
    property Ctl3D;
    property DockSite;
    property DoubleBuffered;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property MousePassthrough: Boolean read FMousePassthrough write FMousePassthrough default False;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property SizeGrip: Boolean read FSizeGrip write SetSizeGrip default False;
    property TabOrder;
    property TabStop;
    property Touch;
    property Visible;
    property StyleElements;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TUxButton = class;

  TUxButtonActionLink = class(TWinControlActionLink)
  protected
    FClient: TUxButton;
    procedure AssignClient(AClient: TObject); override;
    function IsCheckedLinked: Boolean; override;
    procedure SetChecked(Value: Boolean); override;
  end;

  TUxButton = class(TCustomControl)
  strict private
    class var FInstances: TList<TUxButton>;
    class constructor ClassCreate;
    class destructor ClassDestroy;
  private
    FActive: Boolean; // = currently has a default button's border
    FHot: Boolean;
    FDown: Boolean;
    FModalResult: TModalResult;
    FCancel: Boolean;
    FDefault: Boolean;
    procedure SetDefault(const Value: Boolean);
    procedure SetDown(const Value: Boolean);
    function IsDownStored: Boolean;
  protected
    procedure Paint; override;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
    procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
    procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
    procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMFocusChanged(var Message: TCMFocusChanged); message CM_FOCUSCHANGED;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X: Integer;
      Y: Integer); override;
    procedure WMSetFocus(var Message: TMessage); message WM_SETFOCUS;
    procedure WMKillFocus(var Message: TMessage); message WM_KillFOCUS;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; Shift: TShiftState); override;
    procedure Click; override;
    procedure ActionChange(Sender: TObject; CheckDefaults: Boolean); override;
    function GetActionLinkClass: TControlActionLinkClass; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    class procedure UxThemeUpdate; static;
  published
    property Action;
    property Align;
    property Anchors;
    property Cancel: Boolean read FCancel write FCancel default False;
    property Caption;
    property Constraints;
    property Ctl3D;
    property Default: Boolean read FDefault write SetDefault default False;
    property DockSite;
    property DoubleBuffered;
    property Down: Boolean read FDown write SetDown stored IsDownStored default False;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property ModalResult: TModalResult read FModalResult write FModalResult default 0;
    property ParentBiDiMode;
    property ParentBackground;
    property ParentColor;
    property ParentCtl3D;
    property ParentDoubleBuffered;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop default True;
    property Touch;
    property Visible;
    property StyleElements;
    property OnAlignInsertBefore;
    property OnAlignPosition;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGesture;
    property OnGetSiteInfo;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

procedure Register;

implementation

uses
  Math, StrUtils, ASColors, ScreenDispatch;

function _scale(X: Integer): Integer;
begin
  Result := MulDiv(X, Screen.PixelsPerInch, 96);
end;

procedure GetActualTextHeight(const DC: HDC; out y0: Integer; out y1: Integer);
var
  m: TTextMetric;
begin
  GetTextMetrics(DC, m);
  y0 := m.tmInternalLeading;
  y1 := m.tmHeight - m.tmDescent - m.tmExternalLeading;
end;

{ TUxPanel }

class procedure TUxPanel.ActiveFormChange;
var
  UxPanel: TUxPanel;
  ParentForm: TCustomForm;
begin
  if Assigned(FInstances) then
    for UxPanel in FInstances do
    begin
      ParentForm := GetParentForm(UxPanel);
      if UxPanel.FActivePanel xor (Screen.ActiveCustomForm = ParentForm) then
      begin
        UxPanel.FActivePanel := (Screen.ActiveCustomForm = ParentForm) and
          UxPanel.ContainsControl(Screen.ActiveControl);
        UxPanel.Invalidate;
      end;
    end;
end;

procedure TUxPanel.AppActivate(Sender: TObject);
begin
  FActivePanel := ContainsControl(Screen.ActiveControl);
  Invalidate;
end;

procedure TUxPanel.AppDeactivate(Sender: TObject);
begin
  FActivePanel := False;
  Invalidate;
end;

procedure TUxPanel.CaptionFontChange(Sender: TObject);
begin
  Invalidate;
end;

class constructor TUxPanel.ClassCreate;
begin
  FInstances := TList<TUxPanel>.Create;
  TUx.RegisterCallback(UxThemeUpdate);
end;

class destructor TUxPanel.ClassDestroy;
begin
  FreeAndNil(FInstances);
end;

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

procedure TUxPanel.CMTextChanged(var Message: TMessage);
begin
  inherited;
  UpdateMetrics;
  Invalidate;
end;

constructor TUxPanel.Create(AOwner: TComponent);
begin
  inherited;
  FCaptionFont := TFont.Create;
  FCaptionFont.Name := 'Arial';
  FCaptionFont.OnChange := CaptionFontChange;
  FAppEvents := TApplicationEvents.Create(Self);
  FAppEvents.OnActivate := AppActivate;
  FAppEvents.OnDeactivate := AppDeactivate;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  FCaptionSize := _scale(22);
  FBorderWidth := _scale(2);
  FCaptionColor := TUx.ThemeData.ActiveCaptionColor;
  FInactiveCaptionColor := TUx.ThemeData.InactiveCaptionColor;
  FAlignment := taLeftJustify;
  DoubleBuffered := True;
  if Assigned(FInstances) then
    FInstances.Add(Self);
  TScreenDispatcher.RegisterFormChangeProc('TUxPanel', ActiveFormChange);
end;

destructor TUxPanel.Destroy;
begin
  FCaptionFont.Free;
  if Assigned(FInstances) then
    FInstances.Remove(Self);
  inherited;
end;

procedure TUxPanel.DoEnter;
begin
  inherited;
  FActivePanel := True;
  Invalidate;
end;

procedure TUxPanel.DoExit;
begin
  inherited;
  FActivePanel := False;
  Invalidate;
end;

function TUxPanel.GetDisplayCaption: string;
begin
  Result := string(Caption).ToUpper;
end;

procedure TUxPanel.Loaded;
begin
  inherited;
  UpdateMetrics;
end;

procedure TUxPanel.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  if CanFocus and not ContainsControl(Screen.ActiveControl) then
    SetFocus;
  inherited;
end;

procedure TUxPanel.NeedMetrics;
begin
  if y1 = 0 then
    UpdateMetrics;
end;

procedure TUxPanel.Paint;
var
  R: TRect;
  S: string;
begin

  inherited;

  NeedMetrics;

  // Caption

  if FActivePanel then
    Canvas.Brush.Color := FCaptionColor
  else
    Canvas.Brush.Color := FInactiveCaptionColor;

  R := CaptionRect;
  R.Width := TextRect.Left;
  Canvas.FillRect(R);
  R := CaptionRect;
  R.Left := TextRect.Right;
  Canvas.FillRect(R);

  // Border
  R := Rect(0, CaptionRect.Bottom, FBorderWidth, ClientHeight);
  Canvas.FillRect(R);
  R := Rect(ClientWidth - FBorderWidth, CaptionRect.Bottom, ClientWidth, ClientHeight);
  Canvas.FillRect(R);
  R := Rect(0, ClientHeight - FBorderWidth, ClientWidth, ClientHeight);
  Canvas.FillRect(R);

  // Text
  Canvas.Font.Assign(FCaptionFont);
  if TUx.ThemeData.Readable(Canvas.Brush.Color, Color) then
    Canvas.Font.Color := Canvas.Brush.Color
  else
    Canvas.Font.Color := Font.Color;
  Canvas.Brush.Color := Color;
  Canvas.Font.Height := FCaptionSize;

  S := DisplayCaption;
  R := TextRect;
  R.Top := R.Top - y0;
  Canvas.FillRect(R);
  Canvas.TextRect(R, S, [tfSingleLine, tfTop, tfLeft, tfEndEllipsis]);

  // Client area
  if FFreeArea.Bottom > FFreeArea.Top then
    Canvas.FillRect(FFreeArea);

end;

procedure TUxPanel.Resize;
begin
  inherited;
  UpdateMetrics;
  Invalidate;
end;

procedure TUxPanel.SetAlignment(AAlignment: TAlignment);
begin
  if FAlignment <> AAlignment then
  begin
    FAlignment := AAlignment;
    UpdateMetrics;
    Invalidate;
  end;
end;

procedure TUxPanel.SetBorderWidth(ABorderWidth: Integer);
begin
  if FBorderWidth <> ABorderWidth then
  begin
    FBorderWidth := ABorderWidth;
    UpdateMetrics;
    Invalidate;
  end;
end;

procedure TUxPanel.SetCaptionColor(ACaptionColor: TColor);
begin
  if FCaptionColor <> ACaptionColor then
  begin
    FCaptionColor := ACaptionColor;
    Invalidate;
  end;
end;

procedure TUxPanel.SetCaptionSize(ACaptionSize: Integer);
begin
  if FCaptionSize <> ACaptionSize then
  begin
    FCaptionSize := ACaptionSize;
    UpdateMetrics;
    Invalidate;
  end;
end;

procedure TUxPanel.SetInactiveCaptionColor(AInactiveCaptionColor: TColor);
begin
  if FInactiveCaptionColor <> AInactiveCaptionColor then
  begin
    FInactiveCaptionColor := AInactiveCaptionColor;
    Invalidate;
  end;
end;

procedure TUxPanel.UpdateMetrics;
var
  bm: TBitmap;
begin
  if not HasParent then
    Exit;
  bm := TBitmap.Create;
  try
    bm.Canvas.Font.Assign(FCaptionFont);
    bm.Canvas.Font.Height := FCaptionSize;
    GetActualTextHeight(bm.Canvas.Handle, y0, y1);
    W := bm.Canvas.TextWidth(DisplayCaption);
    Indent := bm.Canvas.TextWidth('XXXX');
    FCaptionRect := Rect(0, 0, ClientWidth, y1 - y0);
    case FAlignment of
      taLeftJustify:
        if W < ClientWidth - Indent then
          FTextRect := Rect(Indent, 0, Min(Indent + W, ClientWidth), y1 - y0)
        else
          FTextRect := Rect(0, 0, Min(W, ClientWidth), y1 - y0);
      taRightJustify:
        if W < ClientWidth - Indent then
          FTextRect := Rect(Max(ClientWidth - Indent - W, 0), 0, ClientWidth - Indent, y1 - y0)
        else
          FTextRect := Rect(Max(ClientWidth - W, 0), 0, ClientWidth, y1 - y0);
    else
      FTextRect := Rect(Max((ClientWidth - W) div 2, 0), 0, Min((ClientWidth + W) div 2, ClientWidth), y1 - y0);
    end;
    FFreeArea := Rect(FBorderWidth, y1 - y0, ClientWidth - FBorderWidth, ClientHeight - FBorderWidth);
  finally
    bm.Free;
  end;
  Padding.Top := y1 - y0;
  Padding.Left := FBorderWidth;
  Padding.Right := FBorderWidth;
  Padding.Bottom := FBorderWidth;
end;

class procedure TUxPanel.UxThemeUpdate;
var
  Panel: TUxPanel;
begin
  if Assigned(FInstances) then
    for Panel in FInstances do
    begin
      Panel.CaptionColor := TUx.ThemeData.ActiveCaptionColor;
      Panel.InactiveCaptionColor := TUx.ThemeData.InactiveCaptionColor;
    end;
end;

procedure TUxPanel.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

{ TUxSplitter }

class constructor TUxSplitter.ClassCreate;
begin
  FInstances := TList<TUxSplitter>.Create;
  TUx.RegisterCallback(UxThemeUpdate);
end;

class destructor TUxSplitter.ClassDestroy;
begin
  FreeAndNil(FInstances);
end;

constructor TUxSplitter.Create(AOwner: TComponent);
begin
  inherited;
  if Assigned(FInstances) then
    FInstances.Add(Self);
  Color := TUx.ThemeData.InactiveCaptionColor;
end;

destructor TUxSplitter.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(Self);
  inherited;
end;

procedure TUxSplitter.Loaded;
begin
  inherited;
  Color := TUx.ThemeData.InactiveCaptionColor;
end;

class procedure TUxSplitter.UxThemeUpdate;
var
  Splitter: TUxSplitter;
begin
  if Assigned(FInstances) then
    for Splitter in FInstances do
      Splitter.Color := TUx.ThemeData.InactiveCaptionColor;
end;

{ TUxClient }

class constructor TUxClient.ClassCreate;
begin
  FInstances := TList<TUxClient>.Create;
  TUx.RegisterCallback(UxThemeUpdate);
end;

class destructor TUxClient.ClassDestroy;
begin
  FreeAndNil(FInstances);
end;

procedure TUxClient.CMColorChanged(var Message: TMessage);
begin
  inherited;
  if HandleAllocated then
    Invalidate;
end;

procedure TUxClient.CMTextChanged(var Message: TMessage);
begin
  inherited;
  if HandleAllocated then
    Invalidate;
end;

constructor TUxClient.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csOpaque, csDoubleClicks, csReplicatable];
  if Assigned(FInstances) then
    FInstances.Add(Self);
  Color := TUx.ThemeData.InactiveCaptionColor;
//  FSizeGripSize := GetSystemMetricsForWindow(SM_CXVSCROLL, Handle);
end;

destructor TUxClient.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(Self);
  inherited;
end;

procedure TUxClient.Paint;
var
  R: TRect;
  S: string;
  Frm: TCustomForm;
  LSizeGrip: Boolean;
begin
  inherited;
  if FSizeGrip then
  begin
    Frm := GetParentForm(Self);
    LSizeGrip := Assigned(Frm) and (Frm.WindowState <> wsMaximized) and (Frm.BorderStyle = bsSizeable);
  end
  else
    LSizeGrip := False;
  if LSizeGrip then
    FSizeGripSize := GetSystemMetricsForWindow(SM_CXVSCROLL, Handle);
  Canvas.Brush.Color := Color;
  R := ClientRect;
  if LSizeGrip then
    Dec(R.Right, FSizeGripSize);
  Canvas.FillRect(R);
  if Caption <> '' then
  begin
    Canvas.Font.Assign(Font);
    Canvas.Font.Color := TUx.ThemeData.InactiveCaptionTextColor;
    S := #32 + Caption;
    for var i := 0 to ControlCount - 1 do
      if Controls[i].Visible and (Controls[i].Align = alLeft) then
        Inc(R.Left, Controls[i].Width);
    Canvas.TextRect(R, S, [tfSingleLine, tfLeft, tfVerticalCenter, tfEndEllipsis]);
  end;
  if LSizeGrip then
  begin
    Canvas.Brush.Color := TUx.ThemeData.ActiveCaptionColor;
    Canvas.Pen.Style := psClear;
    R := Rect(
      ClientWidth - FSizeGripSize,
      ClientHeight - FSizeGripSize,
      ClientWidth,
      ClientHeight
    );
    Canvas.Polygon(
      [
        Point(R.Right, R.Top),
        Point(R.Right, R.Bottom),
        Point(R.Left, R.Bottom)
      ]
    );
    Canvas.Brush.Color := TUx.ThemeData.InactiveCaptionColor;
    Canvas.Polygon(
      [
        Point(R.Left, 0),
        Point(R.Right, 0),
        Point(R.Right, R.Top),
        Point(R.Left, R.Bottom)
      ]
    );
  end;
end;

procedure TUxClient.SetSizeGrip(const Value: Boolean);
begin
  if FSizeGrip <> Value then
  begin
    FSizeGrip := Value;
    Invalidate;
  end;
end;

class procedure TUxClient.UxThemeUpdate;
var
  Panel: TUxClient;
begin
  if Assigned(FInstances) then
    for Panel in FInstances do
      Panel.Color := TUx.ThemeData.InactiveCaptionColor;
end;

procedure TUxClient.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TUxClient.WMNCHitTest(var Message: TWMNCHitTest);
begin
  if FMousePassthrough then
    Message.Result := HTTRANSPARENT
  else
    inherited;
end;

{ TUxButton }

procedure TUxButton.ActionChange(Sender: TObject; CheckDefaults: Boolean);
begin
  inherited ActionChange(Sender, CheckDefaults);
  if Sender is TCustomAction then
    with TCustomAction(Sender) do
      if not CheckDefaults or not Self.Down then
        Self.Down := Checked;
end;

class constructor TUxButton.ClassCreate;
begin
  FInstances := TList<TUxButton>.Create;
  TUx.RegisterCallback(UxThemeUpdate);
end;

class destructor TUxButton.ClassDestroy;
begin
  FreeAndNil(FInstances);
end;

procedure TUxButton.Click;
var
  Form: TCustomForm;
begin
  Form := GetParentForm(Self);
  if Form <> nil then
    Form.ModalResult := ModalResult;
  inherited Click;
end;

procedure TUxButton.CMDialogChar(var Message: TCMDialogChar);
begin
  with Message do
    if IsAccel(CharCode, Caption) and CanFocus then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

procedure TUxButton.CMDialogKey(var Message: TCMDialogKey);
begin
  with Message do
    if
      (
        (
          FDefault
            and
          (CharCode = VK_RETURN)
            and
          (Focused or not ((Screen.ActiveControl is TCustomButton) or (Screen.ActiveControl is TUxButton)))
            and
          (Screen.ActiveCustomForm = GetParentForm(Self))
        )
          or
        (FCancel and (CharCode = VK_ESCAPE))
      )
    and
      (KeyDataToShiftState(Message.KeyData) = [])
    and
      CanFocus
    then
    begin
      Click;
      Result := 1;
    end else
      inherited;
end;

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

procedure TUxButton.CMFocusChanged(var Message: TCMFocusChanged);
var
  LActive: Boolean;
begin
  inherited;
  with Message do
    LActive := FDefault and
      ((Sender = Self) or not ((Sender is TCustomButton) or (Sender is TUxButton))) and
      (Screen.ActiveCustomForm = GetParentForm(Self));
  if LActive <> FActive then
  begin
    FActive := LActive;
    Invalidate;
  end;
end;

procedure TUxButton.CMMouseEnter(var Message: TMessage);
begin
  inherited;
  FHot := True;
  Invalidate;
end;

procedure TUxButton.CMMouseLeave(var Message: TMessage);
begin
  inherited;
  FHot := False;
  Invalidate;
end;

procedure TUxButton.CMTextChanged(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

constructor TUxButton.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := [csCaptureMouse, csClickEvents, csOpaque, csReplicatable,
    csSetCaption];
  if Assigned(FInstances) then
    FInstances.Add(Self);
  Color := TUx.ThemeData.InactiveCaptionColor;
  TabStop := True;
end;

destructor TUxButton.Destroy;
begin
  if Assigned(FInstances) then
    FInstances.Remove(Self);
  inherited;
end;

function TUxButton.GetActionLinkClass: TControlActionLinkClass;
begin
  result := TUxButtonActionLink;
end;

function TUxButton.IsDownStored: Boolean;
begin
  Result := (ActionLink = nil) or not TUxButtonActionLink(ActionLink).IsCheckedLinked;
end;

procedure TUxButton.KeyDown(var Key: Word; Shift: TShiftState);
begin
  inherited;
  case Key of
    VK_SPACE:
      Invalidate;
    VK_RETURN:
      Click;
  end;
end;

procedure TUxButton.KeyUp(var Key: Word; Shift: TShiftState);
begin
  inherited;
  case Key of
    VK_SPACE:
      begin
        Click;
        Invalidate;
      end;
  end;
end;

procedure TUxButton.MouseDown(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  if TabStop and CanFocus then
    SetFocus;
  Invalidate;
end;

procedure TUxButton.MouseUp(Button: TMouseButton; Shift: TShiftState; X,
  Y: Integer);
begin
  inherited;
  Invalidate;
end;

procedure TUxButton.Paint;
var
  R: TRect;
  S: string;
  LNormal: Boolean;
begin

  inherited;

  Canvas.Font.Assign(Font);

  LNormal := False;

  if not Enabled then
  begin
    Canvas.Brush.Color := TUx.ThemeData.InactiveCaptionColor;
    Canvas.Font.Color := TUx.ThemeData.InactiveTextColor;
  end
  else if (csLButtonDown in ControlState) or Focused and (GetKeyState(VK_SPACE) < 0) then
  begin
    Canvas.Brush.Color := TUx.ThemeData.DownCaptionColor;
    Canvas.Font.Color := TUx.ThemeData.DownCaptionTextColor;
  end
  else if FHot or Focused or FDown then
  begin
    Canvas.Brush.Color := TUx.ThemeData.ActiveCaptionColor;
    Canvas.Font.Color := TUx.ThemeData.ActiveCaptionTextColor;
  end
  else
  begin
    Canvas.Brush.Color := TUx.ThemeData.InactiveCaptionColor;
    Canvas.Font.Color := TUx.ThemeData.InactiveCaptionTextColor;
    LNormal := True;
  end;

  Canvas.FillRect(ClientRect);
  R := ClientRect;
//  Dec(R.Bottom);
  S := Caption;
  Canvas.TextRect(R, S, [tfSingleLine, tfVerticalCenter, tfEndEllipsis, tfCenter]);

  if LNormal and FActive then
  begin
    Canvas.Brush.Color := TUx.ThemeData.ActiveCaptionColor;
    Canvas.FillRect(Rect(0, 0, ClientWidth, _scale(4)));
    Canvas.FillRect(Rect(0, 0, _scale(4), ClientHeight));
    Canvas.FillRect(Rect(0, ClientHeight - _scale(4), ClientWidth, ClientHeight));
    Canvas.FillRect(Rect(ClientWidth - _scale(4), 0, ClientWidth, ClientHeight));
  end;

  if Focused then
  begin
    R := ClientRect;
    R.Inflate(-_scale(4), -_scale(4));
    DrawFocusRect(Canvas.Handle, R);
  end;

end;

procedure TUxButton.SetDefault(const Value: Boolean);
begin
  if FDefault <> Value then
  begin
    FDefault := Value;
    Invalidate;
  end;
end;

procedure TUxButton.SetDown(const Value: Boolean);
begin
  if FDown <> Value then
  begin
    FDown := Value;
    Invalidate;
  end;
end;

class procedure TUxButton.UxThemeUpdate;
var
  Button: TUxButton;
begin
  if Assigned(FInstances) then
    for Button in FInstances do
      Button.Color := TUx.ThemeData.InactiveCaptionColor;
end;

procedure TUxButton.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TUxButton.WMKillFocus(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure TUxButton.WMSetFocus(var Message: TMessage);
begin
  inherited;
  Invalidate;
end;

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TUxPanel, TUxSplitter, TUxClient, TUxButton]);
end;

{ TUxButtonActionLink }

procedure TUxButtonActionLink.AssignClient(AClient: TObject);
begin
  inherited AssignClient(AClient);
  FClient := AClient as TUxButton;
end;

function TUxButtonActionLink.IsCheckedLinked: Boolean;
begin
  Result := inherited IsCheckedLinked and
    (FClient.Down = TCustomAction(Action).Checked);
end;

procedure TUxButtonActionLink.SetChecked(Value: Boolean);
begin
  if IsCheckedLinked then
    FClient.Down := Value;
end;

end.