flatbars.pas

comerose_flatstyle_v4.42.9.0_d7.rar

unit FlatBars;

interface

{$I FlatStyle.inc}

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, 
  Forms, ExtCtrls, Comctrls, FlatUtils, FlatBtns;

type
  { TFlatProgressBar }
  TFlatProgressBar = class(TVersionGraphic)
  private
    FTransparent: Boolean;
    FSmooth: Boolean;
    FUseAdvColors: Boolean;
    FAdvColorBorder: TAdvColors;
    FOrientation: TProgressBarOrientation;
    FElementWidth: Integer;
    FElementColor: TColor;
    FBorderColor: TColor;
    FPosition: Integer;
    FMin: Integer;
    FMax: Integer;
    FStep: Integer;
    procedure SetMin (Value: Integer);
    procedure SetMax (Value: Integer);
    procedure SetPosition (Value: Integer);
    procedure SetStep (Value: Integer);
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetAdvColors (Index: Integer; Value: TAdvColors);
    procedure SetUseAdvColors (Value: Boolean);
    procedure SetOrientation (Value: TProgressBarOrientation);
    procedure SetSmooth (Value: Boolean);
    procedure CheckBounds;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure SetTransparent (const Value: Boolean);
  protected
    procedure CalcAdvColors;
    procedure DrawElements;
    procedure Paint; override;
   {$IFDEF DFS_COMPILER_4_UP}
    procedure SetBiDiMode(Value: TBiDiMode); override;
   {$ENDIF}
  public
    constructor Create (AOwner: TComponent); override;
    procedure StepIt;
    procedure StepBy (Delta: Integer);
  published
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property Align;
    property Cursor;
    property Color default DefaultFlatColor;
    property ColorElement: TColor index 0 read FElementColor write SetColors default $00996633;
    property ColorBorder: TColor index 1 read FBorderColor write SetColors default DefaultBorderColor;
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 50;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
    property Orientation: TProgressBarOrientation read FOrientation write SetOrientation default pbHorizontal;
    property Enabled;
    property ParentColor;
    property Visible;
    property Hint;
    property ShowHint;
    property PopupMenu;
    property ParentShowHint;
    property Min: Integer read FMin write SetMin;
    property Max: Integer read FMax write SetMax;
    property Position: Integer read FPosition write SetPosition default 0;
    property Step: Integer read FStep write SetStep default 10;
    property Smooth: Boolean read FSmooth write SetSmooth default false;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode write SetBidiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;

  TFlatTitlebar = class(TVersionControl)
  private
   FForm: TCustomForm;
   FWndProcInstance: Pointer;
   FDefProc: LongInt;
   FActive: Boolean;
   FDown: Boolean;
   FOldX, FOldY: Integer;
   FActiveTextColor: TColor;
   FInactiveTextColor: TColor;
   FTitlebarColor: TColor;
   FOnActivate: TNotifyEvent;
   FOnDeactivate: TNotifyEvent;
   procedure FormWndProc(var Message: TMessage);
   procedure DoActivateMessage(var Message: TWMActivate);
   procedure DoActivation;
   procedure DoDeactivation;
   procedure SetActiveTextColor(Value: TColor);
   procedure SetInactiveTextColor(Value: TColor);
   procedure SetTitlebarColor(Value: TColor);
   procedure CMFontChanged (var Message: TMessage); message CM_FONTCHANGED;
   procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
  protected
   procedure Loaded; override;
   procedure Paint; override;
   procedure SetParent(AParent: TWinControl); override;
   procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
   procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
   procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    { Public declarations }
   constructor Create(AOwner: TComponent); override;
   destructor Destroy; override;
  published
   property ActiveTextColor: TColor read FActiveTextColor write SetActiveTextColor;
   property InactiveTextColor: TColor read FInactiveTextColor write SetInactiveTextColor;
   property TitlebarColor: TColor read FTitlebarColor write SetTitlebarColor;
   property Align;
   property Font;
   property Caption;
   property OnMouseDown;
   property OnMouseMove;
   property OnMouseUp;
   property OnActivate: TNotifyEvent read FOnActivate write FOnActivate;
   property OnDeactivate: TNotifyEvent read FOnDeactivate write FOnDeactivate;
  end;
   { TFlatScrollbarThumb }
  TFlatScrollbarThumb = class(TDefineButton)
  private
    FDown: Boolean;
    FOldX, FOldY: Integer;
    FTopLimit: Integer;
    FBottomLimit: Integer;
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    property Color;
  end;

