flatpanel.pas

comerose_flatstyle_v4.42.9.0_d7.rar

unit FlatPanel;

interface

{$I FlatStyle.inc}

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

type
  TFlatTicket = class(TCustomLabel)
  private
    function GetTop: Integer;
    function GetLeft: Integer;
    function GetWidth: Integer;
    function GetHeight: Integer;
    procedure SetHeight(const Value: Integer);
    procedure SetWidth(const Value: Integer);
  protected
    procedure AdjustBounds; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property BiDiMode;
    property Caption;
    property Color;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Font;
    property Height: Integer read GetHeight write SetHeight;
    property Left: Integer read GetLeft;
    property ParentBiDiMode;
    property ParentColor;
    property ParentFont;
    property Top: Integer read GetTop;
    property Transparent;
    property Layout;
    property WordWrap;
    property Width: Integer read GetWidth write SetWidth;
  end;
  { TDefinePanel }
  TDefinePanel = class(TVersionControl)
  private
    FAutoSizeDocking: Boolean;
    FTransparent: Boolean;
    FColorBorder: TColor;
    FBackgropStartColor: TColor;
    FBackgropStopColor: TColor;
    FBackgropOrien: TStyleOrien;
    FStyleFace: TStyleFace;
    FAlignment: TAlignment;
    FLocked: Boolean;
    FFullRepaint: Boolean;
    FParentBackgroundSet: Boolean;
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetTransparent (const Value: Boolean);
    procedure SetBackgropOrien(const Value: TStyleOrien);
    procedure SetStyleFace(const Value: TStyleFace);
    procedure SetAlignment(const Value: TAlignment);
  protected
    procedure Paint; override;
    procedure CMIsToolControl(var Message: TMessage); message CM_ISTOOLCONTROL;
    procedure WMWindowPosChanged(var Message: TWMWindowPosChanged); message WM_WINDOWPOSCHANGED;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMTextChanged (var Message: TWmNoParams); message CM_TEXTCHANGED;
    procedure CMDockClient(var Message: TCMDockClient); message CM_DOCKCLIENT;
    procedure SetParentBackground(Value: Boolean); override;
    procedure CreateParams(var Params: TCreateParams); override;
    procedure AdjustClientRect(var Rect: TRect); override;
    function  CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; override;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property Alignment: TAlignment read FAlignment write SetAlignment default taCenter;
    property Locked: Boolean read FLocked write FLocked default False;
    property FullRepaint: Boolean read FFullRepaint write FFullRepaint default True;
    property ColorBorder: TColor index 0 read FColorBorder write SetColors default DefaultBorderColor;
    property BackgropStartColor: TColor index 1 read FBackgropStartColor write SetColors default DefaultColorStart;
    property BackgropStopColor: TColor index 2 read FBackgropStopColor write SetColors default DefaultColorStop;
    property BackgropOrien: TStyleOrien read FBackgropOrien write SetBackgropOrien default bsHorizontal;
    property StyleFace: TStyleFace read FStyleFace write SetStyleFace default fsDefault;
    property Color default clBtnFace;
  public
    constructor Create (AOwner: TComponent); override;
    function GetControlsAlignment: TAlignment; override;
    property ParentBackground stored FParentBackgroundSet;
  end;

  { TDefinePanel }
  TFlatPanel = class(TDefinePanel)
  published
    property Transparent;
    property Alignment;
    property Locked;
    property FullRepaint;
    property ColorBorder;
    property BackgropStartColor;
    property BackgropStopColor;
    property BackgropOrien;
    property StyleFace;
    property Color;
    property Caption;
    property Action;
    property Font;
    property ParentColor;
    property UseDockManager;
    property Enabled;
    property Visible;
    property Align;
    property AutoSize;
    property Cursor;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property TabOrder;
    property TabStop;
   {$IFDEF DFS_DELPHI_4_UP}
    property AutoSize;
    property UseDockManager;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property DragMode;
    property DragCursor;
    property ParentBiDiMode;
    property DockSite;
    property OnEndDock;
    property OnStartDock;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnGetSiteInfo;
    property OnUnDock;
   {$ENDIF}
   {$IFDEF DFS_DELPHI_5_UP}
    property OnContextPopup;
   {$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;
  { TFlatLBPanel }
  TFlatLBPanel = class(TDefinePanel)
  private
    FTicketSpace: Integer;
    FTicket: TFlatTicket;
    FTicketPosition: TTicketPosition;
  protected
    procedure SetTicketPosition(const Value: TTicketPosition);
    procedure SetLabelSpacing(const Value: Integer);
    procedure SetName(const Value: TComponentName); override;
    procedure CMVisiblechanged(var Message: TMessage); message CM_VISIBLECHANGED;
    procedure CMBidimodechanged(var Message: TMessage); message CM_BIDIMODECHANGED;
    procedure SetParent(AParent: TWinControl); override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure SetupInternalLabel;
  public
    constructor Create (AOwner: TComponent); override;
    procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer);override;
  published
    property Ticket: TFlatTicket read FTicket;
    property TicketPosition: TTicketPosition read FTicketPosition write SetTicketPosition default poLeft;
    property TicketSpace: Integer read FTicketSpace write SetLabelSpacing default 3;
    property Transparent;
    property Alignment;
    property Locked;
    property FullRepaint;
    property ColorBorder;
    property BackgropStartColor;
    property BackgropStopColor;
    property BackgropOrien;
    property StyleFace;
    property Color;
    property Caption;
    property Font;
    property ParentColor;
    property UseDockManager;
    property Enabled;
    property Visible;
    property Align;
    property AutoSize;
    property Cursor;
    property Hint;
    property ParentShowHint;
    property ShowHint;
    property PopupMenu;
    property TabOrder;
    property TabStop;
   {$IFDEF DFS_DELPHI_4_UP}
    property AutoSize;
    property UseDockManager;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property DragMode;
    property DragCursor;
    property ParentBiDiMode;
    property DockSite;
    property OnEndDock;
    property OnStartDock;
    property OnCanResize;
    property OnConstrainedResize;
    property OnDockDrop;
    property OnDockOver;
    property OnGetSiteInfo;
    property OnUnDock;
   {$ENDIF}
   {$IFDEF DFS_DELPHI_5_UP}
    property OnContextPopup;
   {$ENDIF}
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDrag;
  end;

