rm_tb97.pas

进销存·完整的·有数据库的·非常完整·只得参考

unit RM_TB97;

{
  Toolbar97
  Copyright (C) 1998-2001 by Jordan Russell
  For conditions of distribution and use, see LICENSE.TXT.

  e-mail:     [e-mail]
  home page:  http://www.jrsoftware.org/
              (alternate address: http://www.jordanr.cjb.net/)

  *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.

  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.

  $Id: TB97.pas,v 1.4 2001/01/04 04:17:14 jr Exp $
}

{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 RM.INC}

interface

{$IFDEF USE_INTERNALTB97}
{$I RM_TB97Ver.inc}

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

const
  WM_TB97PaintDockedNCArea = WM_USER + 5039; { used internally }
  WM_TB97PaintFloatingNCArea = WM_USER + 5040; { 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, FArrangeToolbarsClipPoses: Boolean;
    FNonClientWidth, FNonClientHeight: Integer;
    DockList: TList; { List of the toolbars docked, and those floating and have LastDock
                        pointing to the dock. Items are casted in TCustomToolWindow97's. }
    DockVisibleList: TList; { Similar to DockList, but lists only docked and visible toolbars }
    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 }
    function GetVersion: TToolbar97Version;
    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);
    procedure SetVersion(const Value: TToolbar97Version);

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

    { Internal }
    procedure ArrangeToolbars(const ClipPoses: Boolean);
    procedure BackgroundChanged(Sender: TObject);
    procedure BuildRowInfo;
    procedure ChangeDockList(const Insert: Boolean; const Bar: TCustomToolWindow97);
    procedure ChangeWidthHeight(const NewWidth, NewHeight: Integer);
    procedure DrawBackground(const DC: HDC;
      const IntersectClippingRect: TRect; const ExcludeClippingRect: PRect;
      const DrawRect: TRect);
    procedure DrawNCArea(const DrawToDC: Boolean; const ADC: HDC;
      const Clip: HRGN);
    function GetDesignModeRowOf(const XY: Integer): Integer;
    function GetNumberOfToolbarsOnRow(const Row: Integer;
      const NotIncluding: TCustomToolWindow97): Integer;
    function GetRowOf(const XY: Integer; var Before: Boolean): Integer;
    function HasVisibleToolbars: Boolean;
    procedure InsertRowBefore(const BeforeRow: Integer);
    procedure InvalidateBackgrounds;
    procedure RemoveBlankRows;
    function ToolbarVisibleOnDock(const AToolbar: TCustomToolWindow97): Boolean;
    procedure ToolbarVisibilityChanged(const Bar: TCustomToolWindow97;
      const ForceRemove: Boolean);
    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;
    procedure WMPrint(var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
  protected
    procedure AlignControls(AControl: TControl; var Rect: TRect); override;
    function GetPalette: HPALETTE; override;
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); 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 GetHighestRow: Integer;
    function GetRowSize(const Row: Integer;
      const DefaultToolbar: TCustomToolWindow97): Integer;

    property NonClientWidth: Integer read FNonClientWidth;
    property NonClientHeight: Integer read FNonClientHeight;
    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 Version: TToolbar97Version read GetVersion write SetVersion stored False;
    property Visible;

    property OnInsertRemoveBar: TInsertRemoveEvent read FOnInsertRemoveBar write FOnInsertRemoveBar;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    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);
  TToolWindowDockMode = (dmCanFloat, dmCannotFloat, dmCannotFloatOrChangeDocks);
  TToolWindowFloatingMode = (fmOnTopOfParentForm, fmOnTopOfAllForms);
  TToolWindowParams = record
    CallAlignControls, ResizeEightCorner, ResizeClipCursor: Boolean;
  end;
  TToolWindowSizeHandle = (twshLeft, twshRight, twshTop, twshTopLeft,
    twshTopRight, twshBottom, twshBottomLeft, twshBottomRight);
    { ^ must be in same order as HTLEFT..HTBOTTOMRIGHT }
  TToolWindowNCRedrawWhatElement = (twrdBorder, twrdCaption, twrdCloseButton);
  TToolWindowNCRedrawWhat = set of TToolWindowNCRedrawWhatElement;
  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, FLastDock: TDock97;
    FOnClose, FOnDockChanged, FOnDockChanging, FOnMove, FOnRecreated,
      FOnRecreating, FOnResize, FOnVisibleChanged: TNotifyEvent;
    FOnCloseQuery: TCloseQueryEvent;
    FOnDockChangingEx, FOnDockChangingHidden: TDockChangingExEvent;
    FActivateParent, FHideWhenInactive, FCloseButton, FCloseButtonWhenDocked,
      FFullSize, FResizable, FShowCaption, FUseLastDock: Boolean;
    FBorderStyle: TBorderStyle;
    FDockMode: TToolWindowDockMode;
    FDragHandleStyle: TDragHandleStyle;
    FDockableTo: TDockableTo;
    FFloatingMode: TToolWindowFloatingMode;
    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;
    FNonClientWidth, FNonClientHeight: Integer;

    { 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 }
    function GetVersion: TToolbar97Version;
    function IsLastDockStored: Boolean;
    procedure SetBorderStyle(Value: TBorderStyle);
    procedure SetCloseButton(Value: Boolean);
    procedure SetCloseButtonWhenDocked(Value: Boolean);
    procedure SetDefaultDock(Value: TDock97);
    procedure SetDockedTo(Value: TDock97);
    procedure SetDockPos(Value: Integer);
    procedure SetDockRow(Value: Integer);
    procedure SetDragHandleStyle(Value: TDragHandleStyle);
    procedure SetFloatingMode(Value: TToolWindowFloatingMode);
    procedure SetFullSize(Value: Boolean);
    procedure SetLastDock(Value: TDock97);
    procedure SetResizable(Value: Boolean);
    procedure SetShowCaption(Value: Boolean);
    procedure SetUseLastDock(Value: Boolean);
    procedure SetVersion(const Value: TToolbar97Version);

    { Internal }
    procedure CalculateNonClientSizes(R: PRect);
    procedure MoveOnScreen(const OnlyIfFullyOffscreen: Boolean);
    procedure DrawDraggingOutline(const DC: HDC; const NewRect, OldRect: PRect;
      const NewDocking, OldDocking: Boolean);
    procedure DrawFloatingNCArea(const DrawToDC: Boolean; const ADC: HDC;
      const Clip: HRGN; RedrawWhat: TToolWindowNCRedrawWhat);
    procedure DrawDockedNCArea(const DrawToDC: Boolean; const ADC: HDC;
      const Clip: HRGN);
    procedure InvalidateDockedNCArea;
    procedure InvalidateFloatingNCArea(const RedrawWhat: TToolWindowNCRedrawWhat);
    procedure ValidateDockedNCArea;
    function ValidateFloatingNCArea: TToolWindowNCRedrawWhat;
    procedure SetInactiveCaption(Value: Boolean);
    procedure Moved;
    function GetShowingState: Boolean;
    procedure UpdateTopmostFlag;
    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 WMEnable(var Message: TWMEnable); message WM_ENABLE;
    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 WMPrint(var Message: TMessage); message WM_PRINT;
    procedure WMPrintClient(var Message: TMessage); message WM_PRINTCLIENT;
    procedure WMTB97PaintDockedNCArea(var Message: TMessage); message WM_TB97PaintDockedNCArea;
    procedure WMTB97PaintFloatingNCArea(var Message: TMessage); message WM_TB97PaintFloatingNCArea;
    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 CloseButtonWhenDocked: Boolean read FCloseButtonWhenDocked write SetCloseButtonWhenDocked default False;
    property DefaultDock: TDock97 read FDefaultDock write SetDefaultDock;
    property DockableTo: TDockableTo read FDockableTo write FDockableTo default [dpTop, dpBottom, dpLeft, dpRight];
    property DockMode: TToolWindowDockMode read FDockMode write FDockMode default dmCanFloat;
    property DragHandleStyle: TDragHandleStyle read FDragHandleStyle write SetDragHandleStyle default dhDouble;
    property FloatingMode: TToolWindowFloatingMode read FFloatingMode write SetFloatingMode default fmOnTopOfParentForm;
    property FullSize: Boolean read FFullSize write SetFullSize default False;
    property HideWhenInactive: Boolean read FHideWhenInactive write FHideWhenInactive default True;
    property LastDock: TDock97 read FLastDock write SetLastDock stored IsLastDockStored;
    property Params: TToolWindowParams read FParams;
    property Resizable: Boolean read FResizable write SetResizable default True;
    property ShowCaption: Boolean read FShowCaption write SetShowCaption default True;
    property UseLastDock: Boolean read FUseLastDock write SetUseLastDock default True;
    property Version: TToolbar97Version read GetVersion write SetVersion stored False;

    property OnClose: TNotifyEvent read FOnClose write FOnClose;
    property OnCloseQuery: TCloseQueryEvent read FOnCloseQuery write FOnCloseQuery;
    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;