jvdockvidvcstyle.pas

East make Tray Icon in delphi

    FCaptionTopOffset: Integer;
    FTabSplitterWidth: Integer;
    FTabHeight: Integer;
    FSortList: TList;
    FSelectSheet: TJvDockVIDVCTabSheet;
    FTempPages: TList;
    FSelectHotIndex: Integer;
    FShowTabImages: Boolean;
    procedure SetPage(const Value: TJvDockVIDVCTabPageControl);
    function GetTotalTabWidth: Integer;
    procedure SetTotalTabWidth(const Value: Integer);
    function GetMinTabWidth: TJvDockTabSheet;
    function GetMaxTabWidth: TJvDockTabSheet;
    procedure SetTabBottomOffset(const Value: Integer);
    procedure SetTabLeftOffset(const Value: Integer);
    procedure SetTabRightOffset(const Value: Integer);
    procedure SetTabTopOffset(const Value: Integer);
    procedure SetCaptionLeftOffset(const Value: Integer);
    procedure SetCaptionRightOffset(const Value: Integer);
    procedure SetCaptionTopOffset(const Value: Integer);
    procedure SetTabSplitterWidth(const Value: Integer);
    function GetSorts(Index: Integer): TJvDockVIDVCTabSheet;
    function GetPanelHeight: Integer;
    function GetPanelWidth: Integer;
    procedure SetPanelHeight(const Value: Integer);
    function FindSheetWithPos(cX, cY, cTopOffset, cBottomOffset: Integer): Integer;
    function GetDockClientFromPageIndex(Index: Integer): TControl;
    procedure CMMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;
    procedure SetShowTabImages(const Value: Boolean);
    procedure SetTabHeight(const Value: Integer);
  protected
    procedure Paint; 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;
    function GetPageIndexFromMousePos(X, Y: Integer): Integer; virtual;
    procedure SetShowTabWidth;
    property TotalTabWidth: Integer read GetTotalTabWidth write SetTotalTabWidth;
    property MinTabWidth: TJvDockTabSheet read GetMinTabWidth;
    property MaxTabWidth: TJvDockTabSheet read GetMaxTabWidth;
    property TabLeftOffset: Integer read FTabLeftOffset write SetTabLeftOffset default 5;
    property TabRightOffset: Integer read FTabRightOffset write SetTabRightOffset default 5;
    property TabTopOffset: Integer read FTabTopOffset write SetTabTopOffset default 2;
    property TabBottomOffset: Integer read FTabBottomOffset write SetTabBottomOffset default 3;
    property TabSplitterWidth: Integer read FTabSplitterWidth write SetTabSplitterWidth default 2;
    property CaptionTopOffset: Integer read FCaptionTopOffset write SetCaptionTopOffset default 0;
    property CaptionLeftOffset: Integer read FCaptionLeftOffset write SetCaptionLeftOffset default 5;
    property CaptionRightOffset: Integer read FCaptionRightOffset write SetCaptionRightOffset default 5;
    property Sorts[Index: Integer]: TJvDockVIDVCTabSheet read GetSorts;
    property PanelHeight: Integer read GetPanelHeight write SetPanelHeight;
    property PanelWidth: Integer read GetPanelWidth;
    property TabHeight: Integer read FTabHeight write SetTabHeight;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
    procedure DeleteSorts(Sheet: TJvDockVIDVCTabSheet);
    property Page: TJvDockVIDVCTabPageControl read FPage write SetPage;
    property SelectSheet: TJvDockVIDVCTabSheet read FSelectSheet write FSelectSheet;
    property ShowTabImages: Boolean read FShowTabImages write SetShowTabImages;
  end;

  TJvDockTabPanelClass = class of TJvDockTabPanel;

  TJvDockVIDVCTabPageControl = class(TJvDockAdvTabPageControl)
  private
    FTabPanelClass: TJvDockTabPanelClass;
    FPanel: TJvDockTabPanel;
    FTempSheet: TJvDockVIDVCTabSheet;
    FTabImageList: TCustomImageList;
    procedure SetActiveSheetColor(const Value: TColor);
    procedure SetInactiveSheetColor(const Value: TColor);
    procedure SetTabBottomOffset(const Value: Integer);
    procedure SetTabLeftOffset(const Value: Integer);
    procedure SetTabRightOffset(const Value: Integer);
    procedure SetTabTopOffset(const Value: Integer);
    procedure SetActiveFont(const Value: TFont);
    procedure SetInactiveFont(const Value: TFont);
    procedure SetHotTrackColor(const Value: TColor);
    function GetTabBottomOffset: Integer;
    function GetTabLeftOffset: Integer;
    function GetTabRightOffset: Integer;
    function GetTabTopOffset: Integer;
    function GetInactiveSheetColor: TColor;
    function GetActiveSheetColor: TColor;
    function GetActiveFont: TFont;
    function GetInactiveFont: TFont;
    function GetVisibleSheetCount: Integer;
    function GetHotTrackColor: TColor;
    function GetShowTabImages: Boolean;
    procedure SetShowTabImages(const Value: Boolean);
    function GetPage(Index: Integer): TJvDockVIDVCTabSheet;
    function GetActiveVIDPage: TJvDockVIDVCTabSheet;
    procedure SetActiveVIDPage(const Value: TJvDockVIDVCTabSheet);
  protected
    procedure AdjustClientRect(var Rect: TRect); override;
    procedure CreatePanel; virtual;
    procedure Change; override;
    procedure CustomDockOver(Source: TJvDockDragDockObject; X, Y: Integer; State: TDragState;
      var Accept: Boolean); override;
    procedure CustomGetSiteInfo(Source: TJvDockDragDockObject; Client: TControl; var InfluenceRect: TRect;
      MousePos: TPoint; var CanDock: Boolean); override;
    procedure CustomDockDrop(Source: TJvDockDragDockObject; X, Y: Integer); override;
    procedure CustomGetDockEdge(Source: TJvDockDragDockObject; MousePos: TPoint; var DropAlign: TAlign); override;
    function CustomUnDock(Source: TJvDockDragDockObject; NewTarget: TWinControl; Client: TControl): Boolean; override;
    procedure DrawTab(TabIndex: Integer; const Rect: TRect; Active: Boolean); override;
    procedure CreateParams(var Params: TCreateParams); override;
    function GetDockClientFromMousePos(MousePos: TPoint): TControl; override;
    procedure Paint; override;
    procedure SetActivePage(Page: TJvDockTabSheet); override;
    procedure SetTabHeight(Value: Smallint); override;
    procedure SetTabPosition(Value: TTabPosition); override;
    procedure CreateWnd; override;
    procedure Loaded; override;
    procedure SetHotTrack(Value: Boolean); override;
    procedure SetImages(Value: TCustomImageList); override;
    property TabPanelClass: TJvDockTabPanelClass read FTabPanelClass write FTabPanelClass;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AfterConstruction; override;
    property ActiveVIDPage: TJvDockVIDVCTabSheet read GetActiveVIDPage write SetActiveVIDPage;
    destructor Destroy; override;
    procedure DockDrop(Source: TDragDockObject; X, Y: Integer); override;
    procedure UpdateCaption(Exclude: TControl); override;
    procedure Resize; override;
    property Pages[Index: Integer]: TJvDockVIDVCTabSheet read GetPage;
    property Panel: TJvDockTabPanel read FPanel;
    property TempSheet: TJvDockVIDVCTabSheet read FTempSheet write FTempSheet;
    property VisibleSheetCount: Integer read GetVisibleSheetCount;
  published
    property ActiveSheetColor: TColor read GetActiveSheetColor write SetActiveSheetColor;
    property InactiveSheetColor: TColor read GetInactiveSheetColor write SetInactiveSheetColor;
    property TabLeftOffset: Integer read GetTabLeftOffset write SetTabLeftOffset default 5;
    property TabRightOffset: Integer read GetTabRightOffset write SetTabRightOffset default 5;
    property TabTopOffset: Integer read GetTabTopOffset write SetTabTopOffset default 2;
    property TabBottomOffset: Integer read GetTabBottomOffset write SetTabBottomOffset default 3;
    property ActiveFont: TFont read GetActiveFont write SetActiveFont;
    property InactiveFont: TFont read GetInactiveFont write SetInactiveFont;
    property HotTrackColor: TColor read GetHotTrackColor write SetHotTrackColor;
    property ShowTabImages: Boolean read GetShowTabImages write SetShowTabImages;
    property ActivePage;
    property Align;
    property Anchors;
    property BiDiMode;
    property Constraints;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property Font;
    property HotTrack;
    property Images;
    property MultiLine;
    property OwnerDraw;
    property ParentBiDiMode;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property RaggedRight;
    property ScrollOpposite;
    property ShowHint;
    property Style;
    property TabHeight;
    property TabIndex;
    property TabOrder;
    property TabPosition;
    property TabStop;
    property TabWidth;
    property Visible;
    property OnChange;
    property OnChanging;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDragDrop;
    property OnDragOver;
    property OnDrawTab;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetImageIndex;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
  end;

  TJvDockVIDVCDragDockObject = class(TJvDockDragDockObject)
  private
    FOldDropAlign: TAlign;
    FCurrState: TDragState;
    FOldState: TDragState;
    FOldTarget: Pointer;
    FSourceDockClientList: TList;
    FDropTabControl: TJvDockVIDVCTabPageControl;
    FIsTabDockOver: Boolean;
    FErase: Boolean;
    function GetSourceDockClient(Index: Integer): TControl;
    function GetSourceDockClientCount: Integer;
    procedure SetOldState(const Value: TDragState);
    procedure SetCurrState(const Value: TDragState);
  protected
    procedure GetBrush_PenSize_DrawRect(var ABrush: TBrush;
      var PenSize: Integer; var DrawRect: TRect; Erase: Boolean); override;
    procedure MouseMsg(var Msg: TMessage); override;
    procedure DefaultDockImage(Erase: Boolean); override;
    function CanLeave(NewTarget: TWinControl): Boolean; override;
  public
    constructor Create(AControl: TControl); override;
    destructor Destroy; override;
    function DragFindWindow(const Pos: TPoint): HWND; override;
    function GetDropCtl: TControl; override;
    property SourceDockClients[Index: Integer]: TControl read GetSourceDockClient;
    property SourceDockClientCount: Integer read GetSourceDockClientCount;
    property CurrState: TDragState read FCurrState write SetCurrState;
    property OldState: TDragState read FOldState write SetOldState;
  end;