{ TFlatScrollbarTrack }

  TFlatScrollbarTrack = class (TVersionControl)
  private
    FThumb: TFlatScrollbarThumb;

    FKind: TScrollBarKind;

    FSmallChange: Integer;
    FLargeChange: Integer;
    FMin: Integer;
    FMax: Integer;
    FPosition: Integer;

    procedure SetSmallChange(Value: Integer);
    procedure SetLargeChange(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetKind(Value: TScrollBarKind);

    procedure WMSize(var Message: TMessage); message WM_SIZE;

    function ThumbFromPosition: Integer;
    function PositionFromThumb: Integer;

    procedure DoPositionChange;

    procedure DoThumbHighlightColor(Value: TColor);
    procedure DoThumbShadowColor(Value: TColor);
    procedure DoThumbBorderColor(Value: TColor);
    procedure DoThumbFocusedColor(Value: TColor);
    procedure DoThumbDownColor(Value: TColor);
    procedure DoThumbColor(Value: TColor);

    procedure DoHScroll(var Message: TWMScroll);
    procedure DoVScroll(var Message: TWMScroll);
    procedure DoEnableArrows(var Message: TMessage);
    procedure DoGetPos(var Message: TMessage);
    procedure DoGetRange(var Message: TMessage);
    procedure DoSetPos(var Message: TMessage);
    procedure DoSetRange(var Message: TMessage);
    procedure DoKeyDown(var Message: TWMKeyDown);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Paint; override;
  published
    property Align;
    property Color;
    property ParentColor;
    property Min: Integer read FMin write SetMin;
    property Max: Integer read FMax write SetMax;
    property SmallChange: Integer read FSmallChange write SetSmallChange;
    property LargeChange: Integer read FLargeChange write SetLargeChange;
    property Position: Integer read FPosition write SetPosition;
    property Kind: TScrollBarKind read FKind write SetKind;
    property Version;
  end;

{ TFlatScrollbarButton }

  TFlatScrollbarButton = class (TDefineButton)
  private
    FNewDown: Boolean;
    FTimer: TTimer;
    FOnDown: TNotifyEvent;
    procedure DoTimer(Sender: TObject);
  protected
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property OnDown: TNotifyEvent read FOnDown write FOnDown;
    property Version;
  end;

  { TFlatScrollbar }

  TFlatOnScroll = procedure (Sender: TObject; ScrollPos: Integer) of object;

  TFlatScrollbar = class(TVersionControl)
  private
    FTrack: TFlatScrollbarTrack;

    FBtnOne: TFlatScrollbarButton;
    FBtnTwo: TFlatScrollbarButton;

    FMin: Integer;
    FMax: Integer;
    FSmallChange: Integer;
    FLargeChange: Integer;
    FPosition: Integer;
    FKind: TScrollBarKind;

    FButtonHighlightColor: TColor;
    FButtonShadowColor: TColor;
    FButtonBorderColor: TColor;
    FButtonFocusedColor: TColor;
    FButtonDownColor: TColor;
    FButtonColor: TColor;
    FThumbHighlightColor: TColor;
    FThumbShadowColor: TColor;
    FThumbBorderColor: TColor;
    FThumbFocusedColor: TColor;
    FThumbDownColor: TColor;
    FThumbColor: TColor;

    FOnScroll: TFlatOnScroll;

    procedure SetSmallChange(Value: Integer);
    procedure SetLargeChange(Value: Integer);
    procedure SetMin(Value: Integer);
    procedure SetMax(Value: Integer);
    procedure SetPosition(Value: Integer);
    procedure SetKind(Value: TScrollBarKind);

    procedure SetButtonHighlightColor(Value: TColor);
    procedure SetButtonShadowColor(Value: TColor);
    procedure SetButtonBorderColor(Value: TColor);
    procedure SetButtonFocusedColor(Value: TColor);
    procedure SetButtonDownColor(Value: TColor);
    procedure SetButtonColor(Value: TColor);
    procedure SetThumbHighlightColor(Value: TColor);
    procedure SetThumbShadowColor(Value: TColor);
    procedure SetThumbBorderColor(Value: TColor);
    procedure SetThumbFocusedColor(Value: TColor);
    procedure SetThumbDownColor(Value: TColor);
    procedure SetThumbColor(Value: TColor);

    procedure BtnOneClick(Sender: TObject);
    procedure BtnTwoClick(Sender: TObject);

    procedure EnableBtnOne(Value: Boolean);
    procedure EnableBtnTwo(Value: Boolean);

    procedure DoScroll;

    procedure WMSize(var Message: TWMSize); message WM_SIZE;

    procedure CNHScroll(var Message: TWMScroll); message WM_HSCROLL;
    procedure CNVScroll(var Message: TWMScroll); message WM_VSCROLL;
    procedure SBMEnableArrows(var Message: TMessage); message SBM_ENABLE_ARROWS;
    procedure SBMGetPos(var Message: TMessage); message SBM_GETPOS;
    procedure SBMGetRange(var Message: TMessage); message SBM_GETRANGE;
    procedure SBMSetPos(var Message: TMessage); message SBM_SETPOS;
    procedure SBMSetRange(var Message: TMessage); message SBM_SETRANGE;
    procedure WMKeyDown(var Message: TWMKeyDown); message WM_KEYDOWN;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Min: Integer read FMin write SetMin default 0;
    property Max: Integer read FMax write SetMax default 100;
    property SmallChange: Integer read FSmallChange write SetSmallChange default 1;
    property LargeChange: Integer read FLargeChange write SetLargeChange default 1;
    property Position: Integer read FPosition write SetPosition default 0;
    property Kind: TScrollBarKind read FKind write SetKind default sbVertical;
    property OnScroll: TFlatOnScroll read FOnScroll write FOnScroll;
    property ButtonHighlightColor: TColor read FButtonHighlightColor write SetButtonHighlightColor;
    property ButtonShadowColor: TColor read FButtonShadowColor write SetButtonShadowColor;
    property ButtonBorderColor: TColor read FButtonBorderColor write SetButtonBorderColor;
    property ButtonFocusedColor: TColor read FButtonFocusedColor write SetButtonFocusedColor;
    property ButtonDownColor: TColor read FButtonDownColor write SetButtonDownColor;
    property ButtonColor: TColor read FButtonColor write SetButtonColor;
    property ThumbHighlightColor: TColor read FThumbHighlightColor write SetThumbHighlightColor;
    property ThumbShadowColor: TColor read FThumbShadowColor write SetThumbShadowColor;
    property ThumbBorderColor: TColor read FThumbBorderColor write SetThumbBorderColor;
    property ThumbFocusedColor: TColor read FThumbFocusedColor write SetThumbFocusedColor;
    property ThumbDownColor: TColor read FThumbDownColor write SetThumbDownColor;
    property ThumbColor: TColor read FThumbColor write SetThumbColor;
    property Version;
    property Align;
    property Color;
    property ParentColor;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyUp;
    property OnStartDrag;
  end;
  { TFlatGauge }
  TFlatGauge = class(TVersionGraphic)
  private
    FTransparent: Boolean;
    FUseAdvColors: Boolean;
    FAdvColorBorder: TAdvColors;
    FBarColor, FBorderColor: TColor;
    FMinValue, FMaxValue, FProgress: LongInt;
    FShowText: Boolean;
    fTextFront: TCaption;
    fTextAfter: TCaption;
    fColorStop: TColor;
    fColorStart: TColor;
    fStyleBars: TStyleOrien;
    fStyleFace: TStyleFace;
    procedure SetShowText(Value: Boolean);
    procedure SetMinValue(Value: Longint);
    procedure SetMaxValue(Value: Longint);
    procedure SetProgress(Value: Longint);
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetAdvColors (Index: Integer; Value: TAdvColors);
    procedure SetUseAdvColors (Value: Boolean);
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure SetTransparent (const Value: Boolean);
    procedure SetTextFront(const Value: TCaption);
    procedure SetTextAfter(const Value: TCaption);
    procedure SetStyleOrien(const Value: TStyleOrien);
    procedure SetStyleFace(const Value: TStyleFace);
  protected
    procedure CalcAdvColors;
    procedure Paint; override;
   {$IFDEF DFS_COMPILER_4_UP}
    procedure SetBiDiMode(Value: TBiDiMode); override;
   {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 50;
    property Transparent: Boolean read FTransparent write SetTransparent default false;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default False;

    property StyleFace: TStyleFace read fStyleFace write SetStyleFace default DefaultStyleFace;
    property StyleOrien: TStyleOrien read fStyleBars write SetStyleOrien default DefaultStyleHorizontal;
    property StyleColorStart: TColor index 2 read fColorStart write SetColors default DefaultColorStart;
    property StyleColorStop: TColor index 3 read fColorStop write SetColors default DefaultColorStop;
    property Version;
    property Color default $00E0E9EF;
    property ColorBorder: TColor index 0 read FBorderColor write SetColors default DefaultBorderColor;
    property BarColor: TColor index 1 read FBarColor write SetColors default $00996633;
    property Min: Longint read FMinValue write SetMinValue default 0;
    property Max: Longint read FMaxValue write SetMaxValue default 100;
    property Progress: Longint read FProgress write SetProgress;
    property ShowText: Boolean read FShowText write SetShowText default True;
    property TextFront: TCaption read fTextFront write SetTextFront;
    property TextAfter: TCaption read fTextAfter write SetTextAfter;
    property Align;
    property Enabled;
    property Font;
    property ParentColor;
    property ParentFont;
    property ParentShowHint;
    property ShowHint;
    property Visible;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode write SetBidiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;

implementation

{$R FlatBars.RES}

uses FlatConsts;

{ TFlatProgressBar }
constructor TFlatProgressBar.Create (AOwner: TComponent);
begin
  inherited Create(AOwner);
  Height          := 16;
  Width           := 147;
  FElementWidth   := 8;
  FElementColor   := $00996633;
  FBorderColor    := DefaultBorderColor;
  ParentColor     := True;
  Orientation     := pbHorizontal;
  FStep           := 10;
  FMin            := 0;
  FMax            := 100;
  FUseAdvColors   := false;
  FAdvColorBorder := 50;
  Transparent     := false;
end;

procedure TFlatProgressBar.SetOrientation (Value: TProgressBarOrientation);
begin
  if FOrientation <> Value then
  begin
    FOrientation := Value;
    if (csLoading in ComponentState) then
    begin
      Repaint;
      Exit;
    end;
    SetBounds(Left, Top, Height, Width);
    Invalidate;
  end;
end;

procedure TFlatProgressBar.SetMin (Value: Integer);
begin
  if FMin <> Value then
  begin
    FMin := Value;
    Invalidate;
  end;
end;

procedure TFlatProgressBar.SetMax (Value: Integer);
begin
  if FMax <> Value then
  begin
    if Value < FPosition then FPosition := Value;
    FMax := Value;
    Invalidate;
  end;
end;

procedure TFlatProgressBar.SetPosition (Value: Integer);
begin
  if Value > FMax then Value := FMax;
  if Value < FMin then Value := FMin;
  
  if Value > FPosition then
  begin
    FPosition := Value;