implementation

{ TDefinePanel }
constructor TDefinePanel.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csAcceptsControls, csCaptureMouse, csClickEvents,
    csSetCaption, csOpaque, csDoubleClicks, csReplicatable];
  { When themes are on in an application default to making
    TDefinePanel's paint with their ParentBackground }
  if ThemeServices.ThemesEnabled then
     ControlStyle := ControlStyle + [csParentBackground] - [csOpaque];
  ParentColor     := True;
  UseDockManager  := True;
  ParentFont      := True;
  Color           := clBtnFace;
  FColorBorder    := DefaultBorderColor;
  FFullRepaint    := True;
  FAlignment      := taCenter;
  FBackgropStartColor := DefaultColorStart;
  FBackgropStopColor  := DefaultColorStop;
  FBackgropOrien      := bsHorizontal;
  SetBounds(0, 0, 185, 41);
end;

procedure TDefinePanel.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FColorBorder := Value;
    1: FBackgropStartColor := Value;
    2: FBackgropStopColor := Value;
  end;
  Invalidate;
end;

procedure TDefinePanel.Paint;
var
  memBitmap: TBitmap;
  textBounds: TRect;
  Format: UINT;
begin
  TextBounds := ClientRect;
  TextBounds.Left  := TextBounds.Left + 3;
  TextBounds.Right := TextBounds.Right - 3;
  Format := DT_SINGLELINE or DT_VCENTER;
  case Alignment of
    taLeftJustify: Format := Format or DT_LEFT;
    taCenter:      Format := Format or DT_CENTER;
    taRightJustify:Format := Format or DT_RIGHT;
  end;   

  memBitmap := TBitmap.Create; // create memory-bitmap to draw flicker-free
  try
    memBitmap.Height := ClientRect.Bottom;
    memBitmap.Width  := ClientRect.Right;
    if not ThemeServices.ThemesEnabled or not ParentBackground then
    begin
      memBitmap.Canvas.Brush.Color := Color;
      memBitmap.Canvas.FillRect(TextBounds);
    end;
    // Draw Background
    if FTransparent then
       DrawParentImage(Self, memBitmap.Canvas)
    else begin