procedure PaintGradientBackground(Canvas: TCanvas; ARect: TRect; StartColor, EndColor: TColor);

{$IFDEF USEJVCL}
{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvDockVIDVCStyle.pas,v $';
    Revision: '$Revision: 1.19 $';
    Date: '$Date: 2005/02/17 10:20:25 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}
{$ENDIF USEJVCL}

implementation

uses
  {$IFDEF JVCLThemesEnabled}
  JvThemes,
  {$ENDIF JVCLThemesEnabled}
  Consts, SysUtils, Math, Forms, ExtCtrls,
  JvDockSupportProc, JvDockGlobals;

type
  TWinControlAccessProtected = class(TWinControl);

// (rom) such global variables are problematic
var
  gi_DockRect: TRect;

{ (rb) Compare to PaintGradientBackground in JvDockVIDStyle.pas }
procedure PaintGradientBackground(Canvas: TCanvas; ARect: TRect;
  StartColor, EndColor: TColor);
const
  D = 256;
var
  X, C1, C2, R1, G1, B1, W: Integer;
  DR, DG, DB, DH: Real;

  procedure InitRGBValues(C1, C2: Integer);
  begin
    R1 := GetRValue(C1);
    G1 := GetGValue(C1);
    B1 := GetBValue(C1);
    DR := (GetRValue(C2) - R1) / D;
    DG := (GetGValue(C2) - G1) / D;
    DB := (GetBValue(C2) - B1) / D;
  end;

begin
  with Canvas do
  begin
    Lock;
    try
      Brush.Style := bsSolid;

      { !! GetRValue etc. assume that the input param is a RGB value thus
           NO system color, such as clWindowText etc. }
      C1 := ColorToRGB(StartColor);
      C2 := ColorToRGB(EndColor);

      if C1 <> C2 then
      begin
        InitRGBValues(C1, C2);

        DH := (ARect.Right - ARect.Left) / D;
        for X := 0 to 255 do
        begin
          Brush.Color := RGB(R1 + Round(DR * X), G1 + Round(DG * X),
            B1 + Round(DB * X));
          with ARect do
          begin
            if Right <= Left + Round((X + 1) * DH) then
              W := Right
            else
              W := Left + Round((X + 1) * DH);
            FillRect(Rect(Left + Round(X * DH), Top, W, Bottom))
          end;
        end;
      end
      else
      begin
        Brush.Color := StartColor;
        FillRect(ARect);
      end;
    finally
      Unlock;
    end;
  end;
end;

procedure AssignList(FromList, ToList: TList);
var
  I: Integer;
begin
  ToList.Clear;
  for I := 0 to FromList.Count - 1 do
    ToList.Add(FromList[I]);
end;

function ComputeVIDDockingRect(Target, Control: TControl; var DockRect: TRect; MousePos: TPoint): TAlign;
var
  DockTopRect: TRect;
  DockLeftRect: TRect;
  DockBottomRect: TRect;
  DockRightRect: TRect;
  DockCenterRect: TRect;
  DockTabRect: TRect;
begin
  Result := alNone;
  if Target = nil then
    Exit;

  with Target do
  begin
    DockLeftRect.TopLeft := Point(0, 0);
    DockLeftRect.BottomRight := Point(ClientWidth div 5, ClientHeight);

    DockTopRect.TopLeft := Point(ClientWidth div 5, 0);
    DockTopRect.BottomRight := Point(ClientWidth div 5 * 4, ClientHeight div 5);

    DockRightRect.TopLeft := Point(ClientWidth div 5 * 4, 0);
    DockRightRect.BottomRight := Point(ClientWidth, ClientHeight);

    if Target is TJvDockCustomTabControl then