home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kolekce / d456 / DCSLIB25.ZIP / DCStdCtrls.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2001-06-28  |  142.6 KB  |  5,290 lines
  1. {
  2.  BUSINESS CONSULTING
  3.  s a i n t - p e t e r s b u r g
  4.  
  5.          Components Library for Borland Delphi 4.x, 5.x
  6.          Copyright (c) 1998-2001 Alex'EM
  7.  
  8. }
  9. unit DCStdCtrls;
  10.  
  11. interface
  12. {$I DCConst.inc}
  13.  
  14. uses Messages, Windows, SysUtils, Classes, Controls, Forms, Menus, Graphics,
  15.      StdCtrls, DCEditTools, DCEditButton, ExtCtrls, DCConst, ComStrs, ImgList;
  16.  
  17. type
  18.   TOutBarMode = (omNormal, omMoveItem);
  19.  
  20.   TDCCustomLabel = class(TCustomLabel)
  21.   private
  22.     FImages: TImageList;
  23.     FImageChangeLink: TChangeLink;
  24.     FOnMouseEnter: TNotifyEvent;
  25.     FOnMouseLeave: TNotifyEvent;
  26.     FDBObject : TDCDBObject;
  27.     function GetDBObject: TDCDBObject;
  28.     procedure SetDBObject(const Value: TDCDBObject);
  29.     procedure SetImages(const Value: TImageList);
  30.     procedure ImageListChange(Sender: TObject);
  31.   protected
  32.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  33.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  34.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  35.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  36.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  37.     property DBObject: TDCDBObject read GetDBObject write SetDBObject;
  38.     property Images: TImageList read FImages write SetImages;
  39.   public
  40.     constructor Create(AOwner: TComponent); override;
  41.     destructor Destroy; override;
  42.     procedure Paint; override;
  43.     procedure AdjustBounds; override;
  44.   end;
  45.  
  46.   TDCLabel = class(TDCCustomLabel)
  47.   published
  48.     property Alignment;
  49.     property Align;
  50.     property Anchors;
  51.     property AutoSize default False;
  52.     property BiDiMode;
  53.     property Caption;
  54.     property Color;
  55.     property Constraints;
  56.     property DragCursor;
  57.     property DragKind;
  58.     property DragMode;
  59.     property Enabled;
  60.     property FocusControl;
  61.     property Font;
  62.     property ParentBiDiMode;
  63.     property ParentColor;
  64.     property ParentFont;
  65.     property ParentShowHint;
  66.     property PopupMenu;
  67.     property ShowAccelChar;
  68.     property ShowHint;
  69.     property Transparent;
  70.     property Layout;
  71.     property Visible;
  72.     property WordWrap;
  73.     property OnClick;
  74.     property OnDblClick;
  75.     property OnDragDrop;
  76.     property OnDragOver;
  77.     property OnEndDock;
  78.     property OnEndDrag;
  79.     property OnMouseDown;
  80.     property OnMouseMove;
  81.     property OnMouseUp;
  82.     property OnStartDock;
  83.     property OnStartDrag;
  84.     property OnMouseEnter;
  85.     property OnMouseLeave;
  86.     property Images;
  87.   end;
  88.  
  89.   TDCCustomBrushImage = class(TPersistent)
  90.   private
  91.     FBitmap: TBitmap;
  92.     FImageChangeLink: TChangeLink;
  93.     FImageIndex: integer;
  94.     FImages: TImageList;
  95.     FOnChange: TNotifyEvent;
  96.     FOwner: TComponent;
  97.     procedure DoChange(Sender: TObject);
  98.     procedure SetBitmap(const Value: TBitmap);
  99.     procedure SetImages(const Value: TImageList);
  100.     procedure SetImageIndex(const Value: integer);
  101.   public
  102.     constructor Create(AOwner: TComponent); virtual;
  103.     destructor Destroy; override;
  104.     procedure Draw(ACanvas: TCanvas; ARect: TRect); virtual;
  105.     function Empty: boolean;
  106.   protected
  107.     property Images: TImageList read FImages write SetImages;
  108.     property ImageIndex: integer read FImageIndex write SetImageIndex;
  109.     property Bitmap: TBitmap read FBitmap write SetBitmap;
  110.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  111.   end;
  112.  
  113.   TDCBrushImage = class(TDCCustomBrushImage)
  114.   published
  115.     property Images;
  116.     property ImageIndex;
  117.     property Bitmap;
  118.   end;
  119.  
  120.   TDCCustomPanel = class(TCustomPanel)
  121.   private
  122.     FImages: TImageList;
  123.     FImageChangeLink: TChangeLink;
  124.     FVertCentered: boolean;
  125.     FOnMouseEnter: TNotifyEvent;
  126.     FOnMouseLeave: TNotifyEvent;
  127.     FMargins: TRect;
  128.     FBrushImage: TDCBrushImage;
  129.     procedure ChangeBrush(Sender: TObject);
  130.     procedure ImageListChange(Sender: TObject);
  131.     procedure SetVertCentered(const Value: boolean);
  132.     procedure SetImages(const Value: TImageList);
  133.     procedure SetBrushImage(const Value: TDCBrushImage);
  134.   protected
  135.     function GetRectOffset: TRect; virtual;
  136.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  137.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  138.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  139.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  140.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  141.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  142.     property VertCentered: boolean read FVertCentered write SetVertCentered;
  143.     property Images: TImageList read FImages write SetImages;
  144.   public
  145.     constructor Create(AOwner: TComponent); override;
  146.     destructor Destroy; override;
  147.     procedure Paint; override;
  148.     procedure SetMargins(Left, Top, Right, Bottom: integer);
  149.   published
  150.     property BrushImage: TDCBrushImage read FBrushImage write SetBrushImage;
  151.   end;
  152.  
  153.   TDCPanel = class(TDCCustomPanel)
  154.   public
  155.     property DockManager;
  156.   published
  157.     property Alignment stored True;
  158.     property Align stored True;
  159.     property Anchors;
  160.     property AutoSize;
  161.     property BevelInner;
  162.     property BevelOuter;
  163.     property BevelWidth;
  164.     property BiDiMode;
  165.     property BorderWidth default 2;
  166.     property BorderStyle;
  167.     property Caption;
  168.     property Color stored True;
  169.     property Constraints;
  170.     property Ctl3D;
  171.     property UseDockManager default True;
  172.     property DockSite;
  173.     property DragCursor;
  174.     property DragKind;
  175.     property DragMode;
  176.     property Enabled;
  177.     property FullRepaint;
  178.     property Font;
  179.     property Locked;
  180.     property ParentBiDiMode;
  181.     property ParentColor;
  182.     property ParentCtl3D;
  183.     property ParentFont;
  184.     property ParentShowHint;
  185.     property PopupMenu;
  186.     property ShowHint;
  187.     property TabOrder;
  188.     property TabStop;
  189.     property Visible;
  190.     property OnCanResize;
  191.     property OnClick;
  192.     property OnConstrainedResize;
  193.     property OnDockDrop;
  194.     property OnDockOver;
  195.     property OnDblClick;
  196.     property OnDragDrop;
  197.     property OnDragOver;
  198.     property OnEndDock;
  199.     property OnEndDrag;
  200.     property OnEnter;
  201.     property OnExit;
  202.     property OnGetSiteInfo;
  203.     property OnMouseDown;
  204.     property OnMouseMove;
  205.     property OnMouseUp;
  206.     property OnResize;
  207.     property OnStartDock;
  208.     property OnStartDrag;
  209.     property OnUnDock;
  210.     property OnMouseEnter;
  211.     property OnMouseLeave;
  212.     property VertCentered;
  213.     property Images;
  214.   end;
  215.  
  216.   TDCCustomHeaderPanel = class(TDCPanel)
  217.   private
  218.     FButtons: TDCEditButtons;
  219.     FClosed: boolean;
  220.     FOnCloseButtonClick: TNotifyEvent;
  221.     FButtonAllign: boolean;
  222.     procedure CloseButtonClick(Sender: TObject);
  223.     procedure AddCloseButton;
  224.     procedure DelCloseButton;
  225.     procedure SetClosed(const Value: boolean);
  226.     procedure SetButtonAllign(const Value: boolean);
  227.     procedure FillNCArea;
  228.   protected
  229.     procedure CreateWnd; override;
  230.     function GetRectOffset: TRect; override;
  231.     property Closed: boolean read FClosed write SetClosed;
  232.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  233.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  234.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  235.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  236.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  237.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  238.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  239.     procedure WMNCHitTest(var Message: TWMNCHitTest); message WM_NCHITTEST;
  240.     procedure WMNCPaint(var Message: TWMNCPaint); message WM_NCPAINT;
  241.     property CloseButtonExist: boolean read FClosed write SetClosed;
  242.     property OnCloseButtonClick: TNotifyEvent read FOnCloseButtonClick write FOnCloseButtonClick;
  243.     property Buttons: TDCEditButtons read FButtons;
  244.   public
  245.     constructor Create(AOwner: TComponent); override;
  246.     destructor Destroy; override;
  247.     procedure Paint; override;
  248.   published
  249.     property BorderWidth default 2;
  250.     property BevelOuter default bvNone;
  251.     property ButtonAllign: boolean read FButtonAllign write SetButtonAllign;
  252.   end;
  253.  
  254.   TDCHeaderPanel = class(TDCCustomHeaderPanel)
  255.   public
  256.     property Buttons;
  257.   published
  258.     property CloseButtonExist;
  259.     property OnCloseButtonClick;
  260.     property Align default alTop;
  261.     property Color default clBtnShadow;
  262.     property BevelOuter default bvNone;
  263.   end;
  264.  
  265.   TDCCustomPageControl = class;
  266.  
  267.   TDrawTabEvent = procedure (Control: TDCCustomPageControl; Canvas: TCanvas; PageIndex: Integer;
  268.     const Rect: TRect; Active: Boolean; var DefaultDraw: boolean) of object;
  269.  
  270.   TGetItemPopup = procedure (Sender: TObject; Item: TDCEditButton;
  271.     var PopupMenu: TPopupMenu) of object;
  272.  
  273.   TDCCustomPage = class(TCustomControl)
  274.   private
  275.     FPageControl: TDCCustomPageControl;
  276.     FPageVisible: boolean;
  277.     FOnHide: TNotifyEvent;
  278.     FOnShow: TNotifyEvent;
  279.     FTabRect: TRect;
  280.     FFullVisible: boolean;
  281.     FRemoving: boolean;
  282.     FImageIndex: integer;
  283.     FBrushImage: TDCBrushImage;
  284.     procedure ChangeBrush(Sender: TObject);
  285.     function GetPageIndex: Integer;
  286.     procedure SetPageControl(const Value: TDCCustomPageControl);
  287.     procedure SetPageIndex(const Value: Integer);
  288.     procedure SetPageVisible(const Value: boolean);
  289.     procedure UpdatePageShowing;
  290.     procedure SetImageIndex(const Value: integer);
  291.     function IsPageVisible: boolean;
  292.     procedure SetBrushImage(const Value: TDCBrushImage);
  293.   protected
  294.     procedure DoHide; dynamic;
  295.     procedure DoShow; dynamic;
  296.     procedure CreateParams(var Params: TCreateParams); override;
  297.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  298.     procedure ReadState(Reader: TReader); override;
  299.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  300.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  301.     procedure CMTextChanged(var Message: TMessage); message CM_TEXTCHANGED;
  302.     procedure CMShowingChanged(var Message: TMessage); message CM_SHOWINGCHANGED;
  303.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  304.     procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
  305.     procedure DoBrushChanged; virtual;
  306.   public
  307.     constructor Create(AOwner: TComponent); override;
  308.     destructor Destroy; override;
  309.     procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer); override;
  310.     property PageControl: TDCCustomPageControl read FPageControl write SetPageControl;
  311.     procedure Paint; override;
  312.     property ImageIndex: integer read FImageIndex write SetImageIndex default -1;
  313.   published
  314.     property Caption;
  315.     property Color stored True default clBtnFace;
  316.     property Constraints;
  317.     property Enabled;
  318.     property DragMode;
  319.     property Font;
  320.     property ParentShowHint;
  321.     property PopupMenu;
  322.     property ShowHint;
  323.     property TabOrder;
  324.     property PageIndex: Integer read GetPageIndex write SetPageIndex stored False;
  325.     property PageVisible: boolean read FPageVisible write SetPageVisible default True;
  326.     property OnClick;
  327.     property OnDragDrop;
  328.     property OnDragOver;
  329.     property OnEndDrag;
  330.     property OnEnter;
  331.     property OnExit;
  332.     property OnHide: TNotifyEvent read FOnHide write FOnHide;
  333.     property OnMouseDown;
  334.     property OnMouseMove;
  335.     property OnMouseUp;
  336.     property OnResize;
  337.     property OnShow: TNotifyEvent read FOnShow write FOnShow;
  338.     property OnStartDrag;
  339.     property BrushImage: TDCBrushImage read FBrushImage write SetBrushImage;
  340.   end;
  341.  
  342.   TDCPage = class(TDCCustomPage)
  343.   protected
  344.     procedure CMBorderChanged(var Message: TMessage); message CM_BORDERCHANGED;
  345.   published
  346.     property BorderWidth default 2;
  347.     property ImageIndex;
  348.   end;
  349.  
  350.   TPageList = class(TList)
  351.   private
  352.     FVisibleList: TList;
  353.     FPageControl: TDCCustomPageControl;
  354.     function GetVisibleCount: integer;
  355.     procedure ClearVisible;
  356.     procedure UpdateVisible;
  357.     procedure AddVisible(AIndex: integer);
  358.   public
  359.     constructor Create(AComponent: TComponent);
  360.     destructor Destroy; override;
  361.     function VisibleIndexOf(Index: integer): integer;
  362.     procedure SetVisible(APage: TDCCustomPage; AVisible: boolean);
  363.     property VisibleCount: integer read GetVisibleCount;
  364.   end;
  365.  
  366.   TDCCustomPageControl = class(TCustomControl)
  367.   private
  368.     FPages: TPageList;
  369.     FActivePage: TDCCustomPage;
  370.     FOnChange: TNotifyEvent;
  371.     FOnChanging: TChangingEvent;
  372.     FOnDrawTab: TDrawTabEvent;
  373.     FTabsRect: TRect;
  374.     FImages: TImageList;
  375.     FTabVisible: boolean;
  376.     FImageChangeLink: TChangeLink;
  377.     FFirstIndex: integer;
  378.     FSelectedPage: TDCCustomPage;
  379.     FBitmap: TBitmap;
  380.     FBuffered: boolean;
  381.     FBrushImage: TDCBrushImage;
  382.     procedure ChangeActivePage(Page: TDCCustomPage); dynamic;
  383.     procedure ChangeBrush(Sender: TObject);
  384.     function GetPage(Index: Integer): TDCCustomPage;
  385.     function GetPageCount: Integer;
  386.     function GetPageIndex: integer;
  387.     procedure ImageListChange(Sender: TObject); virtual;
  388.     procedure InsertPage(Page: TDCCustomPage); virtual;
  389.     procedure RemovePage(Page: TDCCustomPage); virtual;
  390.     procedure SetBrushImage(const Value: TDCBrushImage);
  391.     procedure SetImages(const Value: TImageList); virtual;
  392.     procedure SetPageIndex(const Value: integer);
  393.     procedure SetPageVisible(APageIndex: integer; AVisible: boolean);
  394.     procedure SetTabVisible(const Value: boolean); virtual;
  395.     procedure UpdateTabsRect;
  396.   protected
  397.     procedure AdjustClientRect(var Rect: TRect); override;
  398.     function CanChange(Page: TDCCustomPage): Boolean; dynamic;
  399.     function CanShowPage(PageIndex: Integer): Boolean; virtual;
  400.     procedure Change; dynamic;
  401.     procedure CMDesignHitTest(var Message: TCMDesignHitTest); message CM_DESIGNHITTEST;
  402.     procedure CMDialogChar(var Message: TCMDialogChar); message CM_DIALOGCHAR;
  403.     procedure CMDialogKey(var Message: TCMDialogKey); message CM_DIALOGKEY;
  404.     procedure CreateParams(var Params: TCreateParams); override;
  405.     procedure DoDrawTab(ACanvas: TCanvas; ARect: TRect; AIndex: integer;
  406.       APage: TDCCustomPage; AActivePage: boolean); virtual;
  407.     procedure DrawBorder(ACanvas: TCanvas); virtual;
  408.     procedure DrawTab(ACanvas: TCanvas; ARect: TRect; AIndex: integer;
  409.       APage: TDCCustomPage; var ADefaultDraw: boolean; AExclude: boolean);
  410.     procedure DrawTabsArea(ACanvas: TCanvas); virtual;
  411.     function GetCurrentPageRect: TRect; virtual;
  412.     function GetPageAt(X, Y: integer): TDCCustomPage;
  413.     function GetTabRect(AIndex: integer; Page: TDCCustomPage;
  414.       var ARect: TRect): TRect; virtual;
  415.     function GetTabsRect: TRect; virtual;
  416.     procedure Loaded; override;
  417.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  418.     procedure RepaintTabs; virtual;
  419.     procedure SetActivePage(const Value: TDCCustomPage); virtual;
  420.     procedure ShowControl(AControl: TControl); override;
  421.     procedure TabsChanged; virtual;
  422.     procedure UpdateTabSize; virtual;
  423.     procedure UpdatePage(Page: TDCCustomPage); virtual;
  424.     procedure WMEraseBkGnd(var Message: TWMEraseBkGnd); message WM_ERASEBKGND;
  425.     procedure WMGetDlgCode(var Message: TWMGetDlgCode); message WM_GETDLGCODE;
  426.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  427.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  428.     property PageIndex: integer read GetPageIndex write SetPageIndex;
  429.     property TabsRect: TRect read FTabsRect;
  430.     property BrushImage: TDCBrushImage read FBrushImage write SetBrushImage;
  431.   public
  432.     constructor Create(AOwner: TComponent); override;
  433.     destructor Destroy; override;
  434.     procedure Paint; override;
  435.     function FindNextPage(APage: TDCCustomPage;
  436.       GoForward, CheckTabVisible: Boolean): TDCCustomPage;
  437.     function SelectNextPage(GoForward: Boolean): boolean;
  438.     procedure KeyDown(var Key: Word; Shift: TShiftState); override;
  439.     property PageCount: Integer read GetPageCount;
  440.     property Pages[Index: Integer]: TDCCustomPage read GetPage;
  441.   published
  442.     property Align;
  443.     property Color default clBtnFace;
  444.     property Enabled;
  445.     property Font;
  446.     property Visible;
  447.     property PopupMenu;
  448.     property TabStop;
  449.     property ActivePage: TDCCustomPage read FActivePage write SetActivePage;
  450.     property TabVisible: boolean read FTabVisible write SetTabVisible default True;
  451.     property OnChange: TNotifyEvent read FOnChange write FOnChange;
  452.     property OnChanging: TChangingEvent read FOnChanging write FOnChanging;
  453.     property OnDrawTab: TDrawTabEvent read FOnDrawTab write FOnDrawTab;
  454.     property Images: TImageList read FImages write SetImages;
  455.   end;
  456.  
  457.   {TDCPageControl}
  458.   TDCPageControl = class(TDCCustomPageControl)
  459.   private
  460.     FTabSize: TPoint;
  461.     FTabMargins: TRect;
  462.     FItemMargins: TRect;
  463.     FTabPosition: TLiteTabPosition;
  464.     FDrawStyle: TControlStyle;
  465.     FTabHeight: integer;
  466.     FTabWidth: integer;
  467.     FItemHeight: integer;
  468.     FPrevTrack, FNextTrack: TDCEditButton;
  469.     FMouseDown: boolean;
  470.     FTimer: boolean;
  471.     FCanvasLocked: boolean;
  472.     FRedrawTabs: boolean;
  473.     FChangedPage: TDCCustomPage;
  474.     FPageSelected: boolean;
  475.     FTabColor: TColor;
  476.     procedure SetTabHeight(const Value: integer);
  477.     procedure SetTabWidth(const Value: integer);
  478.     function ControlRect: TRect;
  479.     procedure SetDrawStyle(const Value: TControlStyle);
  480.     procedure SetTabPosition(const Value: TLiteTabPosition); virtual;
  481.     procedure ButtonsUp(Sender: TObject);
  482.     procedure ButtonsDown(Sender: TObject);
  483.     procedure PaintTracks;
  484.     procedure UpdateTracksState(X, Y: integer; lMove: boolean);
  485.     procedure HideTrack(Track: TDCEditButton);
  486.     procedure UpdateTabs;
  487.     procedure CheckToNextTrack;
  488.     procedure CheckToPrevTrack;
  489.     procedure ClearSelection;
  490.     procedure UpdateFirstIndex;
  491.     procedure ChangeActivePage(Page: TDCCustomPage); override;
  492.     procedure RedrawTab(Page: TDCCustomPage);
  493.     procedure SetTabColor(const Value: TColor);
  494.     function GetItemSize(Page: TDCCustomPage): TPoint;
  495.     procedure DrawTabDiv(ACanvas: TCanvas; ARect: TRect; AActivePage, AFirst: boolean); virtual;
  496.   protected
  497.     procedure CreateWnd; override;
  498.     procedure Loaded; override;
  499.     procedure MouseMove(Shift: TShiftState; X, Y: Integer); override;
  500.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  501.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  502.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  503.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  504.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  505.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  506.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  507.     procedure WMSize(var Message: TMessage); message WM_SIZE;
  508.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  509.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  510.     procedure WMSetFocus(var Message: TWMSetFocus); message WM_SETFOCUS;
  511.     procedure CMRedrawTab(var Message: TMessage); message CM_REDRAWTAB;
  512.     procedure UpdateTabSize; override;
  513.     function GetCurrentPageRect: TRect; override;
  514.     function GetTabRect(AIndex: integer; Page: TDCCustomPage;
  515.       var ARect: TRect): TRect; override;
  516.     function GetTabsRect: TRect; override;
  517.     procedure DrawBorder(ACanvas: TCanvas); override;
  518.     procedure DoDrawTab(ACanvas: TCanvas; ARect: TRect; AIndex: integer;
  519.       APage: TDCCustomPage; AActivePage: boolean); override;
  520.     procedure DrawTabText(ACanvas: TCanvas; ARect: TRect; AIndex: integer;
  521.       APage: TDCCustomPage; AActivePage: boolean);
  522.     procedure DrawTabsArea(ACanvas: TCanvas); override;
  523.     function CanChange(Page: TDCCustomPage): Boolean; override;
  524.     procedure CreateTracks; virtual;
  525.     procedure UpdateTracksPos; virtual;
  526.     procedure TabsChanged; override;
  527.     procedure UpdatePage(Page: TDCCustomPage); override;
  528.   public
  529.     constructor Create(AComponent: TComponent); override;
  530.     destructor Destroy; override;
  531.     procedure Paint; override;
  532.   published
  533.     property TabHeight: integer read FTabSize.Y write SetTabHeight default 0;
  534.     property TabWidth: integer read FTabSize.X write SetTabWidth default 0;
  535.     property DrawStyle: TControlStyle read FDrawStyle write SetDrawStyle default fcsNormal;
  536.     property TabPosition: TLiteTabPosition read FTabPosition write SetTabPosition default tbBottom;
  537.     property TabColor: TColor read FTabColor write SetTabColor default clBtnShadow;
  538.     property DragKind;
  539.     property DragMode;
  540.     property Anchors;
  541.     {$IFDEF DELPHI_V5UP}
  542.     property OnContextPopup;
  543.     {$ENDIF}
  544.     property OnDockDrop;
  545.     property OnDockOver;
  546.     property OnDragDrop;
  547.     property OnDragOver;
  548.     property OnEndDock;
  549.     property OnEndDrag;
  550.     property OnMouseDown;
  551.     property OnMouseMove;
  552.     property OnMouseUp;
  553.     property OnGetSiteInfo;
  554.     property OnResize;
  555.     property OnStartDock;
  556.     property OnStartDrag;
  557.     property OnUnDock;
  558.     property BrushImage;
  559.   end;
  560.  
  561.   {TDCOutBar}
  562.  
  563.   TImagesStyle     = (isSmallImages, isLargeImages);
  564.   TOutPanelOption  = (opDropDown, opItemMove);
  565.   TOutPanelOptions = set of TOutPanelOption;
  566.  
  567.   TDCCustomOutBarPanel = class(TDCCustomPage)
  568.   private
  569.     FButtons: TDCEditButtons;
  570.     FLargeImages: TImageList;
  571.     FSmallImages: TImageList;
  572.     FOnMouseEnter: TNotifyEvent;
  573.     FOnMouseLeave: TNotifyEvent;
  574.     FStyle: TImagesStyle;
  575.     FFirstIndex: integer;
  576.     FPrevTrack, FNextTrack: TDCEditButton;
  577.     FMouseDown: boolean;
  578.     FTimer: boolean;
  579.     FRegionDC: HDC;
  580.     FOptions: TOutPanelOptions;
  581.     FClear: boolean;
  582.     FAnchorStyle: TAnchorStyle;
  583.     FImageChangeLink: TChangeLink;
  584.     FOnItemClick: TNotifyEvent;
  585.     FHintObject: TObject;
  586.     FCanvasLocked: boolean;
  587.     FOnGetItemPopup: TGetItemPopup;
  588.     procedure SetLargeImages(const Value: TImageList);
  589.     procedure SetSmallImages(const Value: TImageList);
  590.     procedure SetStyle(const Value: TImagesStyle);
  591.     procedure CheckArea(Sender: TObject; X, Y: integer; var Selected: boolean);
  592.     procedure SetButtonState(Sender: TObject; var State: TButtonState); virtual;
  593.     procedure UpdateTracksState(X, Y: integer; lMove: boolean);
  594.     procedure PaintTracks;
  595.     procedure GetButtonsRegion(Sender: TObject; var Rgn: HRGN);
  596.     procedure ButtonsUp(Sender: TObject);
  597.     procedure ButtonsDown(Sender: TObject);
  598.     procedure HideTrack(Track: TDCEditButton);
  599.     procedure CheckToNextTrack;
  600.     procedure CheckToPrevTrack;
  601.     function GetActiveButton: TDCEditButton;
  602.     procedure SetOptions(const Value: TOutPanelOptions);
  603.     procedure SetDropDown(const Value: boolean);
  604.     procedure SetFirstIndex(const Value: integer);
  605.     procedure SetActiveButton(Value: TDCEditButton);
  606.     procedure ImageListChange(Sender: TObject);
  607.     function GetItemIndex: integer;
  608.     procedure SetItemIndex(const Value: integer);
  609.   protected
  610.     procedure CreateWnd; override;
  611.     function GetPopupMenu: TPopupMenu; override;
  612.     procedure Loaded; override;
  613.     procedure DrawButtonHint(Sender: TObject; Mode: integer); virtual;
  614.     function FormatText(const Value: string; Offset: integer;
  615.       var TextSize: TPoint): string;
  616.     function DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
  617.     procedure CMCancelMode(var Message: TCMCancelMode); message CM_CANCELMODE;
  618.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  619.     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  620.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  621.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  622.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  623.     procedure WMKillFocus(var Message: TWMKillFocus); message WM_KILLFOCUS;
  624.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  625.     procedure WMLButtonDblClk(var Message: TWMLButtonDown); message WM_LBUTTONDBLCLK;
  626.     procedure WMLButtonUp(var Message: TWMLButtonUp); message WM_LBUTTONUP;
  627.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  628.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  629.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  630.     function ButtonVisible(Button: TDCEditButton): boolean; virtual;
  631.     function TracksCovering: boolean; virtual;
  632.     procedure CreateTracks; virtual;
  633.     procedure UpdateTracksPos; virtual;
  634.     procedure SetButtonPos(Index: integer); virtual;
  635.     procedure ItemClick(Sender: TObject); virtual;
  636.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  637.     procedure DoBrushChanged; override;
  638.     property LargeImages: TImageList read FLargeImages write SetLargeImages;
  639.     property SmallImages: TImageList read FSmallImages write SetSmallImages;
  640.     property Style: TImagesStyle read FStyle write SetStyle;
  641.   public
  642.     constructor Create(AOwner: TComponent); override;
  643.     destructor Destroy; override;
  644.     function AddButton: TDCEditButton; virtual;
  645.     procedure DeleteButton(Index: integer);
  646.     procedure Paint; override;
  647.     procedure UpdateButtonsPos;
  648.     procedure SelectItem(Button: TDCEditButton);
  649.     property Buttons: TDCEditButtons read FButtons write FButtons stored False;
  650.     property ActiveButton: TDCEditButton read GetActiveButton write SetActiveButton;
  651.   published
  652.     property Items: TDCEditButtons read FButtons write FButtons;
  653.     property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
  654.     property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
  655.     property OnItemClick: TNotifyEvent read FOnItemClick write FOnItemClick;
  656.     property FirstIndex: integer read FFirstIndex write SetFirstIndex stored False;
  657.     property ItemIndex: integer read GetItemIndex write SetItemIndex stored False;
  658.     property Options: TOutPanelOptions read FOptions write SetOptions;
  659.     property OnGetItemPopup: TGetItemPopup read FOnGetItemPopup write FOnGetItemPopup;
  660.     property OnEnter;
  661.     property OnExit;
  662.     property OnMouseDown;
  663.     property OnMouseMove;
  664.     property OnMouseUp;
  665.   end;
  666.  
  667.   TDCOutBarPanel = class(TDCCustomOutBarPanel)
  668.   published
  669.     property LargeImages;
  670.     property SmallImages;
  671.     property Style;
  672.     property OnDblClick;
  673.     property OnClick;
  674.     property ImageIndex;
  675.     {$IFDEF DELPHI_V5UP}
  676.     property OnContextPopup;
  677.     {$ENDIF}
  678.   end;
  679.  
  680.   TDCCustomOutBar = class(TDCCustomPageControl)
  681.   private
  682.     FTabHeight: integer;
  683.     FItemHeight: integer;
  684.     FTabSize: TPoint;
  685.     FTabMargins: TRect;
  686.     FMode: TOutBarMode;
  687.     FTextAlignment: TAlignment;
  688.     function ControlRect: TRect;
  689.     procedure SetTabHeight(const Value: integer);
  690.     procedure SetTextAlignment(const Value: TAlignment);
  691.   protected
  692.     procedure CreateWnd; override;
  693.     procedure Loaded; override;
  694.     procedure CMFontChanged(var Message: TMessage); message CM_FONTCHANGED;
  695.     procedure WMMouseMove(var Message: TWMMouseMove); message WM_MOUSEMOVE;
  696.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  697.     procedure WMTimer(var Message: TWMTimer); message WM_TIMER;
  698.     function GetCurrentPageRect: TRect; override;
  699.     function GetTabRect(AIndex: integer; Page: TDCCustomPage;
  700.       var ARect: TRect): TRect; override;
  701.     procedure UpdateTabSize; override;
  702.     function GetTabsRect: TRect; override;
  703.     procedure DrawBorder(ACanvas: TCanvas); override;
  704.     procedure DoDrawTab(ACanvas: TCanvas; ARect: TRect; AIndex: integer;
  705.       APage: TDCCustomPage; AActivePage: boolean); override;
  706.     procedure DrawTabsArea(ACanvas: TCanvas); override;
  707.     procedure TabsChanged; override;
  708.   public
  709.     constructor Create(AComponent: TComponent); override;
  710.     procedure Paint; override;
  711.   published
  712.     property TabHeight: integer read FTabSize.Y write SetTabHeight;
  713.     property TextAlignment: TAlignment read FTextAlignment write SetTextAlignment default taCenter;
  714.   end;
  715.  
  716.   TDCOutBar = class(TDCCustomOutBar)
  717.     {}
  718.   end;
  719.  
  720.   TDCPaleteBar = class;
  721.  
  722.   TDCPaleteBarPanel = class(TDCCustomOutBarPanel)
  723.   private
  724.     FDrawText: boolean;
  725.     FIconStyle: boolean;
  726.     procedure UpdateButtonsVisible;
  727.     function GetImages: TImageList;
  728.     procedure SetImages(const Value: TImageList);
  729.     procedure SetDrawText(const Value: boolean);
  730.     procedure SetIconStyle(const Value: boolean);
  731.   protected
  732.     procedure Loaded; override;
  733.     procedure Click; override;
  734.     procedure DblClick; override;
  735.     procedure CreateTracks; override;
  736.     function ButtonVisible(Button: TDCEditButton): boolean; override;
  737.     function TracksCovering: boolean; override;
  738.     procedure UpdateTracksPos; override;
  739.     procedure SetButtonPos(Index: integer); override;
  740.     procedure ItemClick(Sender: TObject); override;
  741.     procedure WMLButtonDown(var Message: TWMLButtonDown); message WM_LBUTTONDOWN;
  742.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  743.     procedure CMHintShow(var Message: TCMHintShow); message CM_HINTSHOW;
  744.     procedure WMSize(var Message: TWMSize); message WM_SIZE;
  745.     property LargeImages;
  746.     property SmallImages;
  747.     property Style;
  748.   public
  749.     constructor Create(AOwner: TComponent); override;
  750.     function AddButton: TDCEditButton; override;
  751.   published
  752.     property ImageIndex;
  753.     property Images: TImageList read GetImages write SetImages;
  754.     property DrawText: boolean read FDrawText write SetDrawText default False;
  755.     property IconStyle: boolean read FIconStyle write SetIconStyle default False;
  756.   end;
  757.  
  758.   TDCPaleteBar = class(TDCPageControl)
  759.   private
  760.     FButtons: TDCEditButtons;
  761.     FCancelExist: boolean;
  762.     FCancelSize: integer;
  763.     FOnCancel: TNotifyEvent;
  764.     procedure AddCancelButton;
  765.     procedure SetCancelButtonBounds(Repaint: boolean = True);
  766.     procedure CancelButtonClick(Sender: TObject);
  767.     procedure SetImages(const Value: TImageList); override;
  768.     procedure SetButtonState(Sender: TObject; var State: TButtonState); virtual;
  769.     procedure SetTabPosition(const Value: TLiteTabPosition); override;
  770.     procedure SetTabVisible(const Value: boolean); override;
  771.     procedure RepaintFreeArea;
  772.     procedure ImageListChange(Sender: TObject); override;
  773.     procedure InsertPage(Page: TDCCustomPage); override;
  774.     procedure RemovePage(Page: TDCCustomPage); override;
  775.     function GetSelectedItem: TDCEditButton;
  776.     procedure SetCancelExist(const Value: boolean);
  777.     procedure SetCancelSize(const Value: integer);
  778.   protected
  779.     procedure UpdateTabSize; override;
  780.     function GetCurrentPageRect: TRect; override;
  781.     procedure SetActivePage(const Value: TDCCustomPage); override;
  782.     procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
  783.     procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
  784.     procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
  785.   public
  786.     constructor Create(AComponent: TComponent); override;
  787.     destructor Destroy; override;
  788.     procedure CreateWnd; override;
  789.     procedure AdjustClientRect(var Rect: TRect); override;
  790.     procedure Cancel;
  791.     property SelectedItem: TDCEditButton read GetSelectedItem;
  792.   published
  793.     property Images;
  794.     property OnClick;
  795.     property OnDblClick;
  796.     property CancelExist: boolean read FCancelExist write SetCancelExist default False;
  797.     property CancelSize: integer read FCancelSize write SetCancelSize;
  798.     property OnCancel: TNotifyEvent read FOnCancel write FOnCancel;
  799.   end;
  800.  
  801. implementation
  802. uses DCResource;
  803.  
  804. const
  805.   BTN_CLOSE_WIDTH  = 16;
  806.   BTN_CLOSE_HEIGHT = 16;
  807.  
  808.   OBMTIMER_IDEVENT = $B0;
  809.   CTRTIMER_IDEVENT = $B1;
  810.   PNLTIMER_IDEVENT = $B2;
  811.  
  812. type
  813.  
  814.   TPrivateWinControl = class(TWinControl)
  815.   end;
  816.  
  817. var
  818.   DrawBitmap: TBitmap;
  819.  
  820. procedure CreateDrawBitmap;
  821. begin
  822.   DrawBitmap := TBitmap.Create;
  823. end;
  824.  
  825. procedure ReleaseDrawBitmap;
  826. begin
  827.   DrawBitmap.Free;
  828. end;
  829.  
  830. { TDCCustomLabel }
  831.  
  832. procedure TDCCustomLabel.AdjustBounds;
  833.  var
  834.   P: TPoint;
  835. begin
  836.   if AutoSize then
  837.   begin
  838.     Canvas.Brush.Color := Self.Color;
  839.     Canvas.Font.Assign(Self.Font);
  840.     P := DrawHighLightText(Canvas, PChar(Caption), Rect(0,0,ClientWidth, ClientHeight), 0,
  841.           DT_END_ELLIPSIS, FImages);
  842.     SetBounds(Left, Top, P.X, P.Y);
  843.   end;
  844. end;
  845.  
  846. procedure TDCCustomLabel.CMMouseEnter(var Message: TMessage);
  847. begin
  848.   inherited;
  849.   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  850. end;
  851.  
  852. procedure TDCCustomLabel.CMMouseLeave(var Message: TMessage);
  853. begin
  854.   inherited;
  855.   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  856. end;
  857.  
  858. constructor TDCCustomLabel.Create(AOwner: TComponent);
  859. begin
  860.   inherited;
  861.   AutoSize := False;
  862.   FImageChangeLink :=  TChangeLink.Create;
  863.   FImageChangeLink.OnChange := ImageListChange;
  864. end;
  865.  
  866. destructor TDCCustomLabel.Destroy;
  867. begin
  868.   FImageChangeLink.Free;
  869.   inherited;
  870. end;
  871.  
  872. function TDCCustomLabel.GetDBObject: TDCDBObject;
  873. begin
  874.   Result := FDBObject;
  875. end;
  876.  
  877. procedure TDCCustomLabel.ImageListChange(Sender: TObject);
  878. begin
  879.   Invalidate;
  880. end;
  881.  
  882. procedure TDCCustomLabel.Notification(AComponent: TComponent;
  883.   Operation: TOperation);
  884. begin
  885.   inherited Notification(AComponent, Operation);
  886.   if (Operation = opRemove) then
  887.   begin
  888.     if (AComponent = FImages) then
  889.     begin
  890.       FImages := nil;
  891.       Invalidate;
  892.       Exit;
  893.     end;
  894.   end;
  895. end;
  896.  
  897. procedure TDCCustomLabel.Paint;
  898.  var
  899.   R: TRect;
  900.   P: TPoint;
  901.  
  902.   procedure DoDrawText(ARect: TRect; AText: string);
  903.   begin
  904.     if not Enabled then
  905.     begin
  906.       OffsetRect(ARect, 1, 1);
  907.       Canvas.Font.Color := clBtnHighlight;
  908.       DrawHighLightText(Canvas, PChar(AText), ARect, 1, DT_END_ELLIPSIS, FImages);
  909.       OffsetRect(ARect, -1, -1);
  910.       Canvas.Font.Color := clBtnShadow;
  911.       DrawHighLightText(Canvas, PChar(AText), ARect, 1, DT_END_ELLIPSIS, FImages);
  912.     end
  913.     else
  914.       DrawHighLightText(Canvas, PChar(AText), ARect, 1, DT_END_ELLIPSIS, FImages);
  915.   end;
  916.  
  917. begin
  918.   with Canvas do
  919.   begin
  920.     Font := Self.Font;
  921.     Brush.Color := Self.Color;
  922.     if Transparent then
  923.       SetBkMode(Handle, Integer(TRANSPARENT))
  924.     else begin
  925.       SetBkMode(Handle, Integer(OPAQUE));
  926.       Brush.Style := bsSolid;
  927.       FillRect(ClientRect);
  928.     end;
  929.   end;
  930.   R := Rect(0,0,ClientWidth, ClientHeight);
  931.   case Alignment of
  932.     taCenter      :
  933.       begin
  934.         P := DrawHighLightText(Canvas, PChar(Caption), R, 0, DT_END_ELLIPSIS,
  935.           FImages);
  936.         R.Left  := (ClientWidth - P.X) shr 1;
  937.         R.Right := R.Left + P.X;
  938.         DoDrawText(R, Caption);
  939.       end;
  940.     taLeftJustify :
  941.        DoDrawText(R, Caption);
  942.     taRightJustify:
  943.       begin
  944.         P := DrawHighLightText(Canvas, PChar(Caption), R, 0, DT_END_ELLIPSIS,
  945.           FImages);
  946.         R.Left  := ClientWidth - P.X;
  947.         R.Right := R.Left + P.X;
  948.         DoDrawText(R, Caption);
  949.       end;
  950.   end;
  951. end;
  952.  
  953. procedure TDCCustomLabel.SetDBObject(const Value: TDCDBObject);
  954. begin
  955.   FDBObject.Assign(Value);
  956. end;
  957.  
  958. procedure TDCCustomLabel.SetImages(const Value: TImageList);
  959. begin
  960.   if Images <> nil then
  961.     Images.UnRegisterChanges(FImageChangeLink);
  962.   FImages := Value;
  963.   if Images <> nil then
  964.   begin
  965.     Images.RegisterChanges(FImageChangeLink);
  966.     Images.FreeNotification(Self);
  967.   end;
  968.   invalidate;
  969. end;
  970.  
  971. { TDCCustomPanel }
  972.  
  973. procedure TDCCustomPanel.ChangeBrush(Sender: TObject);
  974. begin
  975.   invalidate;
  976. end;
  977.  
  978. procedure TDCCustomPanel.CMMouseEnter(var Message: TMessage);
  979. begin
  980.   inherited;
  981.   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  982. end;
  983.  
  984. procedure TDCCustomPanel.CMMouseLeave(var Message: TMessage);
  985. begin
  986.   inherited;
  987.   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  988. end;
  989.  
  990. constructor TDCCustomPanel.Create(AOwner: TComponent);
  991. begin
  992.   inherited;
  993.   FBrushImage := TDCBrushImage.Create(Self);
  994.   FBrushImage.OnChange := ChangeBrush;
  995.   FVertCentered  := True;
  996.   FMargins:= Rect(0,0,0,0);
  997.   FImageChangeLink :=  TChangeLink.Create;
  998.   FImageChangeLink.OnChange := ImageListChange;
  999. end;
  1000.  
  1001. destructor TDCCustomPanel.Destroy;
  1002. begin
  1003.   FBrushImage.Free;
  1004.   FImageChangeLink.Free;
  1005.   inherited;
  1006. end;
  1007.  
  1008. function TDCCustomPanel.GetRectOffset: TRect;
  1009. begin
  1010.   Result := FMargins;
  1011. end;
  1012.  
  1013. procedure TDCCustomPanel.ImageListChange(Sender: TObject);
  1014. begin
  1015.   Invalidate;
  1016. end;
  1017.  
  1018. procedure TDCCustomPanel.Notification(AComponent: TComponent;
  1019.   Operation: TOperation);
  1020. begin
  1021.   inherited Notification(AComponent, Operation);
  1022.   if (Operation = opRemove) then
  1023.   begin
  1024.     if (AComponent = FImages) then
  1025.     begin
  1026.       FImages := nil;
  1027.       Invalidate;
  1028.       Exit;
  1029.     end;
  1030.     if (AComponent = BrushImage.Images) then
  1031.     begin
  1032.       BrushImage.Images := nil;
  1033.       Exit;
  1034.     end;
  1035.   end;
  1036. end;
  1037.  
  1038. procedure TDCCustomPanel.Paint;
  1039.  var
  1040.   Offset, Rect: TRect;
  1041.   TopColor, BottomColor: TColor;
  1042.   P: TPoint;
  1043.  
  1044.   procedure AdjustColors(Bevel: TPanelBevel);
  1045.   begin
  1046.     if Bevel = bvLowered then TopColor := clBtnShadow
  1047.     else TopColor := clBtnHighlight;
  1048.     if Bevel = bvLowered then BottomColor := clBtnHighlight
  1049.     else BottomColor := clBtnShadow;
  1050.   end;
  1051.  
  1052. begin
  1053.   CreateDrawBitmap;
  1054.   Rect := GetClientRect;
  1055.   with DrawBitmap do
  1056.   begin
  1057.     Height := Rect.Bottom-Rect.Top;
  1058.     Width  := Rect.Right-Rect.Left;
  1059.     if BevelOuter <> bvNone then
  1060.     begin
  1061.       AdjustColors(BevelOuter);
  1062.       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  1063.     end;
  1064.     Frame3D(Canvas, Rect, Color, Color, BorderWidth);
  1065.     if BevelInner <> bvNone then
  1066.     begin
  1067.       AdjustColors(BevelInner);
  1068.       Frame3D(Canvas, Rect, TopColor, BottomColor, BevelWidth);
  1069.     end;
  1070.     with Canvas do
  1071.     begin
  1072.       Brush.Style := bsSolid;
  1073.       Brush.Color := Color;
  1074.       if not FBrushImage.Empty then
  1075.         FBrushImage.Draw(Canvas, Rect)
  1076.       else
  1077.         FillRect(Rect);
  1078.       SetBkMode(Handle, Integer(TRANSPARENT));
  1079.       Font := Self.Font;
  1080.     end;
  1081.     Offset := GetRectOffset;
  1082.     InflateRect(Rect, -1, 0);
  1083.     Rect.Left   := Rect.Left   + Offset.Left;
  1084.     Rect.Top    := Rect.Top    + Offset.Top;
  1085.     Rect.Right  := Rect.Right  - Offset.Right;
  1086.     Rect.Bottom := Rect.Bottom - Offset.Bottom;
  1087.  
  1088.     P := Point(0,0);
  1089.  
  1090.     if FVertCentered then
  1091.     begin
  1092.       P := DrawHighLightText(Canvas, PChar(Caption), Rect, 0, DT_END_ELLIPSIS,
  1093.         FImages);
  1094.       Rect.Top := (ClientHeight - P.Y) div 2;
  1095.     end;
  1096.  
  1097.     case Alignment of
  1098.       taCenter      :
  1099.         begin
  1100.           if (P.X=0) and (P.Y=0) then
  1101.              P := DrawHighLightText(Canvas, PChar(Caption), Rect, 0,
  1102.                DT_END_ELLIPSIS, FImages);
  1103.           if P.X < (ClientWidth-Offset.Left-Offset.Right) then
  1104.           begin
  1105.             Rect.Left  := Offset.Left+((ClientWidth-Offset.Left-Offset.Right-P.X) div 2);
  1106.             Rect.Right := Rect.Left + P.X;
  1107.           end;
  1108.           DrawHighLightText(Canvas, PChar(Caption), Rect, 1, DT_END_ELLIPSIS,
  1109.             FImages);
  1110.         end;
  1111.       taLeftJustify :
  1112.         DrawHighLightText(Canvas, PChar(Caption), Rect, 1, DT_END_ELLIPSIS,
  1113.           FImages);
  1114.       taRightJustify:
  1115.         begin
  1116.           if (P.X=0) and (P.Y=0) then
  1117.              P := DrawHighLightText(Canvas, PChar(Caption), Rect, 0,
  1118.                DT_END_ELLIPSIS, FImages);
  1119.           Rect.Right := ClientWidth - Offset.Right;
  1120.           Rect.Left  := Offset.Left + Rect.Right - P.X;
  1121.           if Rect.Left < Offset.Left then Rect.Left := Offset.Left;
  1122.           DrawHighLightText(Canvas, PChar(Caption), Rect, 1, DT_END_ELLIPSIS,
  1123.             FImages);
  1124.         end;
  1125.     end;
  1126.   end;
  1127.   Canvas.Draw(0, 0, DrawBitmap);
  1128.   ReleaseDrawBitmap;
  1129. end;
  1130.  
  1131. procedure TDCCustomPanel.SetBrushImage(const Value: TDCBrushImage);
  1132. begin
  1133.   FBrushImage.Assign(Value);
  1134. end;
  1135.  
  1136. procedure TDCCustomPanel.SetImages(const Value: TImageList);
  1137. begin
  1138.   if Images <> nil then
  1139.     Images.UnRegisterChanges(FImageChangeLink);
  1140.   FImages := Value;
  1141.   if Images <> nil then
  1142.   begin
  1143.     Images.RegisterChanges(FImageChangeLink);
  1144.     Images.FreeNotification(Self);
  1145.   end;
  1146.   invalidate;
  1147. end;
  1148.  
  1149. procedure TDCCustomPanel.SetMargins(Left, Top, Right, Bottom: integer);
  1150. begin
  1151.   if Left   > 0 then FMargins.Left  := Left;
  1152.   if Top    > 0 then FMargins.Top   := Top;
  1153.   if Right  > 0 then FMargins.Right := Right;
  1154.   if Bottom > 0 then FMargins.Bottom:= Bottom;
  1155.   Invalidate;
  1156. end;
  1157.  
  1158. procedure TDCCustomPanel.SetVertCentered(const Value: boolean);
  1159. begin
  1160.   FVertCentered := Value;
  1161.   Invalidate;
  1162. end;
  1163.  
  1164. procedure TDCCustomPanel.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  1165. begin
  1166.   Message.Result := 0;
  1167. end;
  1168.  
  1169. { TDCCustomHeaderPanel }
  1170.  
  1171. procedure TDCCustomHeaderPanel.AddCloseButton;
  1172. begin
  1173.   with FButtons, FButtons.AddButton do
  1174.   begin
  1175.     Name := '$Close$';
  1176.     Allignment := abCenter;
  1177.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNCLOSE');
  1178.     Font  := Self.Font;
  1179.     Style := stShadowFlat;
  1180.     AbsolutePos  := False;
  1181.     DisableStyle := deNormal;
  1182.     BrushColor   := Color;
  1183.     DrawText     := False;
  1184.     OnClick      := CloseButtonClick;
  1185.     if FButtonAllign then
  1186.     begin
  1187.       SetBounds(Rect(Self.Width - (BTN_CLOSE_WIDTH + 2),
  1188.         (Self.Height - BTN_CLOSE_HEIGHT) div 2, BTN_CLOSE_WIDTH, BTN_CLOSE_HEIGHT));
  1189.       AnchorStyle  := asCnR;
  1190.     end
  1191.     else begin
  1192.       SetBounds(Rect(Self.Width - (BTN_CLOSE_WIDTH + 2),
  1193.         2, BTN_CLOSE_WIDTH, BTN_CLOSE_HEIGHT));
  1194.       AnchorStyle  := asTR;
  1195.     end;
  1196.   end;
  1197. end;
  1198.  
  1199. procedure TDCCustomHeaderPanel.CloseButtonClick(Sender: TObject);
  1200. begin
  1201.   if Assigned(FOnCloseButtonClick) then FOnCloseButtonClick(Self)
  1202. end;
  1203.  
  1204. procedure TDCCustomHeaderPanel.CMCancelMode(var Message: TCMCancelMode);
  1205.   var
  1206.    Pos: TPoint;
  1207.    Button: TDCEditButton;
  1208. begin
  1209.   if Message.Sender = Self then
  1210.   begin
  1211.     GetCursorPos(Pos);
  1212.     with FButtons do
  1213.       if not MouseInButtonArea(Pos.X, Pos.Y, Button) then ResetProperties;
  1214.   end
  1215.   else
  1216.     FButtons.ResetProperties;
  1217.   inherited;
  1218. end;
  1219.  
  1220. procedure TDCCustomHeaderPanel.CMColorChanged(var Message: TMessage);
  1221. begin
  1222.   inherited;
  1223.   if Assigned(FButtons) then
  1224.   begin
  1225.     FButtons.Color := Color;
  1226.     if HandleAllocated then
  1227.     begin
  1228.       FillNCArea;
  1229.       FButtons.Invalidate;
  1230.     end;
  1231.   end;
  1232. end;
  1233.  
  1234. procedure TDCCustomHeaderPanel.CMDialogChar(var Message: TCMDialogChar);
  1235.  var
  1236.   Button: TDCEditButton;
  1237. begin
  1238.   with Message do
  1239.   begin
  1240.     if Buttons.IsButtonAccel(Message.CharCode, Button) then
  1241.     begin
  1242.       Result := 1;
  1243.       Button.Click;
  1244.     end
  1245.     else
  1246.       inherited;
  1247.   end;    
  1248. end;
  1249.  
  1250. procedure TDCCustomHeaderPanel.CMMouseEnter(var Message: TMessage);
  1251. begin
  1252.   inherited;
  1253.   FButtons.MouseDown := GetAsyncKeyState(VK_LBUTTON)<0;
  1254. end;
  1255.  
  1256. procedure TDCCustomHeaderPanel.CMMouseLeave(var Message: TMessage);
  1257. begin
  1258.   inherited;
  1259.   FButtons.UpdateButtons( -1, -1, False, True);
  1260. end;
  1261.  
  1262. constructor TDCCustomHeaderPanel.Create(AOwner: TComponent);
  1263. begin
  1264.   inherited;
  1265.   FButtons := TDCEditButtons.Create(Self);
  1266.   FButtons.AnchorStyle := asNone;
  1267.   FClosed  := True;
  1268.  
  1269.   Height   := BTN_CLOSE_HEIGHT+4;
  1270.   Align    := alTop;
  1271.   Color    := clBtnShadow;
  1272.   Alignment:= taLeftJustify;
  1273.  
  1274.   BorderWidth:= 2;
  1275.   BevelOuter := bvNone;
  1276.  
  1277.   FButtons.Color := Color;
  1278. end;
  1279.  
  1280. procedure TDCCustomHeaderPanel.CreateWnd;
  1281. begin
  1282.   inherited;
  1283.   if Parent <> nil then
  1284.   begin
  1285.     FButtons.ClrWndProc;
  1286.     FButtons.SetWndProc;
  1287.     if FClosed then begin
  1288.       AddCloseButton;
  1289.       MoveWindow(Handle, Left, Top, Width, Height, False);
  1290.     end;
  1291.   end;
  1292. end;
  1293.  
  1294. procedure TDCCustomHeaderPanel.DelCloseButton;
  1295.  var
  1296.   CloseButton: TDCEditButton;
  1297. begin
  1298.   CloseButton := FButtons.FindButton('$Close$');
  1299.   if Assigned(CloseButton) then FButtons.DeleteButton(CloseButton.Index);
  1300. end;
  1301.  
  1302. destructor TDCCustomHeaderPanel.Destroy;
  1303. begin
  1304.   FButtons.Free;
  1305.   inherited;
  1306. end;
  1307.  
  1308. procedure TDCCustomHeaderPanel.FillNCArea;
  1309.  var
  1310.   DC: HDC;
  1311.   R: TRect;
  1312.   ABrush: HBRUSH;
  1313. begin
  1314.   if CloseButtonExist then
  1315.   begin
  1316.     DC := GetWindowDC(Handle);
  1317.     try
  1318.       GetWindowRect (Handle, R);  OffsetRect (R, -R.Left, -R.Top);
  1319.       R.Left := R.Right - BTN_CLOSE_WIDTH - 4;
  1320.       ABrush := CreateSolidBrush(ColorToRGB(Color));
  1321.       FillRect(DC, R, ABrush);
  1322.       DeleteObject(ABrush);
  1323.     finally
  1324.       ReleaseDC(Handle, DC);
  1325.     end;
  1326.   end;
  1327. end;
  1328.  
  1329. function TDCCustomHeaderPanel.GetRectOffset: TRect;
  1330. begin
  1331.   Result := inherited GetRectOffset;
  1332. end;
  1333.  
  1334. procedure TDCCustomHeaderPanel.Paint;
  1335. begin
  1336.   FButtons.UpdateDeviceRegion(Canvas.Handle);
  1337.   inherited;
  1338. end;
  1339.  
  1340. procedure TDCCustomHeaderPanel.SetButtonAllign(const Value: boolean);
  1341. begin
  1342.   if FButtonAllign <> Value then
  1343.   begin
  1344.     FButtonAllign := Value;
  1345.     if FClosed then
  1346.     begin
  1347.       SetClosed(False);
  1348.       SetClosed(True);
  1349.     end;
  1350.   end;
  1351. end;
  1352.  
  1353. procedure TDCCustomHeaderPanel.SetClosed(const Value: boolean);
  1354. begin
  1355.   if FClosed <> Value then
  1356.   begin
  1357.     FClosed := Value;
  1358.     if not FClosed then DelCloseButton;
  1359.     RecreateWnd;
  1360.   end;
  1361. end;
  1362.  
  1363. procedure TDCCustomHeaderPanel.WMKillFocus(var Message: TWMKillFocus);
  1364. begin
  1365.   FButtons.ResetProperties;
  1366.   inherited;
  1367. end;
  1368.  
  1369. procedure TDCCustomHeaderPanel.WMNCCalcSize(var Message: TWMNCCalcSize);
  1370. begin
  1371.   inherited;
  1372.   if CloseButtonExist and HandleAllocated then
  1373.   begin
  1374.     Message.CalcSize_Params^.rgrc[0].Right :=
  1375.       Message.CalcSize_Params^.rgrc[0].Right - BTN_CLOSE_WIDTH - 4
  1376.   end;
  1377. end;
  1378.  
  1379. procedure TDCCustomHeaderPanel.WMNCHitTest(var Message: TWMNCHitTest);
  1380.  var
  1381.   Button: TDCEditButton;
  1382. begin
  1383.   inherited;
  1384.   with Message do
  1385.   begin
  1386.     if FButtons.MouseInButtonArea(XPos - Left, YPos - Top, Button) then
  1387.       Result := HTBORDER;
  1388.   end;
  1389. end;
  1390.  
  1391. procedure TDCCustomHeaderPanel.WMNCPaint(var Message: TWMNCPaint);
  1392. begin
  1393.   inherited;
  1394.   FillNCArea;
  1395. end;
  1396.  
  1397. { TDCCustomOutBarPanel }
  1398.  
  1399. function TDCCustomOutBarPanel.AddButton: TDCEditButton;
  1400.  var
  1401.   ATransparent: boolean;
  1402. begin
  1403.   Result := Buttons.AddButton;
  1404.   ATransparent := not BrushImage.Empty;
  1405.   with Result do
  1406.   begin
  1407.     case FStyle of
  1408.       isSmallImages: Allignment   := abLeft;
  1409.       isLargeImages: Allignment   := abImageTop;
  1410.     end;
  1411.     Name         := Format('%s%d',['EditButton', Index]);
  1412.     ImageIndex   := Index;
  1413.     Caption      := Name;
  1414.     Style        := stOutBar;
  1415.     Font         := Self.Font;
  1416.     BrushColor   := Self.Color;
  1417.     AbsolutePos  := False;
  1418.     Grouped      := True;
  1419.     AnchorStyle  := FAnchorStyle;
  1420.     Highlight    := False;
  1421.     DisableStyle := deNone;
  1422.  
  1423.     if opDropDown in FOptions then
  1424.       EventStyle := esDropDown
  1425.     else
  1426.       EventStyle := esNormal;
  1427.     OnCheckArea  := CheckArea;
  1428.     OnClick      := ItemClick;
  1429.     SetButtonPos(Index);
  1430.     ResetOnExitControl := False;
  1431.     Transparent := ATransparent;
  1432.   end;
  1433. end;
  1434.  
  1435. procedure TDCCustomOutBarPanel.ButtonsDown;
  1436. begin
  1437.   if FFirstIndex = 0 then Exit;
  1438.   FFirstIndex := FFirstIndex - 1;
  1439.   UpdateButtonsPos;
  1440. end;
  1441.  
  1442. procedure TDCCustomOutBarPanel.ButtonsUp;
  1443. begin
  1444.   FFirstIndex := FFirstIndex + 1;
  1445.   UpdateButtonsPos;
  1446. end;
  1447.  
  1448. procedure TDCCustomOutBarPanel.CheckArea(Sender: TObject; X, Y: integer;
  1449.   var Selected: boolean);
  1450.  var
  1451.   TextRect, ImageRect: TRect;
  1452.   P: TPoint;
  1453. begin
  1454.   with Sender as TDCEditButton do
  1455.   begin
  1456.     if Visible and (EventStyle <> esDropDown) then
  1457.     begin
  1458.       ImageRect := GetImageRect;
  1459.       TextRect  := GetTextRect(ImageRect);
  1460.       InflateRect(ImageRect, 2, 2);
  1461.       P := Point(ImageRect.Left, ImageRect.Right);
  1462.       if TextRect.Left  < P.X then P.X := TextRect.Left;
  1463.       if TextRect.Right > P.Y then P.Y := TextRect.Right;
  1464.       Selected := PtInRect(Rect(Left+P.X,Top,Left+P.Y,Top+Height), Point(X,Y));
  1465.     end;
  1466.   end;
  1467.   if FTimer then Selected := False;
  1468.   if Selected and FNextTrack.Visible then
  1469.     Selected := not PtInRect(FNextTrack.GetBounds, Point(X,Y));
  1470.   if Selected and FPrevTrack.Visible then
  1471.     Selected := not PtInRect(FPrevTrack.GetBounds, Point(X,Y));
  1472. end;
  1473.  
  1474. procedure TDCCustomOutBarPanel.CheckToNextTrack;
  1475.  var
  1476.   Button: TDCEditButton;
  1477. begin
  1478.   with Buttons do
  1479.     if Count > 0 then
  1480.     begin
  1481.       Button := Buttons[Count-1];
  1482.       with Button do
  1483.       begin
  1484.         if FNextTrack.Visible then
  1485.         begin
  1486.           if ButtonVisible(Button) or TracksCovering then HideTrack(FNextTrack);
  1487.         end
  1488.         else
  1489.           if not ButtonVisible(Button) and not TracksCovering then FNextTrack.Visible := True;
  1490.       end
  1491.    end
  1492.    else HideTrack(FNextTrack);
  1493. end;
  1494.  
  1495. procedure TDCCustomOutBarPanel.CheckToPrevTrack;
  1496.  var 
  1497.   AFirstIndex: integer; 
  1498. begin
  1499.   if FFirstIndex > 0 then
  1500.   begin
  1501.     AFirstIndex   := FFirstIndex;
  1502.     FCanvasLocked := True;
  1503.     repeat
  1504.       ButtonsDown(Self);
  1505.       if FNextTrack.Visible then
  1506.       begin
  1507.         ButtonsUp(Self);
  1508.         break;
  1509.       end;
  1510.     until (FFirstIndex = 0);
  1511.     FCanvasLocked := False;
  1512.     if FFirstIndex <> AFirstIndex then invalidate;
  1513.   end;
  1514. end;
  1515.  
  1516. procedure TDCCustomOutBarPanel.CMCancelMode(var Message: TCMCancelMode);
  1517. begin
  1518.   FButtons.ResetProperties;
  1519.   inherited;
  1520. end;
  1521.  
  1522. procedure TDCCustomOutBarPanel.CMColorChanged(var Message: TMessage);
  1523. begin
  1524.   inherited;
  1525.   Buttons.Color := Color;
  1526.   if (FPageControl <> nil) and (FPageControl.HandleAllocated) then
  1527.     FPageControl.Invalidate;
  1528.   Invalidate;
  1529. end;
  1530.  
  1531. procedure TDCCustomOutBarPanel.CMFontChanged(var Message: TMessage);
  1532.  var
  1533.   i: integer;
  1534. begin
  1535.   inherited;
  1536.   Canvas.Font := Font;
  1537.   for i := 0 to FButtons.Count-1 do
  1538.     FButtons.Buttons[i].Font := Font;
  1539.   UpdateButtonsPos;  
  1540. end;
  1541.  
  1542. procedure TDCCustomOutBarPanel.CMMouseEnter(var Message: TMessage);
  1543. begin
  1544.   inherited;
  1545.   if Assigned(FOnMouseEnter) then FOnMouseEnter(Self);
  1546.   UnHookMouseHooks;
  1547.   FButtons.MouseDown  := GetAsyncKeyState(VK_LBUTTON)<0;
  1548. end;
  1549.  
  1550. procedure TDCCustomOutBarPanel.CMMouseLeave(var Message: TMessage);
  1551. begin
  1552.   inherited;
  1553.   if Assigned(FOnMouseLeave) then FOnMouseLeave(Self);
  1554.   FButtons.UpdateButtons( -1, -1, False, True);
  1555.   if FButtons.IsButtonsActive then HookMouseHooks(FButtons);
  1556.   FPrevTrack.UpdateButtonState(-1, -1, False, True);
  1557.   FNextTrack.UpdateButtonState(-1, -1, False, True);
  1558. end;
  1559.  
  1560. constructor TDCCustomOutBarPanel.Create(AOwner: TComponent);
  1561. begin
  1562.   inherited;
  1563.   FButtons := TDCEditButtons.Create(Self);
  1564.   FButtons.OnGetRegion   := GetButtonsRegion;
  1565.   FButtons.PaintOnSizing := False;
  1566.  
  1567.   ControlStyle := [csCaptureMouse, csClickEvents, {csOpaque,} csDoubleClicks,
  1568.     csReplicatable];
  1569.   Width       := 80;
  1570.   Height      := 150;
  1571.  
  1572.   FFirstIndex := 0;
  1573.   FMouseDown  := False;
  1574.   FTimer      := False;
  1575.   FClear      := False;
  1576.   FStyle      := isLargeImages;
  1577.   FAnchorStyle:= asTLR;
  1578.  
  1579.   FRegionDC := CreateDC('DISPLAY', NIL, NIL, NIL);
  1580.   CreateTracks;
  1581.  
  1582.   FImageChangeLink :=  TChangeLink.Create;
  1583.   FImageChangeLink.OnChange := ImageListChange;
  1584.  
  1585.   FHintObject   := nil;
  1586.   FCanvasLocked := False;
  1587.   BorderWidth   := 0; 
  1588. end;
  1589.  
  1590. procedure TDCCustomOutBarPanel.CreateTracks;
  1591. begin
  1592.   FPrevTrack:= TDCEditButton.Create(Self);
  1593.   with FPrevTrack do
  1594.   begin
  1595.     Visible := False;
  1596.     Width   := 15;
  1597.     Height  := 13;
  1598.     DrawText:= False;
  1599.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNUP');
  1600.     BrushColor := clBtnFace;
  1601.     OnClick := ButtonsDown;
  1602.   end;
  1603.  
  1604.   FNextTrack:= TDCEditButton.Create(Self);
  1605.   with FNextTrack do
  1606.   begin
  1607.     Visible := False;
  1608.     Width   := 15;
  1609.     Height  := 13;
  1610.     DrawText:= False;
  1611.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNDOWN');
  1612.     BrushColor := clBtnFace;
  1613.     OnClick := ButtonsUp;
  1614.   end;
  1615. end;
  1616.  
  1617. procedure TDCCustomOutBarPanel.CreateWnd;
  1618. begin
  1619.   inherited;
  1620.   if Parent <> nil then begin
  1621.     FButtons.ClrWndProc;
  1622.     FButtons.SetWndProc;
  1623.   end;
  1624. end;
  1625.  
  1626. procedure TDCCustomOutBarPanel.DeleteButton(Index: integer);
  1627. begin
  1628.  
  1629. end;
  1630.  
  1631. destructor TDCCustomOutBarPanel.Destroy;
  1632. begin
  1633.   if Assigned(FPrevTrack) then
  1634.   begin
  1635.     FPrevTrack.Free;
  1636.     FPrevTrack := nil;
  1637.   end;
  1638.   if Assigned(FNextTrack) then
  1639.   begin
  1640.     FNextTrack.Free;
  1641.     FNextTrack := nil;
  1642.   end;
  1643.   FButtons.Free;
  1644.   DeleteDC(FRegionDC);
  1645.   FImageChangeLink.Free;
  1646.   inherited;
  1647. end;
  1648.  
  1649. procedure TDCCustomOutBarPanel.DrawButtonHint(Sender: TObject; Mode: integer);
  1650. begin
  1651.   if Application <> nil then
  1652.   begin
  1653.     Application.CancelHint;
  1654.   end;
  1655.   case Mode of
  1656.     0:{Show}
  1657.       FHintObject := Sender;
  1658.     1:{Hide}
  1659.       FHintObject := nil;
  1660.   end;
  1661. end;
  1662.  
  1663. function TDCCustomOutBarPanel.FormatText(const Value: string; Offset: integer;
  1664.   var TextSize: TPoint): string;
  1665.  var
  1666.   SpacePos, AWidth: integer;
  1667.   ASize: TPoint;
  1668.   AText, BText, BResult: string;
  1669.   ARect: TRect;
  1670.   pValue: PChar;
  1671. begin
  1672.  
  1673.   pValue := PChar(Value);
  1674.   Result := '';
  1675.   while pValue^ <> #0 do
  1676.   begin
  1677.     if pValue^ <> #10 then Result := Result + pValue^
  1678.     else begin
  1679.       if ((pValue+1)^ <> #0) and ((pValue+1)^ <> ' ') then Result := Result +  ' ';
  1680.     end;
  1681.     Inc(pValue);
  1682.   end;
  1683.  
  1684.   {
  1685.   TextSize := DrawHighLightText(Canvas, PChar(Result), Rect(0,0,0,0), 0,
  1686.     DT_END_ELLIPSIS);
  1687.   }
  1688.  
  1689.   ARect := Rect(0,0, 500, 500);
  1690.   Windows.DrawText(Canvas.Handle, PChar(Result), Length(Result), ARect,
  1691.      DT_END_ELLIPSIS or DT_CALCRECT);
  1692.   TextSize :=  Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
  1693.  
  1694.   AWidth := ClientWidth - (ButtonOffset+Offset+3)*2;
  1695.   if (Style = isLargeImages) and (TextSize.X > AWidth) then
  1696.   begin
  1697.     SpacePos := Pos(' ', Result);
  1698.     if SpacePos > 0 then
  1699.     begin
  1700.       ASize    := Point(0, 0);
  1701.       BText    := '';
  1702.       repeat
  1703.         if BText = '' then
  1704.         begin
  1705.           BText   := Copy(Result, 1, SpacePos-1);
  1706.           BResult := Copy(Result, SpacePos+1, Length(Result)-SpacePos);
  1707.           AText   := BText;
  1708.           Result  := BResult;
  1709.         end
  1710.         else begin
  1711.           BText   := AText;
  1712.           BResult := Result;
  1713.           AText   := BText + ' ' + Copy(Result, 1, SpacePos-1);
  1714.           Result  := Copy(Result, SpacePos+1, Length(Result)-SpacePos);
  1715.         end;
  1716.         Windows.DrawText(Canvas.Handle, PChar(AText), Length(AText), ARect,
  1717.           DT_END_ELLIPSIS or DT_CALCRECT);
  1718.         ASize :=  Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
  1719.  
  1720.         SpacePos := Pos(' ', Result);
  1721.       until (SpacePos = 0) or (ASize.X > AWidth );
  1722.  
  1723.       Result := Format('%s'#10'%s', [BText, BResult]);
  1724.       Windows.DrawText(Canvas.Handle, PChar(Result), Length(Result), ARect,
  1725.         DT_END_ELLIPSIS or DT_CALCRECT);
  1726.       TextSize :=  Point(ARect.Right - ARect.Left, ARect.Bottom - ARect.Top);
  1727.     end;
  1728.   end;
  1729. end;
  1730.  
  1731. function TDCCustomOutBarPanel.GetActiveButton: TDCEditButton;
  1732. begin
  1733.   Result := FButtons.ActiveButton;
  1734. end;
  1735.  
  1736. procedure TDCCustomOutBarPanel.GetButtonsRegion(Sender: TObject;
  1737.   var Rgn: HRGN);
  1738. begin
  1739.   with ClientRect do
  1740.     if csDesigning in ComponentState then
  1741.       Rgn := CreateRectRgn( 1, 1, ClientWidth-1, ClientHeight-1)
  1742.     else
  1743.       Rgn := CreateRectRgn( 0, 0, ClientWidth-1, ClientHeight);
  1744.   SelectClipRgn(FRegionDC, Rgn);
  1745.  
  1746.   if FPrevTrack.Visible then
  1747.     with FPrevTrack do
  1748.        ExcludeClipRect(FRegionDC, Left, Top, Left+Width, Top+Height);
  1749.   if FNextTrack.Visible then
  1750.     with FNextTrack do
  1751.        ExcludeClipRect(FRegionDC, Left, Top, Left+Width, Top+Height);
  1752.  
  1753.   GetClipRgn(FRegionDC, Rgn);
  1754.  
  1755. end;
  1756.  
  1757. function TDCCustomOutBarPanel.GetPopupMenu: TPopupMenu;
  1758. begin
  1759.   if (ActiveButton <> nil) and Assigned(FOnGetItemPopup) then
  1760.     FOnGetItemPopup(Self, ActiveButton, Result)
  1761.   else
  1762.     Result := inherited GetPopupMenu;
  1763. end;
  1764.  
  1765. procedure TDCCustomOutBarPanel.HideTrack(Track: TDCEditButton);
  1766. begin
  1767.   Track.Visible := False;
  1768.   if FTimer then KillTimer(Handle, PNLTIMER_IDEVENT);
  1769. end;
  1770.  
  1771. procedure TDCCustomOutBarPanel.ItemClick(Sender: TObject);
  1772.  var
  1773.   i: integer;
  1774. begin
  1775.   if (opDropDown in FOptions) and (ActiveButton<>nil) then
  1776.   with Items do
  1777.   begin
  1778.     for i := 0 to Count-1 do
  1779.       if (Buttons[i].ButtonState <> btRest) and
  1780.          (Buttons[i].Grouped)and(Buttons[i].Index <> ActiveButton.Index) then
  1781.       begin
  1782.         Buttons[i].ButtonState := btRest;
  1783.         Buttons[i].Invalidate;
  1784.       end;
  1785.   end;
  1786.   if Assigned(FOnItemClick) then FOnItemClick(Sender);
  1787. end;
  1788.  
  1789. procedure TDCCustomOutBarPanel.Loaded;
  1790.  var
  1791.   i: integer;
  1792.   ATransparent: boolean;
  1793. begin
  1794.   inherited;
  1795.   ATransparent := not BrushImage.Empty;
  1796.   for i:= 0 to Items.Count-1 do
  1797.   begin
  1798.     Items.Buttons[i].OnClick    := ItemClick;
  1799.     Items.Buttons[i].OnCheckArea:= CheckArea;
  1800.     Items.Buttons[i].OnSetButtonState := SetButtonState;
  1801.     Items.Buttons[i].OnDrawHint := DrawButtonHint;
  1802.     Items.Buttons[i].DownClick  := True;
  1803.     Items.Buttons[i].Font := Font;
  1804.     Items.Buttons[i].Highlight := False;
  1805.     Items.Buttons[i].Transparent := ATransparent;
  1806.   end;
  1807. end;
  1808.  
  1809. procedure TDCCustomOutBarPanel.Paint;
  1810. begin
  1811.   with Canvas do
  1812.   begin
  1813.     Brush.Color := ColorToRGB(Color);
  1814.     Brush.Style := bsSolid;
  1815.  
  1816.     if not(csDesigning in ComponentState) then
  1817.       FButtons.UpdateDeviceRegion(Handle);
  1818.  
  1819.     if FPrevTrack.Visible then
  1820.       with FPrevTrack do
  1821.          ExcludeClipRect(Handle, Left, Top, Left+Width, Top+Height);
  1822.     if FNextTrack.Visible then
  1823.       with FNextTrack do
  1824.          ExcludeClipRect(Handle, Left, Top, Left+Width, Top+Height);
  1825.  
  1826.     if not BrushImage.Empty then
  1827.       BrushImage.Draw(canvas, ClientRect)
  1828.     else
  1829.       FillRect(ClientRect);
  1830.  
  1831.     if csDesigning in ComponentState then
  1832.     begin
  1833.       Canvas.Pen.Color   := clNavy;
  1834.       Canvas.Pen.Style   := psDot;
  1835.       Canvas.PolyLine([Point(0, 0), Point(0,ClientHeight-1),
  1836.                        Point(ClientWidth-1,ClientHeight-1),
  1837.                        Point(ClientWidth-1, 0), Point(0,0)]);
  1838.     end;
  1839.   end;
  1840.   PaintTracks;
  1841. end;
  1842.  
  1843. procedure TDCCustomOutBarPanel.PaintTracks;
  1844. begin
  1845.   if FPrevTrack.Visible then FPrevTrack.Paint;
  1846.   if FNextTrack.Visible then FNextTrack.Paint;
  1847. end;
  1848.  
  1849. procedure TDCCustomOutBarPanel.SelectItem(Button: TDCEditButton);
  1850.   procedure ClearButtonsState;
  1851.    var
  1852.     AButton: TDCEditButton;
  1853.     P: TPoint;
  1854.     i: integer;
  1855.   begin
  1856.     if (opDropDown in FOptions) then
  1857.       for i:= 0 to FButtons.Count -1 do
  1858.       begin
  1859.         AButton :=  FButtons.Buttons[i];
  1860.         if AButton.ButtonState = btDownMouseInRect then
  1861.         begin
  1862.           GetCursorPos(P);
  1863.           P := ScreenToClient(P);
  1864.           FClear := True;
  1865.           if AButton.MouseInRect(P.X, P.Y) then
  1866.             AButton.ButtonState := btRestMouseInRect
  1867.           else
  1868.             AButton.ButtonState := btRest;
  1869.           AButton.Invalidate;
  1870.           FClear := False;
  1871.           Break;
  1872.         end;
  1873.       end;
  1874.   end;
  1875. begin
  1876.   if Assigned(Button) then
  1877.   begin
  1878.     ClearButtonsState;
  1879.     if (opDropDown in FOptions) then
  1880.     begin
  1881.       Button.ButtonState := btDownMouseInRect;
  1882.       if Button.DownClick then Button.DownButton := True;
  1883.       Button.Invalidate;
  1884.     end;
  1885.     Button.Click;
  1886.   end
  1887.   else
  1888.     ClearButtonsState;
  1889. end;
  1890.  
  1891. procedure TDCCustomOutBarPanel.SetButtonPos(Index: integer);
  1892.  var
  1893.   TextSize, Pos: TPoint;
  1894.   Button: TDCEditButton;
  1895.   AHeight: integer;
  1896. begin
  1897.   Button := Buttons.Buttons[Index];
  1898.   Pos.X  := 2;
  1899.  
  1900.   Button.Text := FormatText(Button.Text, Pos.X, TextSize);
  1901.  
  1902.   case FStyle of
  1903.    isLargeImages:
  1904.      AHeight := Button.GetGlyphHeight + TextSize.Y + 6;
  1905.    isSmallImages:
  1906.      AHeight := _intMax(TextSize.Y, Button.GetGlyphHeight) + 4
  1907.    else
  1908.       AHeight := 0;
  1909.   end;
  1910.  
  1911.   Pos.Y := 1;
  1912.   if (opItemMove in FOptions) then Inc(Pos.Y);
  1913.   if (opDropDown in FOptions) then Inc(AHeight, 4);
  1914.  
  1915.   Button.Left  := Pos.X;
  1916.   Button.Height:= AHeight;
  1917.   Button.Width := Width - Pos.X*2;
  1918.   if Index < FFirstIndex then
  1919.   begin
  1920.     Button.Top     := 0;
  1921.     Button.Height  := 0;
  1922.     if not FPrevTrack.Visible then FPrevTrack.Visible := True;
  1923.   end
  1924.   else begin
  1925.     Button.Top     := Pos.Y;
  1926.     if (Index > 0) then
  1927.       with Buttons.Buttons[Index-1] do Button.Top := Button.Top+(Top+Height);
  1928.   end;
  1929. end;
  1930.  
  1931. procedure TDCCustomOutBarPanel.SetButtonState(Sender: TObject;
  1932.   var State: TButtonState);
  1933. begin
  1934.   if not FClear and (opDropDown in FOptions) and (ActiveButton <> nil) and
  1935.     (ActiveButton.Name = TDCEditButton(Sender).Name) and
  1936.     (ActiveButton.ButtonState = btDownMouseInRect) then
  1937.    State := btDownMouseInRect;
  1938. end;
  1939.  
  1940. procedure TDCCustomOutBarPanel.SetDropDown(const Value: boolean);
  1941.  var
  1942.   i: integer;
  1943. begin
  1944.   for i := 0 to FButtons.Count-1 do
  1945.   begin
  1946.     if Value then
  1947.       FButtons.Items[i].EventStyle := esDropDown
  1948.     else
  1949.       FButtons.Items[i].EventStyle := esNormal;
  1950.   end;
  1951. end;
  1952.  
  1953. procedure TDCCustomOutBarPanel.SetFirstIndex(const Value: integer);
  1954.  var
  1955.   AOffset: integer;
  1956. begin
  1957.   if FFirstIndex <> Value then
  1958.   begin
  1959.     AOffset := (Value - FFirstIndex) div abs(Value - FFirstIndex);
  1960.     while FFirstIndex <> Value do
  1961.     begin
  1962.       if AOffset > 0 then
  1963.          ButtonsUp(Self)
  1964.       else
  1965.          ButtonsDown(Self);
  1966.     end;
  1967.   end;
  1968. end;
  1969.  
  1970. procedure TDCCustomOutBarPanel.SetLargeImages(const Value: TImageList);
  1971. begin
  1972.   if FLargeImages <> nil then FLargeImages.UnRegisterChanges(FImageChangeLink);
  1973.   FLargeImages := Value;
  1974.   if FLargeImages <> nil then
  1975.   begin
  1976.     FLargeImages.RegisterChanges(FImageChangeLink);
  1977.     FLargeImages.FreeNotification(Self);
  1978.   end;
  1979.   if FStyle = isLargeImages then Buttons.Images := Value;
  1980.   UpdateButtonsPos;
  1981.   UpdateTracksPos;
  1982. end;
  1983.  
  1984. procedure TDCCustomOutBarPanel.SetOptions(const Value: TOutPanelOptions);
  1985. begin
  1986.   FOptions := Value;
  1987.   SetDropDown(opDropDown in Value);
  1988.   UpdateButtonsPos;
  1989.   UpdateTracksPos;
  1990. end;
  1991.  
  1992. procedure TDCCustomOutBarPanel.SetSmallImages(const Value: TImageList);
  1993. begin
  1994.   if FSmallImages <> nil then FSmallImages.UnRegisterChanges(FImageChangeLink);
  1995.   FSmallImages := Value;
  1996.   if FSmallImages <> nil then
  1997.   begin
  1998.     FSmallImages.RegisterChanges(FImageChangeLink);
  1999.     FSmallImages.FreeNotification(Self);
  2000.   end;
  2001.   if FStyle = isSmallImages then Buttons.Images := Value;
  2002.   UpdateButtonsPos;
  2003.   UpdateTracksPos;
  2004. end;
  2005.  
  2006. procedure TDCCustomOutBarPanel.SetStyle(const Value: TImagesStyle);
  2007.  var
  2008.   i: integer;
  2009.   Button: TDCEditButton;
  2010. begin
  2011.   FStyle := Value;
  2012.   case FStyle of
  2013.     isSmallImages:
  2014.       begin
  2015.         Buttons.Images := FSmallImages;
  2016.         Buttons.PaintOnSizing := True;
  2017.         if FSmallImages <> nil then
  2018.         begin
  2019.           FSmallImages.UnRegisterChanges(FImageChangeLink);
  2020.           FSmallImages.RegisterChanges(FImageChangeLink);
  2021.         end;
  2022.       end;
  2023.     isLargeImages:
  2024.       begin
  2025.         Buttons.Images := FLargeImages;
  2026.         Buttons.PaintOnSizing := False;
  2027.         if FLargeImages <> nil then
  2028.         begin
  2029.           FLargeImages.UnRegisterChanges(FImageChangeLink);
  2030.           FLargeImages.RegisterChanges(FImageChangeLink);
  2031.         end;
  2032.       end;
  2033.   end;
  2034.   for i := 0 to FButtons.Count-1 do
  2035.   begin
  2036.     Button := Buttons.Buttons[i];
  2037.     with Button do
  2038.       case FStyle of
  2039.         isSmallImages: Allignment := abLeft;
  2040.         isLargeImages: Allignment := abImageTop;
  2041.       end;
  2042.   end;
  2043.   UpdateButtonsPos;
  2044. end;
  2045.  
  2046. function TDCCustomOutBarPanel.TracksCovering: boolean;
  2047. begin
  2048.   if FPrevTrack.Visible and
  2049.     (FNextTrack.Top < (FPrevTrack.Top+FPrevTrack.Height)) then
  2050.     Result := True
  2051.   else
  2052.     Result := False;
  2053. end;
  2054.  
  2055. procedure TDCCustomOutBarPanel.UpdateButtonsPos;
  2056.  var
  2057.   i: integer;
  2058.   Button: TDCEditButton;
  2059. begin
  2060.   if not HandleAllocated then Exit;
  2061.   if (FFirstIndex = 0) and FPrevTrack.Visible then HideTrack(FPrevTrack);
  2062.   if not FCanvasLocked then Invalidate;
  2063.   with Buttons do
  2064.     if Count > 0 then
  2065.     begin
  2066.       for i := 0 to Count-1 do
  2067.       begin
  2068.         Button := Buttons[i];
  2069.         SetButtonPos(Button.Index);
  2070.       end;
  2071.       CheckToNextTrack;
  2072.     end
  2073.     else
  2074.       if FNextTrack.Visible then HideTrack(FNextTrack);
  2075. end;
  2076.  
  2077. procedure TDCCustomOutBarPanel.UpdateTracksPos;
  2078.  var
  2079.   lVisible: boolean;
  2080. begin
  2081.   lVisible := False;
  2082.   with FPrevTrack do
  2083.   begin
  2084.     if Visible then
  2085.     begin
  2086.       Visible := False; lVisible := True;
  2087.     end;
  2088.     Left :=  ClientRect.Right-Width-1;
  2089.     Top  :=  ClientRect.Top+1;
  2090.     if lVisible then
  2091.     begin
  2092.       Visible := True; lVisible := False;
  2093.     end;
  2094.   end;
  2095.  
  2096.   with FNextTrack do
  2097.   begin
  2098.     if Visible then
  2099.     begin
  2100.       Visible := False; lVisible := True;
  2101.     end;
  2102.     Left :=  ClientRect.Right-Width-1;
  2103.     Top  :=  ClientRect.Bottom-Height-1;
  2104.     if lVisible and not TracksCovering then Visible := True;
  2105.   end;
  2106. end;
  2107.  
  2108. procedure TDCCustomOutBarPanel.UpdateTracksState(X, Y: integer;
  2109.   lMove: boolean);
  2110. begin
  2111.   FPrevTrack.UpdateButtonState(X, Y, FMouseDown, lMove);
  2112.   FNextTrack.UpdateButtonState(X, Y, FMouseDown, lMove);
  2113. end;
  2114.  
  2115. procedure TDCCustomOutBarPanel.WMKillFocus(var Message: TWMKillFocus);
  2116. begin
  2117.   FButtons.ResetProperties;
  2118.   inherited;
  2119. end;
  2120.  
  2121. procedure TDCCustomOutBarPanel.WMLButtonDblClk(var Message: TWMLButtonDown);
  2122. begin
  2123.   inherited;
  2124.   FMouseDown := True;
  2125.   UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  2126.  
  2127.   if (FPrevTrack.ButtonState  = btDownMouseInRect) or
  2128.      (FNextTrack.ButtonState  = btDownMouseInRect) then
  2129.    SetTimer(Handle, PNLTIMER_IDEVENT, 200, nil);
  2130. end;
  2131.  
  2132. procedure TDCCustomOutBarPanel.WMLButtonDown(var Message: TWMLButtonDown);
  2133. begin
  2134.   inherited;
  2135.   FMouseDown := True;
  2136.   UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  2137.  
  2138.   if (FPrevTrack.ButtonState  = btDownMouseInRect) or
  2139.      (FNextTrack.ButtonState  = btDownMouseInRect) then
  2140.    SetTimer(Handle, PNLTIMER_IDEVENT, 200, nil);
  2141. end;
  2142.  
  2143. procedure TDCCustomOutBarPanel.WMLButtonUp(var Message: TWMLButtonUp);
  2144. begin
  2145.   inherited;
  2146.   FMouseDown := False;
  2147.   UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  2148.  
  2149.   KillTimer(Handle, PNLTIMER_IDEVENT);
  2150.   FTimer := False;
  2151. end;
  2152.  
  2153. procedure TDCCustomOutBarPanel.WMMouseMove(var Message: TWMMouseMove);
  2154. begin
  2155.   inherited;
  2156.   UpdateTracksState(Message.Pos.X, Message.Pos.Y, True);
  2157. end;
  2158.  
  2159. procedure TDCCustomOutBarPanel.WMSize(var Message: TWMSize);
  2160. begin
  2161.   inherited;
  2162.   if not FRemoving then
  2163.   begin
  2164.     if Style = isLargeImages then UpdateButtonsPos;
  2165.     CheckToNextTrack;
  2166.     if not FNextTrack.Visible then CheckToPrevTrack;
  2167.     UpdateTracksPos;
  2168.   end;
  2169. end;
  2170.  
  2171. procedure TDCCustomOutBarPanel.WMTimer(var Message: TWMTimer);
  2172. begin
  2173.   FTimer := True;
  2174.   if FNextTrack.ButtonState = btDownMouseInRect then ButtonsUp(Self);
  2175.   if FPrevTrack.ButtonState = btDownMouseInRect then ButtonsDown(Self);
  2176. end;
  2177.  
  2178. procedure TDCCustomOutBarPanel.SetActiveButton(Value: TDCEditButton);
  2179. begin
  2180.   SelectItem(Value);
  2181. end;
  2182.  
  2183. function TDCCustomOutBarPanel.ButtonVisible(Button: TDCEditButton): boolean;
  2184. begin
  2185.   with Button do Result := (Top + Height) <= Self.Height;
  2186. end;
  2187.  
  2188. procedure TDCCustomOutBarPanel.ImageListChange(Sender: TObject);
  2189. begin
  2190.   Invalidate;
  2191.   if not FRemoving then
  2192.   begin
  2193.     UpdateButtonsPos;
  2194.     CheckToNextTrack;
  2195.     if not FNextTrack.Visible then CheckToPrevTrack;
  2196.     UpdateTracksPos;
  2197.   end;
  2198. end;
  2199.  
  2200. procedure TDCCustomOutBarPanel.Notification(AComponent: TComponent;
  2201.   Operation: TOperation);
  2202. begin
  2203.   inherited Notification(AComponent, Operation);
  2204.   if (Operation = opRemove) then
  2205.   begin
  2206.     if (AComponent = FLargeImages) then
  2207.     begin
  2208.       FLargeImages := nil;
  2209.       Invalidate;
  2210.       Exit;
  2211.     end;
  2212.     if (AComponent = FSmallImages) then
  2213.     begin
  2214.       FSmallImages := nil;
  2215.       Invalidate;
  2216.       Exit;
  2217.     end;
  2218.   end;
  2219. end;
  2220.  
  2221. procedure TDCCustomOutBarPanel.CMHintShow(var Message: TCMHintShow);
  2222. begin
  2223.   if FHintObject <> nil then
  2224.   begin
  2225.     with Message, TDCEditButton(FHintObject) do
  2226.     begin
  2227.       HintInfo.HintStr := GetShortHint(Hint);
  2228.       HintInfo.ReshowTimeout := $7FFFFFFF;
  2229.       Result := 0;
  2230.     end;
  2231.   end
  2232.   else
  2233.    inherited;
  2234. end;
  2235.  
  2236. function TDCCustomOutBarPanel.DoMouseWheelDown(Shift: TShiftState;
  2237.   MousePos: TPoint): Boolean;
  2238. begin
  2239.   Result := inherited DoMouseWheelDown(Shift, MousePos);
  2240. end;
  2241.  
  2242. function TDCCustomOutBarPanel.GetItemIndex: integer;
  2243.  var
  2244.   i: integer;
  2245. begin
  2246.   Result := -1;
  2247.   if ActiveButton <> nil then
  2248.   begin
  2249.     for i := 0 to FButtons.Count - 1 do
  2250.       if FButtons.Buttons[i] = ActiveButton then
  2251.       begin
  2252.         Result := i;
  2253.         Break;
  2254.       end;
  2255.   end;
  2256. end;
  2257.  
  2258. procedure TDCCustomOutBarPanel.SetItemIndex(const Value: integer);
  2259. begin
  2260.   if (Value < FButtons.Count) and (Value >= 0) then
  2261.     SelectItem(FButtons.Buttons[Value]);
  2262. end;
  2263.  
  2264. procedure TDCCustomOutBarPanel.DoBrushChanged;
  2265.  var
  2266.   i: integer;
  2267.   ATransparent: boolean;
  2268. begin
  2269.   ATransparent := not BrushImage.Empty;
  2270.   for i:= 0 to Items.Count-1 do
  2271.   begin
  2272.     Items.Buttons[i].Transparent := ATransparent;
  2273.   end;
  2274. end;
  2275.  
  2276. { TDCCustomPage }
  2277.  
  2278. procedure TDCCustomPage.ChangeBrush(Sender: TObject);
  2279. begin
  2280.   DoBrushChanged;
  2281.   invalidate;
  2282. end;
  2283.  
  2284. procedure TDCCustomPage.CMEnabledChanged(var Message: TMessage);
  2285. begin
  2286.   if PageControl <> nil then
  2287.   begin
  2288.     if (FPageControl.ActivePage = Self) and not Enabled and not (csDesigning in ComponentState)then
  2289.       FPageControl.SelectNextPage(False);
  2290.     FPageControl.UpdatePage(Self);
  2291.   end;
  2292.   inherited;
  2293. end;
  2294.  
  2295. procedure TDCCustomPage.CMFontChanged(var Message: TMessage);
  2296. begin
  2297.   inherited;
  2298.   if Assigned(FPageControl) and FPageVisible then FPageControl.UpdatePage(Self);
  2299. end;
  2300.  
  2301. procedure TDCCustomPage.CMShowingChanged(var Message: TMessage);
  2302. begin
  2303.   inherited;
  2304.   if Showing then
  2305.     DoShow
  2306.   else
  2307.     DoHide;
  2308. end;
  2309.  
  2310. procedure TDCCustomPage.CMTextChanged(var Message: TMessage);
  2311. begin
  2312.   inherited;
  2313.   if Assigned(FPageControl) and FPageVisible then FPageControl.UpdatePage(Self);
  2314. end;
  2315.  
  2316. constructor TDCCustomPage.Create(AOwner: TComponent);
  2317. begin
  2318.   inherited Create(AOwner);
  2319.   ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks, csAcceptsControls];
  2320.   FPageVisible := True;
  2321.   FFullVisible := True;
  2322.   FRemoving    := False;
  2323.   FImageIndex  := -1;
  2324.  
  2325.   Align := alClient;
  2326.   BorderWidth:= 2;
  2327.   FBrushImage := TDCBrushImage.Create(Self);
  2328.   FBrushImage.OnChange := ChangeBrush;
  2329. end;
  2330.  
  2331. procedure TDCCustomPage.CreateParams(var Params: TCreateParams);
  2332. begin
  2333.   inherited CreateParams(Params);
  2334.   if not(csDesigning in ComponentState) then
  2335.     with Params.WindowClass do
  2336.       Style := Style and not (CS_HREDRAW or CS_VREDRAW)
  2337. end;
  2338.  
  2339. destructor TDCCustomPage.Destroy;
  2340. begin
  2341.   if FPageControl <> nil then  FPageControl.RemovePage(Self);
  2342.   FBrushImage.Free;
  2343.   inherited Destroy;
  2344. end;
  2345.  
  2346. procedure TDCCustomPage.DoBrushChanged;
  2347. begin
  2348.   {}
  2349. end;
  2350.  
  2351. procedure TDCCustomPage.DoHide;
  2352. begin
  2353.   if Assigned(FOnHide) then FOnHide(Self);
  2354. end;
  2355.  
  2356. procedure TDCCustomPage.DoShow;
  2357. begin
  2358.   if Assigned(FOnShow) then FOnShow(Self);
  2359. end;
  2360.  
  2361. function TDCCustomPage.GetPageIndex: Integer;
  2362. begin
  2363.   if FPageControl <> nil then
  2364.     Result := FPageControl.FPages.IndexOf(Self)
  2365.   else
  2366.     Result := -1;
  2367. end;
  2368.  
  2369. function TDCCustomPage.IsPageVisible: boolean;
  2370. begin
  2371.   Result := FPageVisible;
  2372.   if FPageControl <> nil then Result := Result or (csDesigning in FPageControl.ComponentState);
  2373. end;
  2374.  
  2375. procedure TDCCustomPage.Notification(AComponent: TComponent;
  2376.   Operation: TOperation);
  2377. begin
  2378.   inherited Notification(AComponent, Operation);
  2379.   if (Operation = opRemove) then
  2380.   begin
  2381.     if (AComponent = BrushImage.Images) then
  2382.     begin
  2383.       BrushImage.Images := nil;
  2384.       Exit;
  2385.     end;
  2386.   end;
  2387. end;
  2388.  
  2389. procedure TDCCustomPage.Paint;
  2390.  var
  2391.   R: TRect;
  2392. begin
  2393.   with Canvas do
  2394.   begin
  2395.     R := ClientRect;
  2396.     Canvas.Brush.Color := Self.Color;
  2397.     if csDesigning in ComponentState then
  2398.     begin
  2399.       Canvas.Pen.Color   := clNavy;
  2400.       Canvas.Pen.Style   := psDot;
  2401.       Canvas.PolyLine([Point(0, 0), Point(0, ClientHeight - 1),
  2402.                        Point(ClientWidth - 1, ClientHeight - 1),
  2403.                        Point(ClientWidth - 1, 0), Point(0, 0)]);
  2404.       InflateRect(R, -1, -1);
  2405.     end;
  2406.     if not BrushImage.Empty then
  2407.       BrushImage.Draw(Canvas, R)
  2408.     else begin
  2409.       if not PageControl.BrushImage.Empty then
  2410.         PageControl.BrushImage.Draw(Canvas, R)
  2411.       else
  2412.         FillRect(R);
  2413.     end;
  2414.   end;
  2415. end;
  2416.  
  2417. procedure TDCCustomPage.ReadState(Reader: TReader);
  2418. begin
  2419.   inherited ReadState(Reader);
  2420.   if Reader.Parent is TDCCustomPageControl then
  2421.     PageControl := TDCCustomPageControl(Reader.Parent);
  2422. end;
  2423.  
  2424. procedure TDCCustomPage.SetBounds(ALeft, ATop, AWidth, AHeight: Integer);
  2425. begin
  2426.   inherited;
  2427.   if csDesigning in ComponentState then invalidate;
  2428. end;
  2429.  
  2430. procedure TDCCustomPage.SetBrushImage(const Value: TDCBrushImage);
  2431. begin
  2432.   FBrushImage.Assign(Value);
  2433. end;
  2434.  
  2435. procedure TDCCustomPage.SetImageIndex(const Value: integer);
  2436. begin
  2437.   if ImageIndex <> Value then
  2438.   begin
  2439.     FImageIndex := Value;
  2440.     if FPageControl <> nil then
  2441.     begin
  2442.       FPageControl.TabsChanged;
  2443.       FPageControl.Invalidate;
  2444.     end;
  2445.   end;
  2446. end;
  2447.  
  2448. procedure TDCCustomPage.SetPageControl(const Value: TDCCustomPageControl);
  2449. begin
  2450.   if FPageControl <> Value then
  2451.   begin
  2452.     if FPageControl <> nil then FPageControl.RemovePage(Self);
  2453.     Parent := Value;
  2454.     if Value <> nil then Value.InsertPage(Self);
  2455.   end;
  2456. end;
  2457.  
  2458. procedure TDCCustomPage.SetPageIndex(const Value: Integer);
  2459.  var
  2460.   MaxPageIndex: Integer;
  2461. begin
  2462.   if FPageControl <> nil then
  2463.   begin
  2464.     MaxPageIndex := FPageControl.FPages.Count - 1;
  2465.     if Value > MaxPageIndex then
  2466.       raise EListError.CreateFmt(SPageIndexError, [Value, MaxPageIndex]);
  2467.     FPageControl.FPages.Move(PageIndex, Value);
  2468.     TabOrder := PageIndex;
  2469.     with FPageControl do
  2470.     begin
  2471.       TabsChanged;
  2472.       Invalidate;
  2473.     end;
  2474.   end;
  2475. end;
  2476.  
  2477. procedure TDCCustomPage.SetPageVisible(const Value: boolean);
  2478. begin
  2479.   if FPageVisible <> Value then
  2480.   begin
  2481.     FPageVisible := Value;
  2482.     if FPageControl <> nil then
  2483.       FPageControl.SetPageVisible(PageIndex, Value);
  2484.   end;
  2485. end;
  2486.  
  2487. procedure TDCCustomPage.UpdatePageShowing;
  2488. begin
  2489.   SetPageVisible((FPageControl <> nil) and PageVisible);
  2490. end;
  2491.  
  2492. procedure TDCCustomPage.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  2493. begin
  2494.   Message.Result := 0;
  2495. end;
  2496.  
  2497. procedure TDCCustomPage.WMGetDlgCode(var Message: TWMGetDlgCode);
  2498. begin
  2499.   Message.Result := DLGC_WANTARROWS + DLGC_WANTCHARS;
  2500. end;
  2501.  
  2502. { TDCCustomPageControl }
  2503.  
  2504. procedure TDCCustomPageControl.AdjustClientRect(var Rect: TRect);
  2505. begin
  2506.   inherited;
  2507.   if FTabVisible then
  2508.     Rect := GetCurrentPageRect
  2509.   else
  2510.   begin
  2511.     Rect := ClientRect;
  2512.     InflateRect(Rect, -2, -2);
  2513.   end;
  2514. end;
  2515.  
  2516. function TDCCustomPageControl.CanChange(Page: TDCCustomPage): Boolean;
  2517. begin
  2518.   Result := Page.Enabled or ([csLoading, csDesigning]*ComponentState <> []);
  2519.   if Assigned(FOnChanging) and (ComponentState = []) and (ActivePage <> nil) then
  2520.     FOnChanging(Self, Result);
  2521. end;
  2522.  
  2523. function TDCCustomPageControl.CanShowPage(PageIndex: Integer): Boolean;
  2524.  var
  2525.   Page: TDCCustomPage;
  2526. begin
  2527.   Page   := FPages[PageIndex];
  2528.   Result := (csDesigning in ComponentState) or
  2529.             (Page <> nil) and Page.PageVisible;
  2530. end;
  2531.  
  2532. procedure TDCCustomPageControl.Change;
  2533. begin
  2534.   if Assigned(FOnChange) then FOnChange(Self);
  2535. end;
  2536.  
  2537. procedure TDCCustomPageControl.ChangeActivePage(Page: TDCCustomPage);
  2538. var
  2539.   ParentForm: TCustomForm;
  2540.   ActivePage: TDCCustomPage;
  2541. begin
  2542.   if (FActivePage <> Page) and ((Page = nil) or CanChange(Page)) then
  2543.   begin
  2544.     ParentForm := GetParentForm(Self);
  2545.     if (ParentForm <> nil) and (FActivePage <> nil) and
  2546.       FActivePage.ContainsControl(ParentForm.ActiveControl) then
  2547.     begin
  2548.       ParentForm.ActiveControl := FActivePage;
  2549.       if ParentForm.ActiveControl <> FActivePage then
  2550.         Exit;
  2551.     end;
  2552.  
  2553.     ActivePage := FActivePage;
  2554.  
  2555.     if Page <> nil then
  2556.     begin
  2557.       Page.BringToFront;
  2558.       Page.Visible := True;
  2559.       if (ParentForm <> nil) and (FActivePage <> nil) and
  2560.         (ParentForm.ActiveControl = FActivePage) then
  2561.         if Page.CanFocus then
  2562.           ParentForm.ActiveControl := Page else
  2563.           ParentForm.ActiveControl := Self;
  2564.  
  2565.       FActivePage := Page;
  2566.       Realign;
  2567.     end
  2568.     else
  2569.       FActivePage := Page;
  2570.     if ActivePage <> nil then ActivePage.Visible := False;
  2571.  
  2572.     if (ParentForm <> nil) and (FActivePage <> nil) and
  2573.       (ParentForm.ActiveControl = FActivePage) then
  2574.       FActivePage.SelectFirst;
  2575.  
  2576.     TabsChanged;
  2577.     if ComponentState = [] then Change;
  2578.  
  2579.   end;
  2580. end;
  2581.  
  2582. procedure TDCCustomPageControl.CMDialogChar(var Message: TCMDialogChar);
  2583.  var
  2584.   i: Integer;
  2585. begin
  2586.   for i := 0 to FPages.Count - 1 do
  2587.     if IsAccel(Message.CharCode, TDCCustomPage(FPages[I]).Caption) and
  2588.        CanShowPage(i) and CanFocus
  2589.     then begin
  2590.       Message.Result := 1;
  2591.       if CanChange(FPages[I]) then PageIndex := i;
  2592.       Exit;
  2593.     end;
  2594.   inherited;
  2595. end;
  2596.  
  2597. constructor TDCCustomPageControl.Create(AOwner: TComponent);
  2598. begin
  2599.   inherited;
  2600.   ControlStyle := [csCaptureMouse, csClickEvents, csOpaque, csDoubleClicks];
  2601.   FBrushImage := TDCBrushImage.Create(Self);
  2602.   FBrushImage.OnChange := ChangeBrush;
  2603.   FPages := TPageList.Create(Self);
  2604.  
  2605.   Self.Align  := alNone;
  2606.   FTabVisible := True;
  2607.  
  2608.   Width  := 200;
  2609.   Height := 100;
  2610.   FImageChangeLink :=  TChangeLink.Create;
  2611.   FImageChangeLink.OnChange := ImageListChange;
  2612.  
  2613.   FFirstIndex   := 0;
  2614.   FSelectedPage := nil;
  2615.   FBitmap := TBitmap.Create;
  2616.   FBuffered := True;
  2617. end;
  2618.  
  2619. destructor TDCCustomPageControl.Destroy;
  2620.  var
  2621.   i: integer;
  2622. begin
  2623.   FBitmap.Free;
  2624.   FBrushImage.Free;
  2625.   for i := 0 to FPages.Count - 1 do TDCCustomPage(FPages[I]).FPageControl := nil;
  2626.   FPages.Free;
  2627.   FImageChangeLink.Free;
  2628.   inherited;
  2629. end;
  2630.  
  2631. function TDCCustomPageControl.FindNextPage(APage: TDCCustomPage;
  2632.   GoForward, CheckTabVisible: Boolean): TDCCustomPage;
  2633.  var
  2634.   i, StartIndex: Integer;
  2635. begin
  2636.   if FPages.Count <> 0 then
  2637.   begin
  2638.     StartIndex := FPages.IndexOf(APage);
  2639.     if StartIndex = -1 then
  2640.       if GoForward then StartIndex := FPages.Count - 1 else StartIndex := 0;
  2641.     i := StartIndex;
  2642.     repeat
  2643.       if GoForward then
  2644.       begin
  2645.         Inc(I);
  2646.         if i = FPages.Count then i := 0;
  2647.       end else
  2648.       begin
  2649.         if i = 0 then i := FPages.Count;
  2650.         Dec(i);
  2651.       end;
  2652.       Result := FPages[I];
  2653.       if not CheckTabVisible or Result.IsPageVisible and CanChange(Result) then Exit;
  2654.     until i = StartIndex;
  2655.   end;
  2656.   Result := nil;
  2657. end;
  2658.  
  2659. function TDCCustomPageControl.GetPage(Index: Integer): TDCCustomPage;
  2660. begin
  2661.   Result := FPages[Index];
  2662. end;
  2663.  
  2664. function TDCCustomPageControl.GetTabRect(AIndex: integer; Page: TDCCustomPage;
  2665.   var ARect: TRect): TRect;
  2666. begin
  2667.   {}
  2668. end;
  2669.  
  2670. function TDCCustomPageControl.GetPageCount: Integer;
  2671. begin
  2672.   Result := FPages.Count;
  2673. end;
  2674.  
  2675. function TDCCustomPageControl.GetPageIndex: integer;
  2676. begin
  2677.   if ActivePage <> nil then
  2678.     Result := ActivePage.PageIndex
  2679.   else
  2680.     Result := -1;
  2681. end;
  2682.  
  2683. procedure TDCCustomPageControl.InsertPage(Page: TDCCustomPage);
  2684. begin
  2685.   Page.FPageControl := Self;
  2686.   FPages.Add(Page);
  2687.   if Page.PageVisible then
  2688.   begin
  2689.     FPages.AddVisible(Page.PageIndex);
  2690.     Page.UpdatePageShowing;
  2691.     SetActivePage(Page);
  2692.   end
  2693. end;
  2694.  
  2695. procedure TDCCustomPageControl.Paint;
  2696.  var
  2697.   ARect: TRect;
  2698. begin
  2699.   if FBuffered then
  2700.   begin
  2701.     ARect := TabsRect;
  2702.     if not IsRectEmpty(ARect) then
  2703.     begin
  2704.       FBitmap.Width  := ARect.Right  - ARect.Left;
  2705.       FBitmap.Height := ARect.Bottom - ARect.Top;
  2706.       DrawTabsArea(FBitmap.Canvas);
  2707.       Canvas.Draw(ARect.Left, ARect.Top, FBitmap);
  2708.     end;
  2709.     DrawBorder(Canvas);
  2710.   end
  2711.   else begin
  2712.     if (FPages.VisibleCount > 0) or (csDesigning in ComponentState) then
  2713.       DrawTabsArea(Canvas);
  2714.     DrawBorder(Canvas);
  2715.   end;
  2716. end;
  2717.  
  2718. procedure TDCCustomPageControl.RemovePage(Page: TDCCustomPage);
  2719. var
  2720.   NextPage: TDCCustomPage;
  2721. begin
  2722.   NextPage := FindNextPage(Page, True, not (csDesigning in ComponentState));
  2723.   if NextPage = Page then NextPage := nil;
  2724.  
  2725.   Page.FRemoving := True;
  2726.   Page.SetPageVisible(False);
  2727.   Page.FPageControl := nil;
  2728.   FPages.Remove(Page);
  2729.   FPages.UpdateVisible;
  2730.   SetActivePage(NextPage);
  2731.   UpdateTabsRect;
  2732.   Invalidate;
  2733. end;
  2734.  
  2735. function TDCCustomPageControl.SelectNextPage(GoForward: Boolean): boolean;
  2736. var
  2737.   Page: TDCCustomPage;
  2738. begin
  2739.   Page := FindNextPage(ActivePage, GoForward, not(csDesigning in ComponentState));
  2740.   if (Page <> nil) and (Page <> ActivePage) and CanChange(Page) then ActivePage := Page;
  2741.   Result := Page <> nil;
  2742. end;
  2743.  
  2744. procedure TDCCustomPageControl.SetActivePage(const Value: TDCCustomPage);
  2745. begin
  2746.   if (Value <> nil) and (Value.PageControl <> Self) then Exit;
  2747.   ChangeActivePage(Value);
  2748. end;
  2749.  
  2750. procedure TDCCustomPageControl.SetPageIndex(const Value: integer);
  2751. begin
  2752.   ActivePage := FPages[Value];
  2753. end;
  2754.  
  2755. procedure TDCCustomPageControl.SetPageVisible(APageIndex: integer;
  2756.   AVisible: boolean);
  2757. begin
  2758.   FPages.SetVisible(TDCCustomPage(FPages.Items[APageIndex]), AVisible);
  2759.   UpdateTabSize;
  2760.   TabsChanged;
  2761. end;
  2762.  
  2763. procedure TDCCustomPageControl.UpdatePage(Page: TDCCustomPage);
  2764. begin
  2765.   TabsChanged;
  2766. end;
  2767.  
  2768. procedure TDCCustomPageControl.WMSize(var Message: TWMSize);
  2769. begin
  2770.   inherited;
  2771.   UpdateTabsRect;
  2772.   RepaintTabs;
  2773. end;
  2774.  
  2775. procedure TDCCustomPageControl.DrawTab(ACanvas: TCanvas; ARect: TRect;
  2776.   AIndex: integer; APage: TDCCustomPage; var ADefaultDraw: boolean; AExclude: boolean);
  2777.  var
  2778.   AActivePage: boolean;
  2779. begin
  2780.   ADefaultDraw := True;
  2781.   AActivePage  := ActivePage.PageIndex = APage.PageIndex;
  2782.   if Assigned(FOnDrawTab) then
  2783.     FOnDrawTab(Self, ACanvas, AIndex, ARect, AActivePage, ADefaultDraw);
  2784.  
  2785.   if ADefaultDraw then
  2786.   begin
  2787.     DoDrawTab(ACanvas, ARect, AIndex, APage, AActivePage);
  2788.   end;
  2789.   with ARect do
  2790.   begin
  2791.     if AExclude then
  2792.       ExcludeClipRect(ACanvas.Handle, Left, Top, Right, Bottom);
  2793.   end;
  2794.  
  2795. end;
  2796.  
  2797. procedure TDCCustomPageControl.DrawTabsArea(ACanvas: TCanvas);
  2798.  var
  2799.   i, VisibleIndex: integer;
  2800.   Page: TDCCustomPage;
  2801.   ARect: TRect;
  2802.   ADefaultDraw: boolean;
  2803. begin
  2804.   if FTabVisible then
  2805.   begin
  2806.     for i := 0 to FPages.Count - 1 do
  2807.     begin
  2808.       Page := FPages.Items[i];
  2809.       VisibleIndex := -1;
  2810.       SetRectEmpty(ARect);
  2811.       if ARect.Left < FTabsRect.Right then
  2812.       begin
  2813.         if (csDesigning in ComponentState) then
  2814.           VisibleIndex := i
  2815.         else
  2816.          if Page.IsPageVisible then VisibleIndex := FPages.VisibleIndexOf(Page.PageIndex);
  2817.       end;
  2818.       if (VisibleIndex <> -1) and (Page.FTabRect.Right > Page.FTabRect.Left) then
  2819.       begin
  2820.         ARect := Page.FTabRect;
  2821.         if FBuffered then OffsetRect(ARect, -FTabsRect.Left, -FTabsRect.Top);
  2822.         DrawTab(ACanvas, ARect, VisibleIndex, Page, ADefaultDraw, True);
  2823.       end
  2824.     end;
  2825.   end;
  2826. end;
  2827.  
  2828. function TDCCustomPageControl.GetCurrentPageRect: TRect;
  2829. begin
  2830.   Result := ClientRect;
  2831. end;
  2832.  
  2833. function TDCCustomPageControl.GetTabsRect: TRect;
  2834. begin
  2835.   {}
  2836. end;
  2837.  
  2838. procedure TDCCustomPageControl.ShowControl(AControl: TControl);
  2839. begin
  2840.   if (AControl is TDCCustomPage) and
  2841.      (TDCCustomPage(AControl).PageControl = Self) and (Self.ActivePage <> TDCCustomPage(AControl)) then
  2842.     SetActivePage(TDCCustomPage(AControl));
  2843.   inherited;
  2844. end;
  2845.  
  2846. procedure TDCCustomPageControl.DrawBorder(ACanvas: TCanvas);
  2847. begin
  2848.   {}
  2849. end;
  2850.  
  2851. procedure TDCCustomPageControl.DoDrawTab(ACanvas: TCanvas; ARect: TRect;
  2852.   AIndex: integer; APage: TDCCustomPage; AActivePage: boolean);
  2853. begin
  2854.   {}
  2855. end;
  2856.  
  2857. procedure TDCCustomPageControl.TabsChanged;
  2858. begin
  2859.   if HandleAllocated then UpdateTabsRect;
  2860.   RepaintTabs;
  2861. end;
  2862.  
  2863. function ComparePage(Item1, Item2: Pointer): integer;
  2864. begin
  2865.   if TDCCustomPage(Item1).TabOrder < TDCCustomPage(Item2).TabOrder then
  2866.     Result := -1
  2867.   else
  2868.   if TDCCustomPage(Item1).TabOrder = TDCCustomPage(Item2).TabOrder then
  2869.     Result := 0
  2870.   else
  2871.     Result := 1
  2872. end;
  2873.  
  2874. procedure TDCCustomPageControl.Loaded;
  2875.  var
  2876.   i: integer;
  2877.   Form: TCustomForm;
  2878. begin
  2879.   inherited;
  2880.   FPages.Sort(ComparePage);
  2881.   FPages.UpdateVisible;
  2882.   TabsChanged;
  2883.  
  2884.   if not(csDesigning in ComponentState) then
  2885.   begin
  2886.     if (FPages.VisibleCount > 0) then
  2887.     begin
  2888.       while (ActivePage = nil) or not(ActivePage.IsPageVisible) or not(ActivePage.Enabled) do
  2889.         if not SelectNextPage(True) then
  2890.         begin
  2891.           for i := 0 to FPages.Count - 1 do
  2892.             if TDCCustomPage(FPages[i]).IsPageVisible then
  2893.             begin
  2894.               ActivePage := FPages[i];
  2895.               Form := GetparentForm(Self);
  2896.               if (Form <> nil) and (Form.ActiveControl = Self) then
  2897.               begin
  2898.                 Form.ActiveControl := TPrivateWinControl(Form).FindNextControl(Self, True, True, False);
  2899.               end;
  2900.               Exit;
  2901.             end;
  2902.         end
  2903.     end
  2904.     else ActivePage := nil;
  2905.   end;
  2906. end;
  2907.  
  2908. procedure TDCCustomPageControl.WMGetDlgCode(var Message: TWMGetDlgCode);
  2909. begin
  2910.   Message.Result := DLGC_WANTARROWS + DLGC_WANTCHARS;
  2911. end;
  2912.  
  2913. procedure TDCCustomPageControl.CMDialogKey(var Message: TCMDialogKey);
  2914. begin
  2915.   if FTabVisible and (Focused or Windows.IsChild(Handle, Windows.GetFocus)) and
  2916.     (Message.CharCode = VK_TAB) and (GetKeyState(VK_CONTROL) < 0)
  2917.   then begin
  2918.     SelectNextPage(GetKeyState(VK_SHIFT) >= 0);
  2919.     Message.Result := 1;
  2920.   end else
  2921.     inherited;
  2922. end;
  2923.  
  2924. procedure TDCCustomPageControl.CMDesignHitTest(var Message: TCMDesignHitTest);
  2925.  var
  2926.   Page: TDCCustomPage;
  2927. begin
  2928.   inherited;
  2929.   with Message do
  2930.   begin
  2931.     Page := GetPageAt(Pos.X, Pos.Y);
  2932.     if (Page <> nil) and (Page <> ActivePage) then Result := 1;
  2933.   end;
  2934. end;
  2935.  
  2936. procedure TDCCustomPageControl.WMLButtonDown(var Message: TWMLButtonDown);
  2937.  var
  2938.   Page: TDCCustomPage;
  2939. begin
  2940.   Page := GetPageAt(Message.Pos.X, Message.Pos.Y);
  2941.   if Page <> nil then
  2942.   begin
  2943.     SendCancelMode(Self);
  2944.     SetActivePage(Page);
  2945.   end
  2946.   else
  2947.     inherited;
  2948. end;
  2949.  
  2950. function TDCCustomPageControl.GetPageAt(X, Y: integer): TDCCustomPage;
  2951.  var
  2952.   i: integer;
  2953.   Page: TDCCustomPage;
  2954. begin
  2955.   Result := nil;
  2956.   if FTabVisible then
  2957.     for i := 0 to FPages.Count-1 do
  2958.     begin
  2959.       Page := FPages.Items[i];
  2960.       if Page.IsPageVisible and PtInRect(Page.FTabRect, Point(X, Y)) then
  2961.       begin
  2962.         Result := Page;
  2963.         Break;
  2964.       end;
  2965.     end;
  2966. end;
  2967.  
  2968. procedure TDCCustomPageControl.SetImages(const Value: TImageList);
  2969. begin
  2970.   if Images <> nil then
  2971.     Images.UnRegisterChanges(FImageChangeLink);
  2972.   FImages := Value;
  2973.   if Images <> nil then
  2974.   begin
  2975.     Images.RegisterChanges(FImageChangeLink);
  2976.     Images.FreeNotification(Self);
  2977.   end;
  2978.   UpdateTabSize;
  2979.   TabsChanged;
  2980. end;
  2981.  
  2982. procedure TDCCustomPageControl.SetTabVisible(const Value: boolean);
  2983. begin
  2984.   if FTabVisible <> Value then
  2985.   begin
  2986.     FTabVisible := Value;
  2987.     TabsChanged;
  2988.   end;
  2989. end;
  2990.  
  2991. procedure TDCCustomPageControl.ImageListChange(Sender: TObject);
  2992. begin
  2993.   UpdateTabSize;
  2994.   TabsChanged;
  2995. end;
  2996.  
  2997. procedure TDCCustomPageControl.Notification(AComponent: TComponent;
  2998.   Operation: TOperation);
  2999. begin
  3000.   inherited Notification(AComponent, Operation);
  3001.   if (Operation = opRemove) then
  3002.   begin
  3003.     if (AComponent = FImages) then
  3004.     begin
  3005.       FImages := nil;
  3006.       Invalidate;
  3007.       Exit;
  3008.     end;
  3009.     if (AComponent = BrushImage.Images) then
  3010.     begin
  3011.       BrushImage.Images := nil;
  3012.       Exit;
  3013.     end;
  3014.   end;
  3015. end;
  3016.  
  3017. procedure TDCCustomPageControl.UpdateTabsRect;
  3018.  var
  3019.   i, VisibleIndex: integer;
  3020.   Page: TDCCustomPage;
  3021.   ARect: TRect;
  3022. begin
  3023.   if FTabVisible then
  3024.   begin
  3025.     FTabsRect := GetTabsRect;
  3026.     SetRectEmpty(ARect);
  3027.     for i := 0 to FPages.Count - 1 do
  3028.     begin
  3029.       Page := FPages.Items[i];
  3030.       VisibleIndex := -1;
  3031.       if ARect.Left < FTabsRect.Right then
  3032.       begin
  3033.         if (csDesigning in ComponentState) then
  3034.           VisibleIndex := i
  3035.         else
  3036.          if Page.IsPageVisible then VisibleIndex := FPages.VisibleIndexOf(Page.PageIndex);
  3037.       end;
  3038.       if (VisibleIndex <> -1) and (VisibleIndex >= FFirstIndex) then
  3039.       begin
  3040.         ARect := GetTabRect(VisibleIndex, Page, ARect);
  3041.         Page.FTabRect := ARect;
  3042.       end
  3043.       else
  3044.         SetRectEmpty(Page.FTabRect);
  3045.     end;
  3046.   end
  3047.   else
  3048.     SetRectEmpty(FTabsRect);
  3049. end;
  3050.  
  3051. procedure TDCCustomPageControl.WMEraseBkGnd(var Message: TWMEraseBkGnd);
  3052. begin
  3053.   Message.Result := 0;
  3054. end;
  3055.  
  3056. procedure TDCCustomPageControl.CreateParams(var Params: TCreateParams);
  3057. begin
  3058.   inherited CreateParams(Params);
  3059.   with Params.WindowClass do
  3060.     Style := Style and not (CS_HREDRAW or CS_VREDRAW);
  3061. end;
  3062.  
  3063. procedure TDCCustomPageControl.UpdateTabSize;
  3064. begin
  3065.   {}
  3066. end;
  3067.  
  3068. procedure TDCCustomPageControl.KeyDown(var Key: Word; Shift: TShiftState);
  3069. begin
  3070.   inherited;
  3071.   if FTabVisible then
  3072.   begin
  3073.     case Key of
  3074.       VK_LEFT:
  3075.         SelectNextPage(False);
  3076.       VK_RIGHT:
  3077.         SelectNextPage(True);
  3078.     end
  3079.   end;
  3080. end;
  3081.  
  3082. procedure TDCCustomPageControl.RepaintTabs;
  3083. begin
  3084.   Realign;
  3085.   Paint;
  3086. end;
  3087.  
  3088. procedure TDCCustomPageControl.ChangeBrush(Sender: TObject);
  3089. begin
  3090.   Invalidate;
  3091. end;
  3092.  
  3093. procedure TDCCustomPageControl.SetBrushImage(const Value: TDCBrushImage);
  3094. begin
  3095.   FBrushImage := Value;
  3096. end;
  3097.  
  3098. { TPageList }
  3099.  
  3100. procedure TPageList.AddVisible(AIndex: integer);
  3101.  var
  3102.   pIndex: ^Integer;
  3103. begin
  3104.   GetMem(pIndex, SizeOf(Integer));
  3105.   pIndex^ := AIndex;
  3106.   FVisibleList.Add(pIndex);
  3107. end;
  3108.  
  3109. procedure TPageList.ClearVisible;
  3110.  var
  3111.   i: integer;
  3112. begin
  3113.   for i := 0 to FVisibleList.Count-1 do
  3114.   begin
  3115.     FreeMem(FVisibleList.Items[i], SizeOf(Integer));
  3116.   end;
  3117.   FVisibleList.Clear;
  3118. end;
  3119.  
  3120. constructor TPageList.Create(AComponent: TComponent);
  3121. begin
  3122.   inherited Create;
  3123.   FPageControl := TDCCustomPageControl(AComponent);
  3124.   FVisibleList := TList.Create;
  3125. end;
  3126.  
  3127. destructor TPageList.Destroy;
  3128. begin
  3129.   ClearVisible;
  3130.   FVisibleList.Free;
  3131.   inherited;
  3132. end;
  3133.  
  3134. function TPageList.GetVisibleCount: integer;
  3135. begin
  3136.   Result := FVisibleList.Count;
  3137. end;
  3138.  
  3139. procedure TPageList.SetVisible(APage: TDCCustomPage; AVisible: boolean);
  3140.  var
  3141.   i: integer;
  3142.   pIndex: ^Integer;
  3143.   PageFound: boolean;
  3144. begin
  3145.   PageFound := False;
  3146.   with FVisibleList do
  3147.   begin
  3148.     i := 0;
  3149.     while (i < Count) and PageFound do
  3150.     begin
  3151.       pIndex := Items[i];
  3152.       if APage.PageIndex = pIndex^ then
  3153.       begin
  3154.         if not AVisible then
  3155.         begin
  3156.           FreeMem(pIndex, SizeOf(Integer));
  3157.           Delete(i);
  3158.           PageFound := True;
  3159.           Break;
  3160.         end;
  3161.       end;
  3162.       Inc(i);
  3163.     end;
  3164.     if not PageFound and AVisible then UpdateVisible;
  3165.   end;
  3166. end;
  3167.  
  3168. procedure TPageList.UpdateVisible;
  3169.  var
  3170.   i, j: integer;
  3171.   pIndex: ^Integer;
  3172.   Page: TDCCustomPage;
  3173. begin
  3174.   j := 0;
  3175.   for i := 0 to Count-1 do
  3176.   begin
  3177.     Page := TDCCustomPage(Items[i]);
  3178.     if Page.IsPageVisible then
  3179.     begin
  3180.       if j < FVisibleList.Count then
  3181.         pIndex := FVisibleList.Items[j]
  3182.       else begin
  3183.         GetMem(pIndex, SizeOf(Integer));
  3184.         FVisibleList.Add(pIndex);
  3185.       end;
  3186.       pIndex^ := Page.PageIndex;
  3187.       Inc(j)
  3188.     end;
  3189.   end;
  3190.   if FVisibleList.Count > j then
  3191.   begin
  3192.     while j < FVisibleList.Count do
  3193.     begin
  3194.       FreeMem(FVisibleList.Items[j], SizeOf(Integer));
  3195.       FVisibleList.Delete(j);
  3196.     end;
  3197.   end;
  3198. end;
  3199.  
  3200. function TPageList.VisibleIndexOf(Index: integer): integer;
  3201.  var
  3202.   i: integer;
  3203. begin
  3204.   Result := -1;
  3205.   with FPageControl do
  3206.     if not ((csDesigning in ComponentState) or TabVisible) then Exit;
  3207.   for i := 0 to FVisibleList.Count-1 do
  3208.     if Index = Integer(FVisibleList.Items[i]^) then
  3209.     begin
  3210.       if FPageControl.FFirstIndex <= i then Result := i;
  3211.       Exit;
  3212.     end;
  3213. end;
  3214.  
  3215. { TDCPageControl }
  3216.  
  3217. constructor TDCPageControl.Create(AComponent: TComponent);
  3218. begin
  3219.   inherited;
  3220.   FTabSize     := Point(0, 0);
  3221.   FDrawStyle   := fcsNormal;
  3222.   FTabMargins  := Rect(4, 6, 4, 3);
  3223.   FItemMargins := Rect(5, 3, 5, 3);
  3224.   FTabPosition := tbBottom;
  3225.   CreateTracks;
  3226.  
  3227.   FMouseDown  := False;
  3228.   FTimer      := False;
  3229.   FRedrawTabs := False;
  3230.  
  3231.   FCanvasLocked := False;
  3232.   FChangedPage  := nil;
  3233.   FPageSelected := True;
  3234.  
  3235.   FTabColor := clBtnShadow;
  3236. end;
  3237.  
  3238. procedure TDCPageControl.DoDrawTab(ACanvas: TCanvas; ARect: TRect;
  3239.   AIndex: integer; APage: TDCCustomPage; AActivePage: boolean);
  3240.  var
  3241.   BRect: TRect;
  3242. begin
  3243.   inherited;
  3244.   if ARect.Left >= ARect.Right then Exit;
  3245.  
  3246.   with ACanvas do
  3247.   begin
  3248.     if AActivePage then
  3249.       Brush.Color := clBtnFace
  3250.     else
  3251.       Brush.Color := FTabColor;
  3252.  
  3253.     FillRect(ARect);
  3254.     if (Screen.ActiveControl = Self) and AActivePage then
  3255.     begin
  3256.       BRect := ARect;
  3257.       InflateRect(BRect, -2, -1);
  3258.       BRect.Right  := BRect.Right  - 1;
  3259.       BRect.Bottom := BRect.Bottom - 1;
  3260.  
  3261.       Brush.Bitmap := AllocPatternBitmap(clBlack, Brush.Color);
  3262.       FrameRect(BRect);
  3263.     end;
  3264.  
  3265.     if FTabPosition in [tbTop, tbBottom] then
  3266.     begin
  3267.       if AActivePage then
  3268.       begin
  3269.         case FTabPosition of
  3270.           tbTop:
  3271.             begin
  3272.               if ColorToRGB(FTabColor) < ColorToRGB(clSilver) then
  3273.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOP)
  3274.               else
  3275.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOPLEFT);
  3276.               if APage.FFullVisible then
  3277.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_RIGHT)
  3278.               else begin
  3279.               end;
  3280.             end;
  3281.           tbBottom:
  3282.             begin
  3283.               if APage.FFullVisible then
  3284.                  DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
  3285.               else begin
  3286.                  DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOM)
  3287.               end;
  3288.               if ColorToRGB(FTabColor) > ColorToRGB(clSilver) then
  3289.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_LEFT);
  3290.             end;
  3291.         end;
  3292.       end
  3293.       else begin
  3294.         case FTabPosition of
  3295.           tbTop   : DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_BOTTOM);
  3296.           tbBottom: DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_TOP);
  3297.         end;
  3298.         if FTabPosition = tbTop then Dec(ARect.Bottom) else Inc(ARect.Top);
  3299.         InflateRect(ARect, 0, -3);
  3300.         if APage.FFullVisible and
  3301.            (((csDesigning in ComponentState) and (AIndex <> FPages.Count-1) ) or
  3302.            (not(csDesigning in ComponentState) and (AIndex <> FPages.VisibleCount-1)))
  3303.         then
  3304.           DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_RIGHT or BF_FLAT);
  3305.         if FTabPosition = tbTop then Inc(ARect.Bottom) else Dec(ARect.Top);
  3306.         InflateRect(ARect, 0, 3);
  3307.       end;
  3308.     end
  3309.     else begin
  3310.       if AActivePage then
  3311.       begin
  3312.         case FTabPosition of
  3313.           tbLeft:
  3314.             begin
  3315.               if ColorToRGB(FTabColor) < ColorToRGB(clSilver) then
  3316.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_LEFT)
  3317.               else
  3318.                 DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_BOTTOMLEFT);
  3319.               DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOP);
  3320.             end;
  3321.           tbRight:
  3322.             begin
  3323.               DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_BOTTOMRIGHT);
  3324.               DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDINNER, BF_TOP)
  3325.             end;
  3326.         end;
  3327.       end
  3328.       else begin
  3329.         case FTabPosition of
  3330.           tbLeft  : //DrawEdge(ACanvas.Handle, ARect, BDR_RAISEDOUTER, BF_RIGHT);
  3331.             DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENOUTER, BF_RIGHT);
  3332.           tbRight : DrawEdge(ACanvas.Handle, ARect, BDR_SUNKENINNER, BF_LEFT);
  3333.         end;
  3334.       end;
  3335.     end;
  3336.     DrawTabText(ACanvas, ARect, AIndex, APage, AActivePage);
  3337.   end;
  3338. end;
  3339.  
  3340. procedure TDCPageControl.DrawBorder(ACanvas: TCanvas);
  3341.  var
  3342.   ARect, BRect: TRect;
  3343.   ARgn, BRgn: HRGN;
  3344.   AResult: integer;
  3345. begin
  3346.   if (FPages.VisibleCount > 0) or
  3347.      ((csDesigning in ComponentState) and (FPages.Count > 0)) then
  3348.   begin
  3349.  
  3350.     if FTabVisible then
  3351.     begin
  3352.       ARect := GetCurrentPageRect;
  3353.       case FTabPosition of
  3354.         tbBottom: ARect.Bottom := ARect.Bottom - 2;
  3355.         tbTop: ARect.Top := ARect.Top + 2;
  3356.         tbLeft: ARect.Left := ARect.Left + 2;
  3357.         tbRight: ARect.Right := ARect.Right - 2;
  3358.       end;
  3359.     end
  3360.     else begin
  3361.       ARect := ClientRect;
  3362.       InflateRect(ARect, -2, -2);
  3363.     end;
  3364.  
  3365.     InflateRect(ARect, 2, 2);
  3366.     with Canvas do
  3367.     begin
  3368.       Canvas.Brush.Color := Self.Color;
  3369.       FrameRect(ARect);
  3370.       InflateRect(ARect, -1, -1);
  3371.       FrameRect(ARect);
  3372.       ARgn := CreateRectRgnIndirect(ARect);
  3373.       try
  3374.       if ActivePage <> nil then
  3375.       begin
  3376.         BRect := GetClientRect;
  3377.         AdjustClientRect(BRect);
  3378.         BRgn  := CreateRectRgnIndirect(BRect);
  3379.         try
  3380.           AResult := CombineRgn(ARgn, ARgn, BRgn, RGN_DIFF);
  3381.           if AResult <> NULLREGION then
  3382.             FillRgn(Canvas.Handle, ARgn, Canvas.Brush.Handle)
  3383.         finally
  3384.           DeleteObject(BRgn);
  3385.         end;
  3386.       end;
  3387.       finally
  3388.         DeleteObject(ARgn);
  3389.       end;
  3390.     end;
  3391.   end
  3392.   else begin
  3393.     ARect := ClientRect;
  3394.     Canvas.Brush.Color := Self.Color;
  3395.     Canvas.FillRect(ARect);
  3396.   end;
  3397.  
  3398.   ARect := ClientRect;
  3399.   case FDrawStyle of
  3400.     fcsNormal:
  3401.       begin
  3402.         DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT);
  3403.         InflateRect(ARect, -1, -1);
  3404.         DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_RECT);
  3405.       end;
  3406.     fsFlat:
  3407.       begin
  3408.         DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
  3409.         DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  3410.       end;
  3411.     fsNone:
  3412.       ;
  3413.     fsSingle:
  3414.       with Canvas do
  3415.       begin
  3416.         Canvas.Brush.Color := clBtnShadow;
  3417.         FrameRect(ARect);
  3418.       end;
  3419.   end;
  3420.  
  3421. end;
  3422.  
  3423. procedure TDCPageControl.DrawTabsArea(ACanvas: TCanvas);
  3424.  var
  3425.   ATabRect: TRect;
  3426.   DCRegion, TabsRegion: HRGN;
  3427.   SaveIndex: integer;
  3428. begin
  3429.   if not FBuffered then
  3430.   begin
  3431.     DCRegion  := CreateRectRgnIndirect(ClientRect);
  3432.     DCRegion  := GetClipRgn(ACanvas.Handle, DCRegion);
  3433.     TabsRegion:= CreateRectRgnIndirect(ControlRect);
  3434.     SelectClipRgn(ACanvas.Handle, TabsRegion);
  3435.   end
  3436.   else begin
  3437.     DCRegion   := 0;
  3438.     TabsRegion := 0;
  3439.   end;
  3440.  
  3441.   try
  3442.     SaveIndex := SaveDC(ACanvas.Handle);
  3443.     inherited;
  3444.     ATabRect := TabsRect;
  3445.     if FBuffered then OffsetRect(ATabRect, -ATabRect.Left, -ATabRect.Top);
  3446.  
  3447.     with ACanvas do
  3448.     begin
  3449.       if FPrevTrack.Visible and not FBuffered then
  3450.         with FPrevTrack do
  3451.            ExcludeClipRect(Handle, Left, Top, Left+Width, Top+Height);
  3452.       if FNextTrack.Visible and not FBuffered then
  3453.         with FNextTrack do
  3454.            ExcludeClipRect(Handle, Left, Top, Left+Width, Top+Height);
  3455.  
  3456.       Brush.Color := FTabColor;
  3457.  
  3458.       FillRect(ATabRect);
  3459.       case FTabPosition of
  3460.         tbTop:
  3461.           begin
  3462.             Pen.Color := clWindow;
  3463.             MoveTo(ATabRect.Left, ATabRect.Bottom-1);
  3464.             LineTo(ATabRect.Right, ATabRect.Bottom-1);
  3465.           end;
  3466.         tbBottom:
  3467.           begin
  3468.             Pen.Color   := cl3DDkShadow;
  3469.             MoveTo(ATabRect.Left, ATabRect.Top);
  3470.             LineTo(ATabRect.Right, ATabRect.Top);
  3471.           end;
  3472.         tbLeft:
  3473.           begin
  3474.             Pen.Color := clWindow;
  3475.             MoveTo(ATabRect.Right-1, ATabRect.Top);
  3476.             LineTo(ATabRect.Right-1, ATabRect.Bottom);
  3477.           end;
  3478.         tbRight:
  3479.           begin
  3480.             Pen.Color   := cl3DDkShadow;
  3481.             MoveTo(ATabRect.Left, ATabRect.Top);
  3482.             LineTo(ATabRect.Left, ATabRect.Bottom);
  3483.           end;
  3484.       end;
  3485.     end;
  3486.     RestoreDC(ACanvas.Handle, SaveIndex);
  3487.     if ActivePage <> nil then
  3488.     begin
  3489.       ATabRect := ActivePage.FTabRect;
  3490.       if ATabRect.Left <> ATabRect.Right then
  3491.       begin
  3492.         if FBuffered then OffsetRect(ATabRect, -FTabsRect.Left, -FTabsRect.Top);
  3493.         DrawTabDiv(ACanvas, ATabRect, True, ActivePage.PageIndex = FFirstIndex);
  3494.       end;
  3495.     end;
  3496.   finally
  3497.     if not FBuffered then
  3498.     begin
  3499.       SelectClipRgn(ACanvas.Handle, DCRegion);
  3500.       DeleteObject(TabsRegion);
  3501.       DeleteObject(DCRegion);
  3502.     end;
  3503.   end;
  3504. end;
  3505.  
  3506. function TDCPageControl.ControlRect: TRect;
  3507. begin
  3508.   Result := ClientRect;
  3509.   case FDrawStyle of
  3510.     fcsNormal:
  3511.       InflateRect(Result, -2, -2);
  3512.     fsFlat:
  3513.       InflateRect(Result, -1, -1);
  3514.     fsNone:
  3515.       ;
  3516.     fsSingle:
  3517.       InflateRect(Result, -1, -1);
  3518.   end;
  3519. end;
  3520.  
  3521. function TDCPageControl.GetCurrentPageRect: TRect;
  3522. begin
  3523.   Result := ControlRect;
  3524.   case FTabPosition of
  3525.     tbTop   :  Result.Top := Result.Top + FTabHeight;
  3526.     tbBottom:  Result.Bottom := Result.Bottom - FTabHeight;
  3527.     tbLeft  :  Result.Left := Result.Left + FTabWidth;
  3528.     tbRight :  Result.Right := Result.Right - FTabWidth;
  3529.   end;
  3530. end;
  3531.  
  3532. function TDCPageControl.GetTabRect(AIndex: integer; Page: TDCCustomPage;
  3533.   var ARect: TRect): TRect;
  3534.  var
  3535.   ATabsRect: TRect;
  3536.   AItemWidth: integer;
  3537. begin
  3538.   ATabsRect := TabsRect;
  3539.   AIndex    := AIndex - FFirstIndex;
  3540.  
  3541.   case FTabPosition of
  3542.     tbTop, tbBottom:
  3543.     begin
  3544.       if FTabSize.X = 0 then
  3545.       begin
  3546.         Canvas.Font := Self.Font;
  3547.         AItemWidth := GetItemSize(Page).X;
  3548.         if AIndex <= 0 then
  3549.           Result.Left  := FTabMargins.Left + FPrevTrack.Width + 2
  3550.         else
  3551.           Result.Left  := ARect.Right;
  3552.         Result.Right := Result.Left + AItemWidth + FItemMargins.Left + FItemMargins.Right;
  3553.       end
  3554.       else begin
  3555.         Result.Left  := ATabsRect.Left + FTabMargins.Left + FPrevTrack.Width + 2 + AIndex*FTabSize.X;
  3556.         Result.Right := Result.Left + FTabSize.X;
  3557.       end;
  3558.       case FTabPosition of
  3559.         tbTop:
  3560.           begin
  3561.             Result.Bottom:= ATabsRect.Bottom;
  3562.             Result.Top   := ATabsRect.Bottom - (FItemHeight + FItemMargins.Top + FItemMargins.Bottom);
  3563.           end;
  3564.         tbBottom:
  3565.           begin
  3566.             Result.Top   := ATabsRect.Top;
  3567.             Result.Bottom:= ATabsRect.Top + (FItemHeight + FItemMargins.Top + FItemMargins.Bottom);
  3568.           end;
  3569.       end;
  3570.       if Result.Right > ATabsRect.Right - FTabMargins.Right - FNextTrack.Width - 2 then
  3571.       begin
  3572.         Page.FFullVisible := False;
  3573.         Result.Right := ATabsRect.Right - FTabMargins.Right - FNextTrack.Width - 2;
  3574.       end
  3575.       else
  3576.         Page.FFullVisible := True;
  3577.     end;
  3578.     tbLeft, tbRight:
  3579.     begin
  3580.       Result.Top  := FTabMargins.Top +  FPrevTrack.Height + TabsRect.Top  + AIndex*FTabHeight;
  3581.       Result.Bottom  := Result.Top + FTabHeight;
  3582.       if FTabPosition = tbLeft then
  3583.       begin
  3584.         Result.Right := TabsRect.Right;
  3585.         Result.Left := TabsRect.Left + FTabMargins.Left;
  3586.       end
  3587.       else begin
  3588.         Result.Right := TabsRect.Right - FTabMargins.Right;
  3589.         Result.Left := TabsRect.Left;
  3590.       end;
  3591.       if Result.Bottom > ATabsRect.Bottom - FTabMargins.Right then
  3592.         SetRectEmpty(Result)
  3593.       else
  3594.         Page.FFullVisible := True;
  3595.     end;
  3596.   end;
  3597. end;
  3598.  
  3599. function TDCPageControl.GetTabsRect: TRect;
  3600. begin
  3601.   Result := ControlRect;
  3602.   case FTabPosition of
  3603.     tbTop   :  Result.Bottom := Result.Top + FTabHeight;
  3604.     tbBottom:  Result.Top := Result.Bottom - FTabHeight;
  3605.     tbLeft  :  Result.Right := Result.Left + FTabWidth;
  3606.     tbRight :  Result.Left := Result.Right - FTabWidth;
  3607.   end;
  3608. end;
  3609.  
  3610. procedure TDCPageControl.SetTabHeight(const Value: integer);
  3611. begin
  3612.   if FTabSize.Y <> Value then
  3613.   begin
  3614.     if Value >= 0 then FTabSize.Y := Value;
  3615.     UpdateTabSize;
  3616.   end;
  3617. end;
  3618.  
  3619. procedure TDCPageControl.SetTabWidth(const Value: integer);
  3620. begin
  3621.   if FTabSize.X <> Value then
  3622.   begin
  3623.     if Value >= 0 then FTabSize.X := Value;
  3624.     UpdateTabSize;
  3625.   end;
  3626. end;
  3627.  
  3628. procedure TDCPageControl.UpdateTabSize;
  3629.  var
  3630.   i: integer;
  3631. begin
  3632.   Canvas.Font := Self.Font;
  3633.   FItemHeight := GetTextHeight(Canvas.Handle, 'Wg');
  3634.   if Assigned(Images) and (Images.Height > FItemHeight) then
  3635.     FItemHeight := Images.Height;
  3636.  
  3637.   if FTabSize.Y > 0 then
  3638.     FTabHeight := FTabSize.Y
  3639.   else
  3640.     with FTabMargins do
  3641.       FTabHeight := FItemHeight + Top + Bottom;
  3642.  
  3643.   if FTabPosition in [tbLeft, tbRight] then
  3644.   begin
  3645.     if FTabSize.X > 0 then
  3646.       FTabWidth := FTabSize.X
  3647.     else begin
  3648.       FTabWidth := 0;
  3649.       for i := 0 to PageCount - 1 do
  3650.         if Pages[i].IsPageVisible then
  3651.           FTabWidth := _IntMax(GetItemSize(Pages[i]).X, FTabWidth);
  3652.       Inc(FTabWidth, FItemMargins.Left + FItemMargins.Right + FTabMargins.Left + FTabMargins.Right);
  3653.     end;
  3654.     if FTabSize.Y = 0 then FTabHeight := FItemHeight + 7;
  3655.   end;
  3656.  
  3657.   FPrevTrack.Height := FTabHeight - 4;
  3658.   FNextTrack.Height := FTabHeight - 4;
  3659.  
  3660.   if HandleAllocated then UpdateTracksPos;
  3661.   TabsChanged;
  3662. end;
  3663.  
  3664. procedure TDCPageControl.SetDrawStyle(const Value: TControlStyle);
  3665. begin
  3666.   if FDrawStyle <> Value then
  3667.   begin
  3668.     FDrawStyle := Value;
  3669.     TabsChanged;
  3670.     UpdateTracksPos;
  3671.     invalidate;
  3672.   end;
  3673. end;
  3674.  
  3675. procedure TDCPageControl.SetTabPosition(const Value: TLiteTabPosition);
  3676. begin
  3677.   if FTabPosition <> Value then
  3678.   begin
  3679.     FTabPosition := Value;
  3680.     UpdateTabSize;
  3681.     TabsChanged;
  3682.     Invalidate;
  3683.   end;
  3684. end;
  3685.  
  3686. procedure TDCPageControl.CreateWnd;
  3687. begin
  3688.   inherited;
  3689.   UpdateTabSize;
  3690. end;
  3691.  
  3692. procedure TDCPageControl.CMFontChanged(var Message: TMessage);
  3693. begin
  3694.   inherited;
  3695.   UpdateTabSize;
  3696.   UpdateTabs;
  3697. end;
  3698.  
  3699. procedure TDCPageControl.Paint;
  3700. begin
  3701.   inherited;
  3702.   PaintTracks;
  3703. end;
  3704.  
  3705. function TDCPageControl.CanChange(Page: TDCCustomPage): Boolean;
  3706. begin
  3707.   Result := inherited CanChange(Page);
  3708. end;
  3709.  
  3710. destructor TDCPageControl.Destroy;
  3711. begin
  3712.   if Assigned(FPrevTrack) then
  3713.   begin
  3714.     FPrevTrack.Free;
  3715.     FPrevTrack := nil;
  3716.   end;
  3717.   if Assigned(FNextTrack) then
  3718.   begin
  3719.     FNextTrack.Free;
  3720.     FNextTrack := nil;
  3721.   end;
  3722.   inherited;
  3723. end;
  3724.  
  3725. procedure TDCPageControl.CreateTracks;
  3726. begin
  3727.   FPrevTrack:= TDCEditButton.Create(Self);
  3728.   with FPrevTrack do
  3729.   begin
  3730.     Visible := False;
  3731.     Width   := 13;
  3732.     Height  := TabHeight;
  3733.     DrawText:= False;
  3734.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNLEFT');
  3735.     BrushColor := clBtnFace;
  3736.     OnClick := ButtonsDown;
  3737.   end;
  3738.  
  3739.   FNextTrack:= TDCEditButton.Create(Self);
  3740.   with FNextTrack do
  3741.   begin
  3742.     Visible := False;
  3743.     Width   := 13;
  3744.     Height  := TabHeight;
  3745.     DrawText:= False;
  3746.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNRIGHT');
  3747.     BrushColor := clBtnFace;
  3748.     OnClick := ButtonsUp;
  3749.   end;
  3750. end;
  3751.  
  3752. procedure TDCPageControl.ButtonsDown(Sender: TObject);
  3753. begin
  3754.   FFirstIndex := FFirstIndex - 1;
  3755.   UpdateTabsRect;
  3756.   UpdateTabs;
  3757. end;
  3758.  
  3759. procedure TDCPageControl.ButtonsUp(Sender: TObject);
  3760. begin
  3761.   FFirstIndex := FFirstIndex + 1;
  3762.   UpdateTabsRect;
  3763.   UpdateTabs;
  3764. end;
  3765.  
  3766. procedure TDCPageControl.WMSize(var Message: TMessage);
  3767. begin
  3768.   CheckToNextTrack;
  3769.   if not FNextTrack.Visible then CheckToPrevTrack;
  3770.   UpdateTracksPos;
  3771.   inherited;
  3772. end;
  3773.  
  3774. procedure TDCPageControl.PaintTracks;
  3775. begin
  3776.   if FPrevTrack.Visible then FPrevTrack.Paint;
  3777.   if FNextTrack.Visible then FNextTrack.Paint;
  3778. end;
  3779.  
  3780. procedure TDCPageControl.UpdateTracksState(X, Y: integer; lMove: boolean);
  3781. begin
  3782.   FPrevTrack.UpdateButtonState(X, Y, FMouseDown, lMove);
  3783.   FNextTrack.UpdateButtonState(X, Y, FMouseDown, lMove);
  3784. end;
  3785.  
  3786. procedure TDCPageControl.WMLButtonDblClk(var Message: TWMLButtonDown);
  3787. begin
  3788.   inherited;
  3789.   if not (csDesigning in ComponentState) then
  3790.   begin
  3791.     FMouseDown := True;
  3792.     UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  3793.  
  3794.     if (FPrevTrack.ButtonState  = btDownMouseInRect) or
  3795.        (FNextTrack.ButtonState  = btDownMouseInRect) then
  3796.      SetTimer(Handle, CTRTIMER_IDEVENT, 200, nil);
  3797.   end;
  3798. end;
  3799.  
  3800. procedure TDCPageControl.WMLButtonDown(var Message: TWMLButtonDown);
  3801. begin
  3802.   inherited;
  3803.   if not (csDesigning in ComponentState) then
  3804.   begin
  3805.     FMouseDown := True;
  3806.     UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  3807.  
  3808.     if (FPrevTrack.ButtonState  = btDownMouseInRect) or
  3809.        (FNextTrack.ButtonState  = btDownMouseInRect) then
  3810.      SetTimer(Handle, CTRTIMER_IDEVENT, 200, nil);
  3811.   end;
  3812. end;
  3813.  
  3814. procedure TDCPageControl.WMLButtonUp(var Message: TWMLButtonUp);
  3815. begin
  3816.   inherited;
  3817.   if not (csDesigning in ComponentState) then
  3818.   begin
  3819.     FMouseDown := False;
  3820.     UpdateTracksState(Message.Pos.X, Message.Pos.Y, False);
  3821.  
  3822.     KillTimer(Handle, CTRTIMER_IDEVENT);
  3823.     FTimer := False;
  3824.   end;
  3825. end;
  3826.  
  3827. procedure TDCPageControl.WMMouseMove(var Message: TWMMouseMove);
  3828. begin
  3829.   inherited;
  3830.   UpdateTracksState(Message.Pos.X, Message.Pos.Y, True);
  3831. end;
  3832.  
  3833. procedure TDCPageControl.UpdateTracksPos;
  3834.  var
  3835.   ARect: TRect;
  3836. begin
  3837.   ARect :=  GetTabsRect;
  3838.  
  3839.   case FTabPosition of
  3840.     tbTop, tbBottom:
  3841.       begin
  3842.         with FPrevTrack do
  3843.         begin
  3844.           Left :=  ARect.Left + 2;
  3845.           Top  :=  ARect.Top  + 2;
  3846.         end;
  3847.  
  3848.         with FNextTrack do
  3849.         begin
  3850.           Left :=  ClientRect.Right - Width - 4;
  3851.           Top  :=  ARect.Top  + 2;
  3852.         end;
  3853.       end;
  3854.     tbLeft, tbRight:
  3855.       begin
  3856.         with FPrevTrack do
  3857.         begin
  3858.           Left :=  ARect.Left + 2;
  3859.           Top  :=  ARect.Top  + 2;
  3860.         end;
  3861.         with FNextTrack do
  3862.         begin
  3863.           Left :=  ARect.Right - Width - 2;
  3864.           Top  :=  ARect.Top  + 2;
  3865.         end;
  3866.       end;
  3867.   end;
  3868. end;
  3869.  
  3870. procedure TDCPageControl.HideTrack(Track: TDCEditButton);
  3871. begin
  3872.   Track.Visible := False;
  3873.   if FTimer then KillTimer(Handle, CTRTIMER_IDEVENT);
  3874. end;
  3875.  
  3876. procedure TDCPageControl.UpdateTabs;
  3877. begin
  3878.   if not HandleAllocated then Exit;
  3879.   if not FTabVisible then
  3880.   begin
  3881.     HideTrack(FPrevTrack);
  3882.     HideTrack(FNextTrack);
  3883.   end
  3884.   else begin
  3885.     if (FFirstIndex = 0) and FPrevTrack.Visible then HideTrack(FPrevTrack);
  3886.     if (FFirstIndex > 0) and not FPrevTrack.Visible then FPrevTrack.Visible := True;
  3887.     CheckToNextTrack;
  3888.   end;
  3889.   if not FCanvasLocked then Invalidate;
  3890. end;
  3891.  
  3892. procedure TDCPageControl.CheckToNextTrack;
  3893.  var
  3894.   i, VisibleIndex: integer;
  3895.   Page: TDCCustomPage;
  3896.   ARect: TRect;
  3897. begin
  3898.   if FTabVisible then
  3899.   begin
  3900.     FTabsRect := GetTabsRect;
  3901.     SetRectEmpty(ARect);
  3902.     for i := 0 to FPages.Count - 1 do
  3903.     begin
  3904.       Page := FPages.Items[i];
  3905.       VisibleIndex := -1;
  3906.       if (csDesigning in ComponentState) then
  3907.         VisibleIndex := i
  3908.       else
  3909.         if Page.IsPageVisible then VisibleIndex := FPages.VisibleIndexOf(Page.PageIndex);
  3910.       if (VisibleIndex <> -1) and ( not Page.FFullVisible or IsRectEmpty(Page.FTabRect)) then 
  3911.       begin
  3912.         FNextTrack.Visible := True;
  3913.         Exit;
  3914.       end;
  3915.     end;
  3916.   end;
  3917.   HideTrack(FNextTrack);
  3918. end;
  3919.  
  3920. procedure TDCPageControl.CheckToPrevTrack; 
  3921.  var
  3922.   AFirstIndex: integer;
  3923. begin
  3924.   if FFirstIndex > 0 then
  3925.   begin
  3926.     AFirstIndex   := FFirstIndex;
  3927.     FCanvasLocked := True;
  3928.     repeat
  3929.       ButtonsDown(Self);
  3930.       if FNextTrack.Visible then
  3931.       begin
  3932.         ButtonsUp(Self);
  3933.         break;
  3934.       end;
  3935.     until (FFirstIndex = 0);
  3936.     FCanvasLocked := False;
  3937.     if FFirstIndex <> AFirstIndex then invalidate;
  3938.   end;
  3939. end;
  3940.  
  3941. procedure TDCPageControl.Loaded;
  3942. begin
  3943.   inherited;
  3944.   FCanvasLocked := True;
  3945.   UpdateFirstIndex;
  3946.   UpdateTabs;
  3947.   if FTabPosition in [tbLeft, tbRight] then UpdateTabSize;
  3948.   FCanvasLocked := False;
  3949. end;
  3950.  
  3951. procedure TDCPageControl.WMTimer(var Message: TWMTimer);
  3952. begin
  3953.   FTimer := True;
  3954.   if FNextTrack.ButtonState = btDownMouseInRect then ButtonsUp(Self);
  3955.   if FPrevTrack.ButtonState = btDownMouseInRect then ButtonsDown(Self);
  3956. end;
  3957.  
  3958. procedure TDCPageControl.TabsChanged;
  3959. begin
  3960.   Realign;
  3961.   if (ActivePage <> nil) and
  3962.      (not ActivePage.FFullVisible or IsRectEmpty(ActivePage.FTabRect)) then
  3963.     UpdateFirstIndex
  3964.   else
  3965.     if not FRedrawTabs then UpdateTabsRect;
  3966.  
  3967.   if FRedrawTabs and FTabVisible  then
  3968.   begin
  3969.     RedrawTab(FChangedPage);
  3970.     RedrawTab(ActivePage);
  3971.     FRedrawTabs := False;
  3972.   end
  3973.   else
  3974.     UpdateTabs;
  3975. end;
  3976.  
  3977. procedure TDCPageControl.CMMouseEnter(var Message: TMessage);
  3978. begin
  3979.   inherited;
  3980. end;
  3981.  
  3982. procedure TDCPageControl.CMMouseLeave(var Message: TMessage);
  3983. begin
  3984.   ClearSelection;
  3985.   inherited;
  3986.   FPrevTrack.UpdateButtonState(-1, -1, False, True);
  3987.   FNextTrack.UpdateButtonState(-1, -1, False, True);
  3988. end;
  3989.  
  3990. procedure TDCPageControl.DrawTabText(ACanvas: TCanvas; ARect: TRect;
  3991.   AIndex: integer; APage: TDCCustomPage; AActivePage: boolean);
  3992.  var
  3993.   Flags: Longint;
  3994.   AText: string;
  3995. begin
  3996.   inherited;
  3997.   if ARect.Left >= ARect.Right then Exit;
  3998.  
  3999.   with ACanvas do
  4000.   begin
  4001.     Font := Self.Font;
  4002.     if AActivePage then
  4003.     begin
  4004.       Brush.Color := clBtnFace;
  4005.       if APage.Enabled or (csDesigning in ComponentState) then
  4006.         Font.Color  := clWindowText
  4007.       else
  4008.         Font.Color := clBtnShadow
  4009.     end
  4010.     else begin
  4011.       Brush.Color := FTabColor;
  4012.       if ColorToRGB(FTabColor) < ColorToRGB(clSilver) then
  4013.       begin
  4014.         if not(APage.Enabled or (csDesigning in ComponentState)) then
  4015.           Font.Color := clCaptionDarkText
  4016.         else begin
  4017.           if APage <> FSelectedPage then
  4018.             Font.Color := clCaptionLightText
  4019.           else
  4020.             Font.Color := clCaptionText
  4021.         end;
  4022.       end
  4023.       else begin
  4024.         if not(APage.Enabled or (csDesigning in ComponentState)) then
  4025.           Font.Color := clGrayText
  4026.         else begin
  4027.           if APage <> FSelectedPage then
  4028.             Font.Color := clMenuText
  4029.           else
  4030.             Font.Color := clSelectedBlue
  4031.         end;
  4032.       end;
  4033.     end;
  4034.  
  4035.     with ARect do
  4036.     begin
  4037.       Left   := Left   + FItemMargins.Left   - 1;
  4038.       Right  := Right  - FItemMargins.Right  + 1;
  4039.       Top    := Top    + FItemMargins.Top    - 1;
  4040.       Bottom := Bottom - FItemMargins.Bottom + 1;
  4041.     end;
  4042.  
  4043.     if APage.FFullVisible then
  4044.       Flags := DT_SINGLELINE or DT_CENTER or DT_END_ELLIPSIS or DT_VCENTER
  4045.     else
  4046.       Flags := DT_SINGLELINE or DT_END_ELLIPSIS or DT_VCENTER;
  4047.     SetBkMode(Handle, TRANSPARENT);
  4048.  
  4049.     AText := APage.Caption;
  4050.     if Assigned(Images) then Dec(ARect.Bottom);
  4051.     if Assigned(Images) and (APage.ImageIndex > -1) and (Images.Width < ARect.Right-ARect.Left) then
  4052.     begin
  4053.       if AActivePage then
  4054.         AText := Format('/im{%d}/ow{5}%s', [APage.ImageIndex, AText])
  4055.       else begin
  4056.         if APage.Enabled or (csDesigning in ComponentState) then
  4057.           AText := Format('/id{%d,33}/ow{5}%s', [APage.ImageIndex, AText])
  4058.         else
  4059.           AText := Format('/id{%d,70}/ow{5}%s', [APage.ImageIndex, AText]);
  4060.       end;
  4061.       DrawHighlightText(ACanvas, PChar(AText), ARect, 1, Flags, Images);
  4062.     end
  4063.     else
  4064.       DrawText(Handle, PChar(APage.Caption), Length(APage.Caption), ARect, Flags);
  4065.   end;
  4066. end;
  4067.  
  4068. procedure TDCPageControl.ClearSelection;
  4069.  var
  4070.   Page: TDCCustomPage;
  4071. begin
  4072.   if not(csDesigning in ComponentState) and (FSelectedPage <> nil) then
  4073.   begin
  4074.     Page := FSelectedPage;
  4075.     FSelectedPage := nil;
  4076.     DrawTabText(Canvas, Page.FTabRect, FPages.VisibleIndexOf(Page.PageIndex),
  4077.       Page, ActivePage.PageIndex = Page.PageIndex);
  4078.   end;
  4079. end;
  4080.  
  4081. procedure TDCPageControl.MouseMove(Shift: TShiftState; X, Y: Integer);
  4082.  var
  4083.   i: integer;
  4084.   Page, APage: TDCCustomPage;
  4085. begin
  4086.   if not(csDesigning in ComponentState) and TabVisible then
  4087.   begin
  4088.     for i := 0 to FPages.VisibleCount-1 do
  4089.     begin
  4090.       Page := FPages.Items[Integer(FPages.FVisibleList.Items[i]^)];
  4091.       if PtInRect(Page.FTabRect, Point(X, Y)) then
  4092.       begin
  4093.         APage := FSelectedPage;
  4094.         FSelectedPage := Page;
  4095.         if APage <> Page then
  4096.         begin
  4097.           if APage <> nil then
  4098.             DrawTabText(Canvas, APage.FTabRect, i, APage, ActivePage.PageIndex = APage.PageIndex);
  4099.           DrawTabText(Canvas, Page.FTabRect, i, Page, ActivePage.PageIndex = Page.PageIndex);
  4100.         end;
  4101.         Exit;
  4102.       end;
  4103.     end;
  4104.     ClearSelection;
  4105.   end;
  4106.   inherited;
  4107. end;
  4108.  
  4109. procedure TDCPageControl.UpdateFirstIndex;
  4110.  var
  4111.   Page: TDCCustomPage;
  4112.   VisibleIndex: integer;
  4113. begin
  4114.   FFirstIndex  := -1;
  4115.   VisibleIndex := -1;
  4116.   if ActivePage <> nil then
  4117.   begin
  4118.     Page := ActivePage;
  4119.     if (csDesigning in ComponentState) then
  4120.       VisibleIndex := Page.PageIndex
  4121.     else
  4122.       if Page.IsPageVisible then VisibleIndex := FPages.VisibleIndexOf(Page.PageIndex);
  4123.     repeat
  4124.       Inc(FFirstIndex);
  4125.       UpdateTabsRect;
  4126.     until not IsRectEmpty(Page.FTabRect) and Page.FFullVisible or
  4127.      (FFirstIndex >= VisibleIndex);
  4128.  end;
  4129. end;
  4130.  
  4131. procedure TDCPageControl.ChangeActivePage(Page: TDCCustomPage);
  4132.  var
  4133.   ParentForm: TCustomForm;
  4134. begin
  4135.   FChangedPage := ActivePage;
  4136.  
  4137.   FRedrawTabs  := (FChangedPage <> nil) and (FChangedPage.FFullVisible) and
  4138.    not IsRectEmpty(FChangedPage.FTabRect) and (Page <> nil) and
  4139.    (Page.FFullVisible) and not IsRectEmpty(Page.FTabRect);
  4140.  
  4141.   if FPageSelected and (ComponentState = []) and (Page <> nil) then
  4142.   begin
  4143.     ParentForm := GetParentForm(Self);
  4144.     if (ActivePage = Page) then
  4145.     begin
  4146.       if (ParentForm <> nil) and Page.Enabled and
  4147.          (ParentForm.ActiveControl <> Self) and Self.CanFocus then
  4148.       begin
  4149.         ParentForm.ActiveControl := Self;
  4150.         RedrawTab(ActivePage);
  4151.       end;
  4152.     end
  4153.     else if CanChange(Page) then
  4154.     begin
  4155.       if not Focused and (ParentForm <> nil) and
  4156.          FActivePage.ContainsControl(ParentForm.ActiveControl) then
  4157.         ParentForm.ActiveControl := ActivePage;
  4158.       inherited;
  4159.     end;
  4160.   end
  4161.   else
  4162.     inherited;
  4163. end;
  4164.  
  4165. procedure TDCPageControl.RedrawTab(Page: TDCCustomPage);
  4166.  var
  4167.   VisibleIndex: integer;
  4168.   ADefaultDraw, AActivePage: boolean;
  4169.   ARect: TRect;
  4170. begin
  4171.   ADefaultDraw := True;
  4172.   VisibleIndex := -1;
  4173.   if (csDesigning in ComponentState) then
  4174.     VisibleIndex := Page.PageIndex
  4175.   else
  4176.     if Page.IsPageVisible then VisibleIndex := FPages.VisibleIndexOf(Page.PageIndex);
  4177.   if VisibleIndex >= 0 then
  4178.   begin
  4179.     ARect := Page.FTabRect;
  4180.     DrawTab(Canvas, ARect, VisibleIndex, Page, ADefaultDraw, False);
  4181.     AActivePage := ActivePage.PageIndex = Page.PageIndex;
  4182.     DrawTabDiv(Canvas, ARect, AActivePage, Page.PageIndex = FFirstIndex);
  4183.   end;
  4184. end;
  4185.  
  4186. procedure TDCPageControl.WMKillFocus(var Message: TWMKillFocus);
  4187. begin
  4188.   inherited;
  4189.   PostMessage(Handle, CM_REDRAWTAB, Integer(ActivePage), 0);
  4190. end;
  4191.  
  4192. procedure TDCPageControl.CMRedrawTab(var Message: TMessage);
  4193. begin
  4194.   if FPageSelected then RedrawTab(TDCCustomPage(Message.WParam))
  4195. end;
  4196.  
  4197. procedure TDCPageControl.WMSetFocus(var Message: TWMSetFocus);
  4198. begin
  4199.   inherited;
  4200.   if not FTabVisible then Message.Result := 1
  4201.   else
  4202.     PostMessage(Handle, CM_REDRAWTAB, Integer(ActivePage), 0);
  4203. end;
  4204.  
  4205. procedure TDCPageControl.SetTabColor(const Value: TColor);
  4206. begin
  4207.   if FTabColor <> Value then
  4208.   begin
  4209.     FTabColor := Value;
  4210.     TabsChanged;
  4211.   end;
  4212. end;
  4213.  
  4214. procedure TDCPageControl.UpdatePage(Page: TDCCustomPage);
  4215. begin
  4216.   inherited;
  4217.   CheckToNextTrack;
  4218.   if not FNextTrack.Visible then CheckToPrevTrack;
  4219. end;
  4220.  
  4221. function TDCPageControl.GetItemSize(Page: TDCCustomPage): TPoint;
  4222.  var
  4223.   AText: string;
  4224.   ARect: TRect;
  4225. begin
  4226.   ARect := TabsRect;
  4227.   OffsetRect(ARect, -ARect.Left, -ARect.Top);
  4228.   if Assigned(Images) and (Page.ImageIndex > -1) then
  4229.   begin
  4230.     AText := Format('/im{%d}/ow{5}%s', [Page.ImageIndex, Page.Caption]);
  4231.     Result := DrawHighlightText(Canvas, PChar(AText), ARect, 0, DT_SINGLELINE, Images);
  4232.   end
  4233.   else begin
  4234.     Result.X := GetTextWidth(Canvas.Handle, Page.Caption);
  4235.     Result.Y := GetTextHeight(Canvas.Handle, Page.Caption);
  4236.   end;
  4237. end;
  4238.  
  4239. procedure TDCPageControl.DrawTabDiv(ACanvas: TCanvas; ARect: TRect;
  4240.   AActivePage, AFirst: boolean);
  4241. begin
  4242.   if FTabPosition in [tbBottom, tbTop] then
  4243.   begin
  4244.     ARect.Right := ARect.Left;
  4245.     ARect.Left  := ARect.Left - 1;
  4246.     InflateRect(ARect, 0, -1);
  4247.     if FTabPosition = tbBottom then
  4248.       ARect.Bottom  := ARect.Bottom + 1;
  4249.     with ACanvas do
  4250.     begin
  4251.       if not AActivePage then
  4252.       begin
  4253.         Brush.Color := FTabColor;
  4254.         FillRect(ARect);
  4255.         if AFirst then Exit;
  4256.         InflateRect(ARect, 0, -2);
  4257.         ARect.Bottom  := ARect.Bottom - 1;
  4258.         DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_LEFT or BF_FLAT);
  4259.       end
  4260.       else
  4261.         DrawEdge(Handle, ARect, BDR_RAISEDINNER, BF_LEFT);
  4262.     end;
  4263.   end;
  4264. end;
  4265.  
  4266. { TDCOutBar }
  4267.  
  4268. procedure TDCCustomOutBar.CMFontChanged(var Message: TMessage);
  4269. begin
  4270.   inherited;
  4271.   UpdateTabSize;
  4272. end;
  4273.  
  4274. function TDCCustomOutBar.ControlRect: TRect;
  4275. begin
  4276.   Result := ClientRect;
  4277.   InflateRect(Result, -1, -1);
  4278. end;
  4279.  
  4280. constructor TDCCustomOutBar.Create(AComponent: TComponent);
  4281. begin
  4282.   inherited;
  4283.   Width       := 80;
  4284.   FTabMargins := Rect(4, 4, 4, 4);
  4285.   Align       := alLeft;
  4286.   FMode       := omNormal;
  4287.   FBuffered   := False;
  4288. //  TabStop := False;
  4289.   FTextAlignment := taCenter;
  4290. end;
  4291.  
  4292. procedure TDCCustomOutBar.CreateWnd;
  4293. begin
  4294.   inherited;
  4295.   UpdateTabSize;
  4296. end;
  4297.  
  4298. procedure TDCCustomOutBar.DoDrawTab(ACanvas: TCanvas; ARect: TRect;
  4299.   AIndex: integer; APage: TDCCustomPage; AActivePage: boolean);
  4300. const
  4301.  Aligmnts: array[TAlignment] of WORD = (DT_LEFT, DT_RIGHT, DT_CENTER);
  4302.  var
  4303.   Flags: Longint;
  4304.   AText: string;
  4305.   APoint: TPoint;
  4306. begin
  4307.   inherited;
  4308.   with Canvas do
  4309.   begin
  4310.     Font := Self.Font;
  4311.     if APage.Enabled or (csDesigning in ComponentState) then
  4312.     begin
  4313.       Brush.Color := clBtnFace
  4314.     end
  4315.     else begin
  4316.       Font.Color  := clBtnShadow;
  4317.       Brush.Color := clBtnFace
  4318.     end;
  4319.     FillRect(ARect);
  4320.  
  4321.     DrawEdge(Canvas.Handle, ARect, BDR_RAISEDINNER, BF_RECT);
  4322.  
  4323.     with ARect do
  4324.     begin
  4325.       Left   := Left   + FTabMargins.Left   - 1;
  4326.       Right  := Right  - FTabMargins.Right  + 1;
  4327.       Top    := Top    + FTabMargins.Top    - 1;
  4328.       Bottom := Bottom - FTabMargins.Bottom + 1;
  4329.     end;
  4330.  
  4331.     Flags := DT_SINGLELINE or Aligmnts[FTextAlignment] or DT_END_ELLIPSIS;
  4332.  
  4333.     AText := APage.Caption;
  4334.     if Assigned(Images) and (APage.ImageIndex > -1) then
  4335.     begin
  4336.       if APage.Enabled or (csDesigning in ComponentState) then
  4337.         AText := Format('/im{%d}/ow{5}%s', [APage.ImageIndex, AText])
  4338.       else
  4339.         AText := Format('/id{%d}/ow{5}%s', [APage.ImageIndex, AText]);
  4340.       if FTextAlignment = taCenter then
  4341.       begin
  4342.         Flags := DT_SINGLELINE or DT_END_ELLIPSIS;
  4343.         APoint := DrawHighlightText(Canvas, PChar(AText), ARect, 0, Flags, Images);
  4344.         if APoint.X < (ARect.Right - ARect.Left) then
  4345.         begin
  4346.           OffsetRect(ARect, (ARect.Right - ARect.Left - APoint.X) div 2,0)
  4347.         end;
  4348.       end;
  4349.       DrawHighlightText(Canvas, PChar(AText), ARect, 1, Flags, Images);
  4350.     end
  4351.     else
  4352.       DrawText(Handle, PChar(APage.Caption), Length(APage.Caption), ARect, Flags)
  4353.   end;
  4354. end;
  4355.  
  4356. procedure TDCCustomOutBar.DrawBorder(ACanvas: TCanvas);
  4357.  var
  4358.   ARect: TRect;
  4359. begin
  4360.   if (FPages.VisibleCount > 0) or
  4361.      ((csDesigning in ComponentState) and (FPages.Count > 0)) then
  4362.   begin
  4363.  
  4364.     if FTabVisible then
  4365.       ARect := GetCurrentPageRect
  4366.     else begin
  4367.       ARect := ClientRect;
  4368.       InflateRect(ARect, -2, -2);
  4369.     end;
  4370.  
  4371.     InflateRect(ARect, 1, 1);
  4372.     with Canvas do
  4373.     begin
  4374.       Canvas.Brush.Color := Self.Color;
  4375.       FrameRect(ARect);
  4376.       if ActivePage.Color = clBtnShadow then
  4377.       begin
  4378.         DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_TOPLEFT);
  4379.       end
  4380.     end;
  4381.   end
  4382.   else begin
  4383.     ARect := ClientRect;
  4384.     Canvas.Brush.Color := Self.Color;
  4385.     Canvas.FillRect(ARect);
  4386.   end;
  4387.  
  4388.   ARect := ClientRect;
  4389.   DrawEdge(Canvas.Handle, ARect, BDR_SUNKENOUTER, BF_RECT or BF_ADJUST);
  4390.   DrawEdge(Canvas.Handle, ARect, BDR_SUNKENINNER, BF_BOTTOMRIGHT);
  4391. end;
  4392.  
  4393. procedure TDCCustomOutBar.DrawTabsArea(ACanvas: TCanvas);
  4394. begin
  4395.   inherited;
  4396. end;
  4397.  
  4398. function TDCCustomOutBar.GetCurrentPageRect: TRect;
  4399.  var
  4400.   AIndex, AVisibleCount: integer;
  4401.   PageOffset: TPoint;
  4402. begin
  4403.   Result := ControlRect;
  4404.  
  4405.   InflateRect(Result, -1, -1);
  4406.   try
  4407.     if (ActivePage <> nil) and (ActivePage.PageControl <> nil) then
  4408.     begin
  4409.       if csDesigning in ComponentState then
  4410.       begin
  4411.         AIndex := ActivePage.PageIndex;
  4412.         AVisibleCount := FPages.Count;
  4413.       end
  4414.       else begin
  4415.         AIndex := FPages.VisibleIndexOf(ActivePage.PageIndex);
  4416.         AVisibleCount := FPages.VisibleCount;
  4417.       end;
  4418.       if (AIndex > -1) then
  4419.       begin
  4420.         PageOffset.X := (AIndex + 1) * FTabHeight;
  4421.         PageOffset.Y := (AVisibleCount - AIndex - 1) * FTabHeight;
  4422.         Result.Top   := Result.Top + PageOffset.X;
  4423.         Result.Bottom:= Result.Bottom - PageOffset.Y;
  4424.       end;
  4425.     end;
  4426.   except
  4427.     //
  4428.   end;
  4429. end;
  4430.  
  4431. function TDCCustomOutBar.GetTabRect(AIndex: integer; Page: TDCCustomPage;
  4432.   var ARect: TRect): TRect;
  4433.  var
  4434.   PIndex, PVisibleCount : integer;
  4435.   PageOffset: TPoint;
  4436.   PRect: TRect;
  4437. begin
  4438.   SetRectEmpty(Result);
  4439.   PRect  := ControlRect;
  4440.   if ActivePage <> nil then
  4441.   begin
  4442.     if csDesigning in ComponentState then
  4443.     begin
  4444.       PIndex := ActivePage.PageIndex;
  4445.       PVisibleCount := FPages.Count;
  4446.     end
  4447.     else begin
  4448.       PIndex := FPages.VisibleIndexOf(ActivePage.PageIndex);
  4449.       PVisibleCount := FPages.VisibleCount;
  4450.     end;
  4451.     if PIndex > -1 then
  4452.     begin
  4453.       if AIndex <= PIndex then
  4454.         PageOffset.X := AIndex * FTabHeight
  4455.       else
  4456.         PageOffset.X := PRect.Bottom - (PVisibleCount - AIndex) * FTabHeight - 1;
  4457.  
  4458.       Result.Left  := PRect.Left;
  4459.       Result.Top   := PRect.Top   + PageOffset.X;
  4460.       Result.Right := PRect.Right;
  4461.       Result.Bottom:= Result.Top  + FTabHeight;
  4462.     end;
  4463.   end;
  4464. end;
  4465.  
  4466. function TDCCustomOutBar.GetTabsRect: TRect;
  4467. begin
  4468.   Result := ControlRect;
  4469. end;
  4470.  
  4471. procedure TDCCustomOutBar.Loaded;
  4472. begin
  4473.   inherited;
  4474.   Realign;
  4475. end;
  4476.  
  4477. procedure TDCCustomOutBar.Paint;
  4478. begin
  4479.   inherited;
  4480. end;
  4481.  
  4482. procedure TDCCustomOutBar.SetTabHeight(const Value: integer);
  4483. begin
  4484.   if FTabSize.Y <> Value then
  4485.   begin
  4486.     if Value >= 0 then FTabSize.Y := Value;
  4487.     UpdateTabSize;
  4488.   end;
  4489. end;
  4490.  
  4491. procedure TDCCustomOutBar.SetTextAlignment(const Value: TAlignment);
  4492. begin
  4493.   if FTextAlignment <> Value then
  4494.   begin;
  4495.     FTextAlignment := Value;
  4496.     invalidate;
  4497.   end;
  4498. end;
  4499.  
  4500. procedure TDCCustomOutBar.TabsChanged;
  4501. begin
  4502.   inherited;
  4503. end;
  4504.  
  4505. procedure TDCCustomOutBar.UpdateTabSize;
  4506. begin
  4507.   if HandleAllocated then
  4508.   begin
  4509.     Canvas.Font := Self.Font;
  4510.     FItemHeight := GetTextHeight(Canvas.Handle, 'Wg');
  4511.     if Assigned(Images) and (Images.Height > FItemHeight) then
  4512.       FItemHeight := Images.Height;
  4513.  
  4514.     if FTabSize.Y > 0 then
  4515.       FTabHeight := FTabSize.Y
  4516.     else
  4517.       with FTabMargins do
  4518.         FTabHeight := FItemHeight + Top + Bottom;
  4519.  
  4520.     TabsChanged;
  4521.   end;
  4522. end;
  4523.  
  4524. procedure TDCCustomOutBar.WMMouseMove(var Message: TWMMouseMove);
  4525.  var
  4526.   Page: TDCCustomPage;
  4527. begin
  4528.   if FMode = omMoveItem then
  4529.   begin
  4530.     KillTimer(Handle, OBMTIMER_IDEVENT);
  4531.     Page := GetPageAt(Message.Pos.X, Message.Pos.Y);
  4532.     if Page <> nil then SetTimer(Handle, OBMTIMER_IDEVENT, 500, nil);
  4533.   end;
  4534.   inherited;
  4535. end;
  4536.  
  4537. procedure TDCCustomOutBar.WMSize(var Message: TWMSize);
  4538. begin
  4539.   inherited;
  4540.   UpdateTabsRect;
  4541. end;
  4542.  
  4543. procedure TDCCustomOutBar.WMTimer(var Message: TWMTimer);
  4544.  var
  4545.   Page: TDCCustomPage;
  4546.   Pos: TPoint;
  4547. begin
  4548.   inherited;
  4549.   if (FMode = omMoveItem) and (Message.TimerID = OBMTIMER_IDEVENT) then
  4550.   begin
  4551.     GetCursorPos(Pos);
  4552.     Pos := ScreenToClient(Pos);
  4553.     Page := GetPageAt(Pos.X, Pos.Y);
  4554.     if Page <> nil then SetActivePage(Page);
  4555.   end;
  4556. end;
  4557.  
  4558. { TDCPaleteBarPanel }
  4559.  
  4560. function TDCPaleteBarPanel.AddButton: TDCEditButton;
  4561. begin
  4562.   Result := inherited AddButton;
  4563.   if Result <> nil then
  4564.   begin
  4565.     Result.DrawText := FDrawText;
  4566.     if FDrawText then Result.Allignment := abImageTop;
  4567.     if FIconStyle then
  4568.     begin
  4569.       Result.Style    := stIcon;
  4570.       Result.DownClick:= False;
  4571.     end
  4572.     else begin
  4573.       Result.Style    := stOutbar;
  4574.       Result.DownClick:= True;
  4575.     end;
  4576.   end;
  4577. end;
  4578.  
  4579. function TDCPaleteBarPanel.ButtonVisible(Button: TDCEditButton): boolean;
  4580. begin
  4581.   with Button do Result := (Left + Width) <= (Self.Width - FNextTrack.Width -2);
  4582. end;
  4583.  
  4584. procedure TDCPaleteBarPanel.Click;
  4585. begin
  4586.   if PageControl <> nil then PageControl.Click;
  4587. end;
  4588.  
  4589. procedure TDCPaleteBarPanel.CMColorChanged(var Message: TMessage);
  4590. begin
  4591.   inherited;
  4592.   FPrevTrack.BrushColor := Color;
  4593.   FNextTrack.BrushColor := Color;
  4594. end;
  4595.  
  4596. procedure TDCPaleteBarPanel.CMHintShow(var Message: TCMHintShow);
  4597.  var
  4598.   AHintPos: TPoint;
  4599. begin
  4600.   if FHintObject <> nil then
  4601.   begin
  4602.     with Message, TDCEditButton(FHintObject) do
  4603.     begin
  4604.       HintInfo.HintStr := Hint;
  4605.       HintInfo.ReshowTimeout := 1000;
  4606.       AHintPos := Point(Left, Top + Height + 1);
  4607.       AHintPos := ClientToScreen(AHintPos);
  4608.       HintInfo.HintPos := AHintPos;
  4609.       Result := 0;
  4610.     end;
  4611.   end
  4612.   else
  4613.    inherited;
  4614. end;
  4615.  
  4616. constructor TDCPaleteBarPanel.Create(AOwner: TComponent);
  4617. begin
  4618.   inherited;
  4619.   ControlStyle := ControlStyle - [csAcceptsControls];
  4620.   FStyle   := isSmallImages;
  4621.   FOptions := [opDropDown];
  4622.   FAnchorStyle := asNone;
  4623.   FIconStyle   := False;
  4624.   BorderWidth  := 0;
  4625. end;
  4626.  
  4627. procedure TDCPaleteBarPanel.CreateTracks;
  4628. begin
  4629.   inherited;
  4630.   with FPrevTrack do
  4631.   begin
  4632.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNLEFT');
  4633.     Style := stShadowFlat;
  4634.     Top   := 2;
  4635.   end;
  4636.   with FNextTrack do
  4637.   begin
  4638.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNRIGHT');
  4639.     Style := stShadowFlat;
  4640.     Top   := 2;
  4641.   end;
  4642. end;
  4643.  
  4644. procedure TDCPaleteBarPanel.DblClick;
  4645. begin
  4646.   if PageControl <> nil then PageControl.DblClick;
  4647. end;
  4648.  
  4649. function TDCPaleteBarPanel.GetImages: TImageList;
  4650. begin
  4651.   Result := SmallImages;
  4652. end;
  4653.  
  4654. procedure TDCPaleteBarPanel.ItemClick(Sender: TObject);
  4655.  var
  4656.   Button: TDCEditButton;
  4657.   ParentForm: TCustomForm;
  4658. begin
  4659.   if Parent is TDCPaleteBar then
  4660.     Button := TDCPaleteBar(Parent).FButtons.FindButton('$Cancel$')
  4661.   else
  4662.     Button :=  nil;
  4663.  
  4664.   ParentForm := GetParentForm(Self);
  4665.   if FIconStyle and Assigned(Button) and (ParentForm <> nil) then
  4666.   begin
  4667.     ParentForm.ActiveControl := Self;
  4668.   end;
  4669.  
  4670.   if Assigned(Button) and (Button.ButtonState = btDownMouseInRect) then
  4671.   begin
  4672.     Button.ResetProperties;
  4673.     Button.Invalidate;
  4674.   end;
  4675.  
  4676.   inherited;
  4677. end;
  4678.  
  4679. procedure TDCPaleteBarPanel.Loaded;
  4680.  var
  4681.   i: integer;
  4682. begin
  4683.   inherited;
  4684.   for i:= 0 to Items.Count-1 do
  4685.   begin
  4686.     Items.Buttons[i].DrawText := FDrawText;
  4687.     if FDrawText then Items.Buttons[i].Allignment := abImageTop else
  4688.       Items.Buttons[i].Allignment := abLeft;
  4689.     if FIconStyle then
  4690.     begin
  4691.       Items.Buttons[i].Style    := stIcon;
  4692.       Items.Buttons[i].DownClick:= False;
  4693.     end
  4694.     else begin
  4695.       Items.Buttons[i].Style    := stOutbar;
  4696.       Items.Buttons[i].DownClick:= True;
  4697.     end;
  4698.   end;
  4699.   UpdateButtonsPos;
  4700. end;
  4701.  
  4702. procedure TDCPaleteBarPanel.SetButtonPos(Index: integer);
  4703.  var
  4704.   TextSize, Pos: TPoint;
  4705.   Button: TDCEditButton;
  4706.   AHeight: integer;
  4707. begin
  4708.   Button := Buttons.Buttons[Index];
  4709.   Pos.X  := 2 + FPrevTrack.Left + FPrevTrack.Width;
  4710.  
  4711.   case FStyle of
  4712.    isLargeImages:
  4713.      begin
  4714.        AHeight := Button.GetGlyphHeight + TextSize.Y + 6;
  4715.        if FDrawText then AHeight := AHeight + Button.TextSize.Y + 2;
  4716.      end;
  4717.    isSmallImages:
  4718.      begin
  4719.        AHeight := Button.GetGlyphHeight + 8;
  4720.        if FDrawText then AHeight := AHeight + Button.TextSize.Y + 2;
  4721.      end;
  4722.    else
  4723.      AHeight := 0;
  4724.   end;
  4725.  
  4726.   Pos.Y := 5;
  4727.   if (PageControl <> nil) and not PageControl.TabVisible then Dec(Pos.Y, 2);
  4728.  
  4729.   Button.Left  := Pos.X;
  4730.   Button.Top   := Pos.Y;
  4731.   Button.Height:= AHeight;
  4732.   if FDrawText then
  4733.     Button.Width := _intMax(Button.GetGlyphHeight, Button.TextSize.X) + 8
  4734.   else
  4735.     Button.Width := Button.GetGlyphHeight + 8;
  4736.  
  4737.   if Index < FFirstIndex then
  4738.   begin
  4739.     Button.Left   := Pos.X;
  4740.     Button.Top    := 0;
  4741.     Button.Height := 0;
  4742.     Button.Width  := 0;
  4743.     if not FPrevTrack.Visible then FPrevTrack.Visible := True;
  4744.   end
  4745.   else begin
  4746.     Button.Visible := True;
  4747.     if (Index > 0) then
  4748.     begin
  4749.       with Buttons.Buttons[Index-1] do
  4750.       begin
  4751.         if FDrawText then
  4752.           Button.Left := (Left + Width) + 8
  4753.         else
  4754.           Button.Left := (Left + Width);
  4755.       end;
  4756.       if Button.Left + Button.Width > FNextTrack.Left then Button.Visible := False;
  4757.     end;
  4758.   end;
  4759. end;
  4760.  
  4761. procedure TDCPaleteBarPanel.SetDrawText(const Value: boolean);
  4762.  var
  4763.   i: integer;
  4764. begin
  4765.   FDrawText := Value;
  4766.   for i:= 0 to Items.Count-1 do
  4767.   begin
  4768.     Items.Buttons[i].DrawText := FDrawText;
  4769.     if FDrawText then Items.Buttons[i].Allignment := abImageTop else
  4770.       Items.Buttons[i].Allignment := abLeft;
  4771.   end;
  4772.   UpdateButtonsPos;
  4773.   UpdateTracksPos;
  4774. end;
  4775.  
  4776. procedure TDCPaleteBarPanel.SetIconStyle(const Value: boolean);
  4777.  var
  4778.   i: integer;
  4779. begin
  4780.   FIconStyle := Value;
  4781.   for i:= 0 to Items.Count-1 do
  4782.   begin
  4783.     if Value then
  4784.     begin
  4785.       Items.Buttons[i].Style    := stIcon;
  4786.       Items.Buttons[i].DownClick:= False;
  4787.     end
  4788.     else begin
  4789.       Items.Buttons[i].Style    := stOutbar;
  4790.       Items.Buttons[i].DownClick:= True;
  4791.     end;
  4792.     UpdateButtonsPos;
  4793.     UpdateTracksPos;
  4794.   end;
  4795. end;
  4796.  
  4797. procedure TDCPaleteBarPanel.SetImages(const Value: TImageList);
  4798. begin
  4799.   SmallImages := Value;
  4800. end;
  4801.  
  4802. function TDCPaleteBarPanel.TracksCovering: boolean;
  4803. begin
  4804.   if FPrevTrack.Visible and
  4805.     (FNextTrack.Left < (FPrevTrack.Left + FPrevTrack.Width)) then
  4806.     Result := True
  4807.   else
  4808.     Result := False;
  4809. end;
  4810.  
  4811. procedure TDCPaleteBarPanel.UpdateButtonsVisible;
  4812.  var
  4813.   i: integer;
  4814.   Button: TDCEditButton;
  4815. begin
  4816.   with Buttons do
  4817.     if Count > 0 then
  4818.     begin
  4819.       for i := 0 to Count-1 do
  4820.       begin
  4821.         Button := Buttons[i];
  4822.         Button.Visible := ButtonVisible(Button);
  4823.       end;
  4824.       CheckToNextTrack;
  4825.    end;
  4826. end;
  4827.  
  4828. procedure TDCPaleteBarPanel.UpdateTracksPos;
  4829.  var
  4830.   lVisible: boolean;
  4831. begin
  4832.   lVisible := False;
  4833.   with FPrevTrack do
  4834.   begin
  4835.     if Visible then
  4836.     begin
  4837.       Visible := False; lVisible := True;
  4838.     end;
  4839.     Left   :=  ClientRect.Left + 1;
  4840.     Top    :=  ClientRect.Top  + 2;
  4841.     Width  :=  13;
  4842.     if Assigned(Buttons.Images) then Height := Buttons.Images.Height + 8;
  4843.     if lVisible then
  4844.     begin
  4845.       Visible := True; lVisible := False;
  4846.     end;
  4847.   end;
  4848.  
  4849.   with FNextTrack do
  4850.   begin
  4851.     if Visible then
  4852.     begin
  4853.       Visible := False; lVisible := True;
  4854.     end;
  4855.     Left   :=  ClientRect.Right - 15;
  4856.     Top    :=  ClientRect.Top   + 2;
  4857.     Width  :=  13;
  4858.     if Assigned(Buttons.Images) then  Height :=  Buttons.Images.Height + 8;
  4859.     if lVisible and not TracksCovering then Visible := True;
  4860.   end;
  4861. end;
  4862.  
  4863. procedure TDCPaleteBarPanel.WMLButtonDown(var Message: TWMLButtonDown);
  4864.  var
  4865.   ParentForm: TCustomForm;
  4866. begin
  4867.   inherited;
  4868.   ParentForm := GetParentForm(Self);
  4869.   if FIconStyle and (ParentForm <> nil) then
  4870.   begin
  4871.     ParentForm.ActiveControl := Self;
  4872.   end;
  4873. end;
  4874.  
  4875. procedure TDCPaleteBarPanel.WMSize(var Message: TWMSize);
  4876. begin
  4877.   inherited;
  4878.   UpdateButtonsVisible;
  4879. end;
  4880.  
  4881. { TDCPaleteBar }
  4882.  
  4883. procedure TDCPaleteBar.AddCancelButton;
  4884. begin
  4885.   with FButtons, FButtons.AddButton do
  4886.   begin
  4887.     Name := '$Cancel$';
  4888.     Allignment := abCenter;
  4889.     Glyph.LoadFromResourceName(HInstance, 'DC_BTNARROW');
  4890.     Font  := Self.Font;
  4891.     SetCancelButtonBounds;
  4892.     Style := stOutBar;
  4893.     AbsolutePos  := False;
  4894.     EventStyle   := esDropDown;
  4895.     DisableStyle := deNormal;
  4896.     BrushColor   := Color;
  4897.     AnchorStyle  := asNone;
  4898.     OnClick      := CancelButtonClick;
  4899.     OnSetButtonState := SetButtonState;
  4900.     DrawText := False;
  4901.     Visible  := FCancelExist;
  4902.   end;
  4903. end;
  4904.  
  4905. procedure TDCPaleteBar.AdjustClientRect(var Rect: TRect);
  4906.  var
  4907.   Button: TDCEditButton;
  4908. begin
  4909.   inherited AdjustClientRect(Rect);
  4910.   if FCancelExist then
  4911.   begin
  4912.     Button := FButtons.FindButton('$Cancel$');
  4913.     if Assigned(Button) then Rect.Left := Rect.Left + Button.Width + 5;
  4914.   end;
  4915. end;
  4916.  
  4917. procedure TDCPaleteBar.Cancel;
  4918. begin
  4919.   CancelButtonClick(Self)
  4920. end;
  4921.  
  4922. procedure TDCPaleteBar.CancelButtonClick(Sender: TObject);
  4923.  var
  4924.   Button: TDCEditButton;
  4925. begin
  4926.   if CancelExist then
  4927.   begin
  4928.     Button := FButtons.FindButton('$Cancel$');
  4929.     if (ActivePage <> nil) and (ActivePage is TDCCustomOutBarPanel) then
  4930.       TDCCustomOutBarPanel(ActivePage).ActiveButton := nil;
  4931.     if Button.ButtonState <> btDownMouseInRect then
  4932.     begin
  4933.       Button.UpdateButtonState(Button.Left + 1, Button.Top + 1, True, False);
  4934.       Click;
  4935.     end
  4936.     else
  4937.       if not(csLoading in ComponentState) and Assigned(FOnCancel) then FOnCancel(Self)
  4938.   end;
  4939. end;
  4940.  
  4941. procedure TDCPaleteBar.CMColorChanged(var Message: TMessage);
  4942. begin
  4943.   inherited;
  4944.   FButtons.Color := Self.Color;
  4945. end;
  4946.  
  4947. procedure TDCPaleteBar.CMMouseEnter(var Message: TMessage);
  4948. begin
  4949.   inherited;
  4950.   FButtons.MouseDown := GetAsyncKeyState(VK_LBUTTON)<0;
  4951. end;
  4952.  
  4953. procedure TDCPaleteBar.CMMouseLeave(var Message: TMessage);
  4954. begin
  4955.   inherited;
  4956.   FButtons.UpdateButtons( -1, -1, False, True);
  4957. end;
  4958.  
  4959. constructor TDCPaleteBar.Create(AComponent: TComponent);
  4960. begin
  4961.   inherited;
  4962.   ControlStyle := ControlStyle - [csAcceptsControls];
  4963.   FButtons := TDCEditButtons.Create(Self);
  4964.   FTabMargins  := Rect(4, 6, 4, 4);
  4965.   FItemMargins := Rect(5, 3, 5, 3);
  4966.   FCancelExist := False;
  4967.  
  4968.   FTabMargins.Left  := FTabMargins.Left  + FPrevTrack.Width + 2;
  4969.   FTabMargins.Right := FTabMargins.Right + FNextTrack.Width + 6;
  4970.  
  4971.   FCancelSize := 0;
  4972.   FPageSelected := False;
  4973. end;
  4974.  
  4975. procedure TDCPaleteBar.CreateWnd;
  4976. begin
  4977.   inherited;
  4978.   if Parent <> nil then begin
  4979.     FButtons.ClrWndProc;
  4980.     FButtons.SetWndProc;
  4981.     AddCancelButton;
  4982.   end;
  4983. end;
  4984.  
  4985. destructor TDCPaleteBar.Destroy;
  4986. begin
  4987.   FButtons.Free;
  4988.   inherited;
  4989. end;
  4990.  
  4991. function TDCPaleteBar.GetCurrentPageRect: TRect;
  4992. begin
  4993.   Result := inherited GetCurrentPageRect;
  4994. end;
  4995.  
  4996. function TDCPaleteBar.GetSelectedItem: TDCEditButton;
  4997. begin
  4998.   Result :=  nil;
  4999.   if (ActivePage <> nil) and (ActivePage is TDCPaleteBarPanel) then
  5000.     Result := TDCPaleteBarPanel(ActivePage).Buttons.SelectedButton;
  5001. end;
  5002.  
  5003. procedure TDCPaleteBar.ImageListChange(Sender: TObject);
  5004. begin
  5005.   inherited;
  5006.   SetCancelButtonBounds;
  5007.   if ActivePage <> nil then ActivePage.AdjustSize;
  5008. end;
  5009.  
  5010. procedure TDCPaleteBar.InsertPage(Page: TDCCustomPage);
  5011. begin
  5012.   inherited;
  5013.   if Page is TDCPaleteBarPanel then
  5014.   begin
  5015.     TDCPaleteBarPanel(Page).Images := Images;
  5016.   end;
  5017. end;
  5018.  
  5019. procedure TDCPaleteBar.RemovePage(Page: TDCCustomPage);
  5020.  var
  5021.   Button: TDCEditButton;
  5022. begin
  5023.   inherited;
  5024.   if PageCount = 0 then
  5025.   begin
  5026.     Button := FButtons.FindButton('$Cancel$');
  5027.     if Assigned(Button) and (Button.ButtonState = btDownMouseInRect) then
  5028.     begin
  5029.       Button.ResetProperties;
  5030.       Button.Invalidate;
  5031.     end;
  5032.   end;
  5033. end;
  5034.  
  5035. procedure TDCPaleteBar.RepaintFreeArea;
  5036.  var
  5037.   ARect, BRect: TRect;
  5038.   ARgn, BRgn: HRGN;
  5039.   AResult: integer;
  5040. begin
  5041.   BRect := ClientRect;
  5042.   AdjustClientRect(ARect);
  5043.   InflateRect(ARect, -2, -2);
  5044.  
  5045.   ARgn := CreateRectRgn(ARect.Left, ARect.Top, ARect.Right, ARect.Bottom);
  5046.   BRgn := CreateRectRgn(BRect.Left, BRect.Top, BRect.Right, BRect.Bottom);
  5047.   try
  5048.     AResult :=  CombineRgn(ARgn, BRgn, ARgn, RGN_DIFF);
  5049.     if AResult <> NULLREGION then
  5050.     begin
  5051.       Canvas.Brush.Color := Self.Color;
  5052.       FillRgn(Canvas.Handle, ARgn, Canvas.Brush.Handle)
  5053.     end;
  5054.   finally
  5055.     DeleteObject(ARgn);
  5056.     DeleteObject(BRgn);
  5057.   end;
  5058. end;
  5059.  
  5060. procedure TDCPaleteBar.SetActivePage(const Value: TDCCustomPage);
  5061. begin
  5062.   inherited;
  5063.   if (ActivePage = Value) and FCancelExist then Cancel;
  5064. end;
  5065.  
  5066. procedure TDCPaleteBar.SetButtonState(Sender: TObject;
  5067.   var State: TButtonState);
  5068.  var
  5069.   Button: TDCEditButton;
  5070. begin
  5071.   Button := FButtons.FindButton('$Cancel$');
  5072.   if Assigned(Button) then
  5073.   begin
  5074.     if (Sender = Button) and (Button.ButtonState = btDownMouseInRect) then
  5075.       State := btDownMouseInRect;
  5076.   end;
  5077. end;
  5078.  
  5079. procedure TDCPaleteBar.SetCancelButtonBounds(Repaint: boolean = True);
  5080.  var
  5081.   Button: TDCEditButton;
  5082.   Rect: TRect;
  5083. begin
  5084.   Button := FButtons.FindButton('$Cancel$');
  5085.   if Assigned(Button) then
  5086.   begin
  5087.     if TabVisible then
  5088.       Rect := GetTabsRect
  5089.     else
  5090.       Rect := ClientRect;
  5091.  
  5092.     with Button do
  5093.     begin
  5094.       Left := Rect.Left + 4;
  5095.       if (TabPosition = tbTop) and TabVisible then
  5096.         Top := Rect.Bottom + 4
  5097.       else begin
  5098.         Top := 4;
  5099.         if TabVisible then Top := Top + 2;
  5100.       end;
  5101.       if (Self.Images <> nil) and (FCancelSize = 0) then
  5102.       begin
  5103.         Width  := Self.Images.Width  + 8;
  5104.         Height := Self.Images.Height + 8;
  5105.       end
  5106.       else begin
  5107.         if FCancelSize = 0 then
  5108.         begin
  5109.           Width  := 24;
  5110.           Height := 24;
  5111.         end
  5112.         else begin
  5113.           Width  := FCancelSize;
  5114.           Height := FCancelSize;
  5115.         end;
  5116.       end;
  5117.     end
  5118.   end;
  5119.   Realign;
  5120.   if Repaint then RepaintFreeArea;
  5121. end;
  5122.  
  5123. procedure TDCPaleteBar.SetCancelExist(const Value: boolean);
  5124.  var
  5125.   Button: TDCEditButton;
  5126. begin
  5127.   if FCancelExist <> Value then
  5128.   begin
  5129.     Button := FButtons.FindButton('$Cancel$');
  5130.     FCancelExist := Value;
  5131.     if Assigned(Button) then Button.Visible := FCancelExist;
  5132.     if FCancelExist then Cancel;
  5133.     if ActivePage <> nil then
  5134.     begin
  5135.       ActivePage.AdjustSize;
  5136.       ActivePage.Invalidate;
  5137.     end
  5138.     else
  5139.       Repaint;
  5140.   end;
  5141. end;
  5142.  
  5143. procedure TDCPaleteBar.SetCancelSize(const Value: integer);
  5144. begin
  5145.   FCancelSize := Value;
  5146.   SetCancelButtonBounds(False);
  5147.   RepaintTabs;
  5148. end;
  5149.  
  5150. procedure TDCPaleteBar.SetImages(const Value: TImageList);
  5151.  var
  5152.   i: integer;
  5153.   Page: TDCPaleteBarPanel;
  5154. begin
  5155.   for i := 0 to PageCount - 1 do
  5156.   begin
  5157.     if (Pages[i] is TDCPaleteBarPanel) then
  5158.     begin
  5159.       Page := TDCPaleteBarPanel(Pages[i]);
  5160.       if Page.Images = Images then Page.Images := Value;
  5161.     end;
  5162.   end;
  5163.   inherited;
  5164.   SetCancelButtonBounds;
  5165. end;
  5166.  
  5167. procedure TDCPaleteBar.SetTabPosition(const Value: TLiteTabPosition);
  5168. begin
  5169.   if not(Value in [tbTop, tbBottom]) then Exit;
  5170.   inherited;
  5171.   SetCancelButtonBounds;
  5172. end;
  5173.  
  5174. procedure TDCPaleteBar.SetTabVisible(const Value: boolean);
  5175. begin
  5176.   inherited;
  5177.   SetCancelButtonBounds;
  5178. end;
  5179.  
  5180. procedure TDCPaleteBar.UpdateTabSize;
  5181. begin
  5182.   Canvas.Font := Self.Font;
  5183.   FItemHeight := GetTextHeight(Canvas.Handle, 'Wg') + 1;
  5184.   
  5185.   if FTabSize.Y > 0 then
  5186.     FTabHeight := FTabSize.Y
  5187.   else
  5188.     with FTabMargins do
  5189.       FTabHeight := FItemHeight + Top + Bottom;
  5190.  
  5191.   FPrevTrack.Height := FTabHeight - 4;
  5192.   FNextTrack.Height := FTabHeight - 4;
  5193.  
  5194.   TabsChanged;
  5195. end;
  5196.  
  5197. { TDCPage }
  5198.  
  5199. procedure TDCPage.CMBorderChanged(var Message: TMessage);
  5200. begin
  5201.   if csDesigning in ComponentState then
  5202.   begin
  5203.     invalidate;
  5204.   end;
  5205.   inherited;
  5206. end;
  5207.  
  5208. { TDCCustomBrushImage }
  5209.  
  5210. constructor TDCCustomBrushImage.Create;
  5211. begin
  5212.   inherited Create;
  5213.   FOwner := AOwner;
  5214.   FBitmap := TBitmap.Create;
  5215.   FImageChangeLink :=  TChangeLink.Create;
  5216.   FImageChangeLink.OnChange := DoChange;
  5217.   FImageIndex := -1;
  5218. end;
  5219.  
  5220. destructor TDCCustomBrushImage.Destroy;
  5221. begin
  5222.   FBitmap.Free;
  5223.   inherited;
  5224. end;
  5225.  
  5226. procedure TDCCustomBrushImage.DoChange(Sender: TObject);
  5227. begin
  5228.   ProcessPaintMessages;
  5229.   if Assigned(OnChange) then FOnChange(Self);
  5230. end;
  5231.  
  5232. procedure TDCCustomBrushImage.Draw(ACanvas: TCanvas; ARect: TRect);
  5233.  var
  5234.   ABitmap: TBitmap;
  5235. begin
  5236.   if not FBitmap.Empty then
  5237.   begin
  5238.     ACanvas.Brush.Bitmap := FBitmap;
  5239.     ACanvas.FillRect(ARect);
  5240.   end
  5241.   else begin
  5242.     if Assigned(FImages) and (FImageIndex <> -1) and (FImageIndex < FImages.Count) then
  5243.     begin
  5244.       ABitmap := TBitmap.Create;
  5245.       try
  5246.         FImages.GetBitmap(FImageIndex, ABitmap);
  5247.         ACanvas.Brush.Bitmap := ABitmap;
  5248.         ACanvas.FillRect(ARect);
  5249.         ACanvas.Brush.Bitmap := nil;
  5250.       finally
  5251.         ABitmap.Free;
  5252.       end;
  5253.     end
  5254.     else
  5255.       ACanvas.FillRect(ARect);
  5256.   end;
  5257. end;
  5258.  
  5259. function TDCCustomBrushImage.Empty: boolean;
  5260. begin
  5261.   Result := Bitmap.Empty and ((FImageIndex = -1) or not Assigned(FImages));
  5262. end;
  5263.  
  5264. procedure TDCCustomBrushImage.SetBitmap(const Value: TBitmap);
  5265. begin
  5266.   FBitmap.Assign(Value);
  5267.   DoChange(Self);
  5268. end;
  5269.  
  5270. procedure TDCCustomBrushImage.SetImageIndex(const Value: integer);
  5271. begin
  5272.   FImageIndex := Value;
  5273.   DoChange(Self);
  5274. end;
  5275.  
  5276. procedure TDCCustomBrushImage.SetImages(const Value: TImageList);
  5277. begin
  5278.   if FImages <> nil then
  5279.     FImages.UnRegisterChanges(FImageChangeLink);
  5280.   FImages := Value;
  5281.   if FImages <> nil then
  5282.   begin
  5283.     FImages.RegisterChanges(FImageChangeLink);
  5284.     FImages.FreeNotification(FOwner);
  5285.   end;
  5286.   DoChange(Self);
  5287. end;
  5288.  
  5289. end.
  5290.