tb97.pas

企业智能(ERP)管理系统

unit TB97;

{

  Toolbar97 version 1.68
  Copyright (C) 1998 by Jordan Russell

  e-mail:     [e-mail]
  home page:  http://www.connect.net/jordanr/
              (alternate address: http://www.digicron.com/jordanr/)

  *PLEASE NOTE*  Before making any bug reports please first verify you are
                 using the latest version by checking my home page. And if
                 you do report a bug, please, if applicable, include a code
                 sample.

  You are free to use Toolbar97 in compiled form for any purpose. However,
  use in commercial or shareware applications requires registration. The
  Toolbar97 source code or DCU, in whole or in part, modified or unmodified,
  may not be redistributed for profit or as part of another commercial or
  shareware software package without express written permission from me.

  This code is distributed "as is" without any warranties, express or implied.

  Notes:
  - I cannot support modified versions of this code. So if you encounter a
    possible bug while using a modified version, always first revert back to
    the my original code before making an attempt to contact me.
  - While debugging the toolbar code you might want to enable the
    'TB97DisableLock' conditional define, as described below.
  - In the WM_NCPAINT handlers, GetWindowRect is used to work around a possible
    VCL problem. The Width, Height, and BoundsRect properties are sometimes
    wrong. So it avoids any use of these properties in the WM_NCPAINT handlers.
  - In case you are unsure of its meaning, NewStyleControls is a VCL variable
    set to True at application startup if the user is running Windows 95 or NT
    4.0 or later.
}

{x$DEFINE TB97DisableLock}
{ Remove the 'x' to enable the define. It will disable calls to
  LockWindowUpdate, which it calls to disable screen updates while dragging.
  You should temporarily enable that while debugging so you are able to see
  your code window if you have something like a breakpoint that's set inside
  the dragging routines }

{$I TB97Ver.inc}

interface

uses
  Windows, Messages, Classes, Controls, Forms, Graphics;

const
  Toolbar97Version = '1.68';

  WM_TB97PaintDockedNCArea = WM_USER + 5039;  { used internally }

type
  { TDock97 }

  TDockBoundLinesValues = (blTop, blBottom, blLeft, blRight);
  TDockBoundLines = set of TDockBoundLinesValues;
  TDockPosition = (dpTop, dpBottom, dpLeft, dpRight);
  TDockType = (dtNotDocked, dtTopBottom, dtLeftRight);
  TDockableTo = set of TDockPosition;

  TCustomToolWindow97 = class;

  TInsertRemoveEvent = procedure(Sender: TObject; Inserting: Boolean;
    Bar: TCustomToolWindow97) of object;
  TRequestDockEvent = procedure(Sender: TObject; Bar: TCustomToolWindow97;
    var Accept: Boolean) of object;

  TDock97 = class(TCustomControl)
  private
    { Property values }
    FPosition: TDockPosition;
    FAllowDrag: Boolean;
    FBoundLines: TDockBoundLines;
    FBkg, FBkgCache: TBitmap;
    FBkgTransparent, FBkgOnToolbars: Boolean;
    FFixAlign: Boolean;
    FLimitToOneRow: Boolean;
    FOnInsertRemoveBar: TInsertRemoveEvent;
    FOnRequestDock: TRequestDockEvent;
    FOnResize: TNotifyEvent;

    { Internal }
    FDisableArrangeToolbars: Integer; { Increment to disable ArrangeToolbars }
    FArrangeToolbarsNeeded: Boolean;
    DockList: TList;  { List of the visible toolbars docked. Items are casted in TCustomToolWindow97's.
                        But, at design time, all docked toolbars are here regardless of visibility }
    RowSizes: TList;  { List of the width or height of each row, depending on what Position is set to.
                        Items are casted info Longint's }

    { Property access methods }
    procedure SetAllowDrag (Value: Boolean);
    procedure SetBackground (Value: TBitmap);
    procedure SetBackgroundOnToolbars (Value: Boolean);
    procedure SetBackgroundTransparent (Value: Boolean);
    procedure SetBoundLines (Value: TDockBoundLines);
    procedure SetFixAlign (Value: Boolean);
    procedure SetPosition (Value: TDockPosition);

    function GetToolbarCount: Integer;
    function GetToolbars (Index: Integer): TCustomToolWindow97;

    { Internal }
    function GetRowOf (const XY: Integer; var Before: Boolean): Integer;
    function GetDesignModeRowOf (const XY: Integer): Integer;
    function GetHighestRow: Integer;
    function GetNumberOfToolbarsOnRow (const Row: Integer;
      const NotIncluding: TCustomToolWindow97): Integer;
    procedure RemoveBlankRows;
    procedure InsertRowBefore (const BeforeRow: Integer);
    procedure BuildRowInfo;
    procedure ChangeDockList (const Insert: Boolean; const Bar: TCustomToolWindow97;
      const IsVisible: Boolean);
    procedure ChangeWidthHeight (const IsClientWidthAndHeight: Boolean;
      NewWidth, NewHeight: Integer);
    procedure ArrangeToolbars;
    procedure DrawBackground (const DC: HDC;
      const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
      const DrawRect: TRect);
    procedure InvalidateBackgrounds;
    procedure BackgroundChanged (Sender: TObject);
    function UsingBackground: Boolean;

    { Messages }
    procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
    procedure CMSysColorChange (var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
  protected
    procedure AlignControls (AControl: TControl; var Rect: TRect); override;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure SetParent (AParent: TWinControl); override;
    procedure Paint; override;
  public
    constructor Create (AOwner: TComponent); override;
    procedure CreateParams (var Params: TCreateParams); override;
    destructor Destroy; override;

    procedure BeginUpdate;
    procedure EndUpdate;
    function GetRowSize (const Row: Integer;
      const DefaultToolbar: TCustomToolWindow97): Integer;

    property ToolbarCount: Integer read GetToolbarCount;
    property Toolbars[Index: Integer]: TCustomToolWindow97 read GetToolbars;
  published
    property AllowDrag: Boolean read FAllowDrag write SetAllowDrag default True;
    property Background: TBitmap read FBkg write SetBackground;
    property BackgroundOnToolbars: Boolean read FBkgOnToolbars write SetBackgroundOnToolbars default True;
    property BackgroundTransparent: Boolean read FBkgTransparent write SetBackgroundTransparent default False;
    property BoundLines: TDockBoundLines read FBoundLines write SetBoundLines default [];
    property Color default clBtnFace;
    property FixAlign: Boolean read FFixAlign write SetFixAlign default False;
    property LimitToOneRow: Boolean read FLimitToOneRow write FLimitToOneRow default False;
    property PopupMenu;
    property Position: TDockPosition read FPosition write SetPosition default dpTop;
    property Visible;

    property OnInsertRemoveBar: TInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar;
    property OnRequestDock: TRequestDockEvent read FOnRequestDock write FOnRequestDock;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
  end;

  { TFloatingWindowParent - internal }

  TFloatingWindowParent = class(TForm)
  private
    FParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF};
    FShouldShow: Boolean;
    procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMDialogKey (var Message: TCMDialogKey); message CM_DIALOGKEY;
  protected
    procedure CreateParams (var Params: TCreateParams); override;
  public
    property ParentForm: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF} read FParentForm;
    constructor Create (AOwner: TComponent); override;
  end;

  { TCustomToolWindow97 }

  TDockChangingExEvent = procedure(Sender: TObject; DockingTo: TDock97) of object;
  TDragHandleStyle = (dhDouble, dhNone, dhSingle);
  TToolWindowParams = record
    CallAlignControls, ResizeEightCorner, ResizeClipCursor: Boolean;
  end;
  TPositionReadIntProc = function(const ToolbarName, Value: String; const Default: Longint;
    const ExtraData: Pointer): Longint;
  TPositionReadStringProc = function(const ToolbarName, Value, Default: String;
    const ExtraData: Pointer): String;
  TPositionWriteIntProc = procedure(const ToolbarName, Value: String; const Data: Longint;
    const ExtraData: Pointer);
  TPositionWriteStringProc = procedure(const ToolbarName, Value, Data: String;
    const ExtraData: Pointer);

  TCustomToolWindow97 = class(TCustomControl)
  private
    { Property variables }
    FDockPos, FDockRow: Integer;
    FDocked: Boolean;
    FDockedTo, FDefaultDock: TDock97;
    FOnClose, FOnDockChanged, FOnDockChanging, FOnMove, FOnRecreated,
      FOnRecreating, FOnResize, FOnVisibleChanged: TNotifyEvent;
    FOnDockChangingEx, FOnDockChangingHidden: TDockChangingExEvent;
    FActivateParent, FHideWhenInactive, FCloseButton, FFullSize, FResizable: Boolean;
    FBorderStyle: TBorderStyle;
    FDragHandleStyle: TDragHandleStyle;
    FDockableTo: TDockableTo;
    FLastDockType: TDockType;
    FLastDockTypeSet: Boolean;
    FParams: TToolWindowParams;

    { Misc. }
    FUpdatingBounds,           { Incremented while internally changing the bounds. This allows
                                 it to move the toolbar freely in design mode and prevents the
                                 SizeChanging protected method from begin called }
    FDisableArrangeControls,   { Incremented to disable ArrangeControls }
    FDisableOnMove,            { Incremented to prevent WM_MOVE handler from calling the OnMoved handler }
    FHidden: Integer;          { Incremented while the toolbar is temporarily hidden }
    FArrangeNeeded, FMoved: Boolean;
    FInactiveCaption: Boolean; { True when the caption of the toolbar is currently the inactive color }
    FFloatingTopLeft: TPoint;
    FDockForms: TList;
    FSavedAtRunTime: Boolean;

    { When floating. These are not used in design mode }
    FFloatParent: TFloatingWindowParent; { Run-time only: The actual Parent of the toolbar when it is floating }
    FCloseButtonDown: Boolean; { True if Close button is currently depressed }

    { Property access methods }
    procedure SetBorderStyle (Value: TBorderStyle);
    procedure SetCloseButton (Value: Boolean);
    procedure SetDefaultDock (Value: TDock97);
    procedure SetDockedTo (Value: TDock97);
    procedure SetDockPos (Value: Integer);
    procedure SetDockRow (Value: Integer);
    procedure SetDragHandleStyle (Value: TDragHandleStyle);
    procedure SetFullSize (Value: Boolean);
    procedure SetResizable (Value: Boolean);

    { Internal }
    procedure MoveOnScreen (const OnlyIfFullyOffscreen: Boolean);
    procedure DrawDraggingOutline (const DC: HDC; const NewRect, OldRect: PRect;
      const NewDocking, OldDocking: Boolean);
    procedure BeginMoving (const InitX, InitY: Integer);
    procedure BeginSizing (const HitTestValue: Integer; var Accept: Boolean;
      var NewRect: TRect);
    procedure DrawFloatingNCArea (const Clip: HRGN; const RedrawBorder, RedrawCaption, RedrawCloseButton: Boolean);
    procedure DrawDockedNCArea (const Clip: HRGN);
    procedure InvalidateDockedNCArea;
    procedure ValidateDockedNCArea;
    procedure SetInactiveCaption (Value: Boolean);
    procedure Moved;
    function GetShowingState: Boolean;
    procedure UpdateVisibility;
    procedure ReadSavedAtRunTime (Reader: TReader);
    procedure WriteSavedAtRunTime (Writer: TWriter);

    { Messages }
    procedure CMColorChanged (var Message: TMessage); message CM_COLORCHANGED;
    procedure CMTextChanged (var Message: TMessage); message CM_TEXTCHANGED;
    procedure CMShowingChanged (var Message: TMessage); message CM_SHOWINGCHANGED;
    procedure CMVisibleChanged (var Message: TMessage); message CM_VISIBLECHANGED;
    procedure WMActivate (var Message: TWMActivate); message WM_ACTIVATE;
    procedure WMClose (var Message: TWMClose); message WM_CLOSE;
    procedure WMGetMinMaxInfo (var Message: TWMGetMinMaxInfo); message WM_GETMINMAXINFO;
    procedure WMMove (var Message: TWMMove); message WM_MOVE;
    procedure WMMouseActivate (var Message: TWMMouseActivate); message WM_MOUSEACTIVATE;
    procedure WMNCCalcSize (var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
    procedure WMNCHitTest (var Message: TWMNCHitTest); message WM_NCHITTEST;
    procedure WMNCLButtonDown (var Message: TWMNCLButtonDown); message WM_NCLBUTTONDOWN;
    procedure WMNCPaint (var Message: TMessage); message WM_NCPAINT;
    procedure WMTB97PaintDockedNCArea (var Message: TMessage); message WM_TB97PaintDockedNCArea;
    procedure WMSize (var Message: TWMSize); message WM_SIZE;
  protected
    property ActivateParent: Boolean read FActivateParent write FActivateParent default True;
    property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
    property Color default clBtnFace;
    property CloseButton: Boolean read FCloseButton write SetCloseButton default True;
    property DefaultDock: TDock97 read FDefaultDock write SetDefaultDock;
    property DockableTo: TDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight];
    property DragHandleStyle: TDragHandleStyle read FDragHandleStyle write SetDragHandleStyle default dhDouble;
    property FullSize: Boolean read FFullSize write SetFullSize default False;
    property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True;
    property Params: TToolWindowParams read FParams;
    property Resizable: Boolean read FResizable write SetResizable default True;

    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnDockChanged: TNotifyEvent read FOnDockChanged write FOnDockChanged;
    property OnDockChanging: TNotifyEvent read FOnDockChanging write FOnDockChanging;
    property OnDockChangingEx: TDockChangingExEvent read FOnDockChangingEx write FOnDockChangingEx;
    property OnDockChangingHidden: TDockChangingExEvent read FOnDockChangingHidden write FOnDockChangingHidden;
    property OnMove: TNotifyEvent read FOnMove write FOnMove;
    property OnRecreated: TNotifyEvent read FOnRecreated write FOnRecreated;
    property OnRecreating: TNotifyEvent read FOnRecreating write FOnRecreating;
    property OnResize: TNotifyEvent read FOnResize write FOnResize;
    property OnVisibleChanged: TNotifyEvent read FOnVisibleChanged write FOnVisibleChanged;

    { Overridden methods }
    procedure AlignControls (AControl: TControl; var Rect: TRect); override;
    procedure CreateParams (var Params: TCreateParams); override;
    procedure DefineProperties (Filer: TFiler); override;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Notification (AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
    function PaletteChanged (Foreground: Boolean): Boolean; override;
    procedure SetParent (AParent: TWinControl); override;

    { Methods accessible to descendants }
    procedure ArrangeControls;
    function ChildControlTransparent (Ctl: TControl): Boolean; dynamic;
    procedure CustomArrangeControls (const PreviousDockType: TDockType;
      const DockingTo: TDock97; const Resize: Boolean);
    procedure GetBarSize (var ASize: Integer; const DockType: TDockType); virtual; abstract;
    procedure GetDockRowSize (var AHeightOrWidth: Integer);
    procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); virtual; abstract;
    procedure GetParams (var Params: TToolWindowParams); dynamic;
    procedure InitializeOrdering; dynamic;
    function OrderControls (CanMoveControls: Boolean; PreviousDockType: TDockType;
      DockingTo: TDock97): TPoint; virtual; abstract;
    procedure ResizeBegin (HitTestValue: Integer); dynamic;
    procedure ResizeEnd (Accept: Boolean); dynamic;
    procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); dynamic;
    procedure SizeChanging (const AWidth, AHeight: Integer); virtual;
  public
    property Docked: Boolean read FDocked;
    property DockedTo: TDock97 read FDockedTo write SetDockedTo stored False;
    property DockPos: Integer read FDockPos write SetDockPos default -1;
    property DockRow: Integer read FDockRow write SetDockRow default 0;
    property FloatingPosition: TPoint read FFloatingTopLeft write FFloatingTopLeft;

    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    procedure SetBounds (ALeft, ATop, AWidth, AHeight: Integer); override;

    procedure BeginUpdate;
    procedure EndUpdate;
    procedure AddDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});
    procedure RemoveDockForm (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF});

    procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
    procedure DoneReadingPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); dynamic;
    procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); dynamic;
  published
    property Height stored False;
    property Width stored False;
  end;

procedure RegLoadToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const BaseRegistryKey: String);
procedure RegLoadToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const RootKey: HKEY; const BaseRegistryKey: String);
procedure RegSaveToolbarPositions (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const BaseRegistryKey: String);
procedure RegSaveToolbarPositionsEx (const Form: {$IFDEF TB97D3} TCustomForm {$ELSE} TForm {$ENDIF}; const RootKey: HKEY; const BaseRegistryKey: String);