flattabs.pas

comerose_flatstyle_v4.42.9.0_d7.rar

unit FlatTabs;

interface

{$I FlatStyle.inc}

uses
  Windows, Messages, Classes, Controls, Forms, Graphics, StdCtrls, SysUtils,
  FlatUtils, Themes, ComStrs, commCtrl, FlatPanel;

type
  { TDefineTab }
  TDefineTab = class(TVersionControl)
  private
    FUseAdvColors: Boolean;
    FAdvColorBorder: TAdvColors;
    FTabPosition: TFlatTabPosition;
    FTabs: TStringList;
    FTabsRect: TList;
    FTabHeight: Integer;
    FTabSpacing: Integer;
    FTabIndex: Integer;
    FUnselectedColor: TColor;
    FBorderColor: TColor;
    FOnChange: TNotifyEvent;
    FBorderWidth: Integer;
  protected
    procedure SetTabs (Value: TStringList);
    procedure SetTabPosition (Value: TFlatTabPosition);
    procedure SetTabHeight (Value: Integer);
    procedure SetTabSpacing (Value: Integer);
    procedure SetTabIndex (Value: Integer);
    procedure SetColors (Index: Integer; Value: TColor);
    procedure SetAdvColors (Index: Integer; Value: TAdvColors);
    procedure SetUseAdvColors (Value: Boolean);
    procedure SetTabRect;
    procedure CMDialogChar (var Message: TCMDialogChar); message CM_DIALOGCHAR;
    procedure CMEnabledChanged (var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMParentColorChanged (var Message: TWMNoParams); message CM_PARENTCOLORCHANGED;
    procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure SetBorderWidth(const Value: Integer);
    procedure CalcAdvColors;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Loaded; override;
    procedure Paint; override;
    procedure Change; dynamic;
    procedure AlignControls (AControl: TControl; var Rect: TRect); override;
    function  CanShowTab(TabIndex: Integer): Boolean; virtual;
    procedure TabsChanged (Sender: TObject);
    property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
    property ColorBorder: TColor index 0 read FBorderColor write SetColors default $008396A0;
    property ColorUnselectedTab: TColor index 1 read FUnselectedColor write SetColors default $00996633;
    property AdvColorBorder: TAdvColors index 0 read FAdvColorBorder write SetAdvColors default 50;
    property UseAdvColors: Boolean read FUseAdvColors write SetUseAdvColors default false;
    property Tabs: TStringList read FTabs write SetTabs;
    property TabHeight: Integer read FTabHeight write SetTabHeight default 16;
    property TabSpacing: Integer read FTabSpacing write SetTabSpacing default 4;
    property TabPosition: TFlatTabPosition read FTabPosition write SetTabPosition default fpTop;
    property TabIndex: Integer read FTabIndex write SetTabIndex default 0;
  public
    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TFlatTab = class(TDefineTab)
  published
    property Align;
    property BorderWidth;
    property ColorBorder;
    property ColorUnselectedTab;
    property AdvColorBorder;
    property UseAdvColors;
    property Tabs;
    property TabHeight;
    property TabSpacing;
    property TabPosition;
    property TabIndex;
    property Version;
    property Font;
    property Color;
    property ParentColor;
    property Enabled;
    property Visible;
    property Cursor;
    property ParentShowHint;
    property ParentFont;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property OnEnter;
    property OnExit;
    property OnMouseMove;
    property OnMouseDown;
    property OnMouseUp;
    property OnChange;
   {$IFDEF DFS_COMPILER_4_UP}
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DragKind;
    property ParentBiDiMode;
    property OnEndDock;
    property OnStartDock;
   {$ENDIF}
  end;


implementation

procedure TDefineTab.CMDesignHitTest(var Message: TCMDesignHitTest);
begin
  case FTabPosition of
    fpTop:
      if PtInRect(Rect(ClientRect.Left, ClientRect.Top, ClientRect.Right, ClientRect.Top + FTabHeight + 1), Point(message.XPos, message.YPos)) then
        Message.Result := 1
      else
        Message.Result := 0;
    fpBottom:
      if PtInRect(Rect(ClientRect.Left, ClientRect.Bottom - FTabHeight, ClientRect.Right, ClientRect.Bottom), Point(message.XPos, message.YPos)) then
        Message.Result := 1
      else
        Message.Result := 0;
  end;
end;

constructor TDefineTab.Create (AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csAcceptsControls, csOpaque];
  SetBounds(Left, Top, 289, 193);
  FTabs := TStringList.Create;
  FTabs.OnChange := TabsChanged;
  FTabsRect := TList.Create;
  FTabHeight := 16;
  FTabSpacing := 4;
  FTabPosition := fpTop;
  FTabIndex := 0;
  Color := $00E1EAEB;
  FBorderColor := $008396A0;
  FUnselectedColor := $00996633;
  ParentColor := true;
  ParentFont := true;
  FUseAdvColors := false;
  FAdvColorBorder := 50;
end;

function TDefineTab.CanShowTab(TabIndex: Integer): Boolean;
begin
  Result := True;
end;

destructor TDefineTab.Destroy;
begin
  FTabs.Free;
  RemoveList(FTabsRect, lsFree);
  inherited;
end;

procedure TDefineTab.CalcAdvColors;
begin
  if FUseAdvColors then
  begin
    FBorderColor := CalcAdvancedColor(Color, FBorderColor, FAdvColorBorder, darken);
  end;
end;

procedure TDefineTab.SetAdvColors (Index: Integer; Value: TAdvColors);
begin
  case Index of
    0: FAdvColorBorder := Value;
  end;
  CalcAdvColors;
  Invalidate;
end;

procedure TDefineTab.SetUseAdvColors (Value: Boolean);
begin
  if Value <> FUseAdvColors then
  begin
    FUseAdvColors := Value;
    ParentColor := Value;
    CalcAdvColors;
    Invalidate;
  end;
end;

procedure TDefineTab.CMSysColorChange (var Message: TMessage);
begin
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TDefineTab.CMParentColorChanged (var Message: TWMNoParams);
begin
  inherited;
  if FUseAdvColors then
  begin
    ParentColor := True;
    CalcAdvColors;
  end;
  Invalidate;
end;

procedure TDefineTab.Loaded;
begin
  inherited;
  SetTabRect;
  Invalidate;
end;

procedure TDefineTab.WMSize (var Message: TWMSize);
begin
  inherited;
  SetTabRect;
  Invalidate;
end;

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

procedure TDefineTab.SetTabPosition (Value: TFlatTabPosition);
var
  I: Integer;
  r: TRect;
begin
  if Value <> FTabPosition then
  begin
    for I := 0 to ControlCount - 1 do // reposition client-controls
    begin
      if Value = fpTop then
        Controls[I].Top := Controls[I].Top + TabHeight
      else
        Controls[I].Top := Controls[I].Top - TabHeight;
    end;
    FTabPosition := Value;
    SetTabRect;
    Invalidate;
    r := ClientRect;
    AlignControls(self, r);
  end;
end;

procedure TDefineTab.SetTabIndex (Value: Integer);
begin
  if FTabs <> nil then begin
    if Value > (FTabs.Count - 1) then
       Value := FTabs.Count - 1
    else if Value < 0 then
        Value := 0;

    FTabIndex := Value;
    if Assigned(FOnChange) then
       FOnChange(Self);
    Invalidate;
  end else FTabIndex := 0;
  if csDesigning in ComponentState then
    if (GetParentForm(self) <> nil) and (GetParentForm(self).Designer <> nil) then
      GetParentForm(self).Designer.Modified;
end;

procedure TDefineTab.SetColors (Index: Integer; Value: TColor);
begin
  case Index of
    0: FBorderColor := Value;
    1: FUnselectedColor := Value;
  end;
  Invalidate;
end;

procedure TDefineTab.SetTabs (Value: TStringList);
var
  counter: Integer;
begin
  FTabs.Assign(Value);
  if FTabs.Count = 0 then // no tabs? then active tab = 0
    FTabIndex := 0
  else
    begin
      if (FTabs.Count - 1) < FTabIndex then // if TabIndex > last-tab the TabIndex = last-tab
        FTabIndex := FTabs.Count - 1;
      for counter := 0 to FTabs.Count - 1 do
        FTabs[counter] := Trim(FTabs[counter]); // delete all spaces at left and right
    end;
  SetTabRect;
  Invalidate;
end;

procedure TDefineTab.SetTabHeight (Value: Integer);
var
  r: TRect;
begin
  if Value < 0 then Value := 0; // TabHeigh can't negative
  FTabHeight := Value;
  SetTabRect;
  r := ClientRect;
  AlignControls(self, r);
  Invalidate;
end;