rm_tb97tlbr.pas

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

unit RM_TB97Tlbr;

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

  TCustomToolbar97, TToolbar97, TToolbarSep97

  $Id: TB97Tlbr.pas,v 1.3 2001/02/26 17:52:42 jr Exp $
}

{$I RM.INC}

interface

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

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

type
  { TCustomToolbar97 }

  TToolbarParams = record
    InitializeOrderByPosition, DesignOrderByPosition: Boolean;
  end;

  TCustomToolbar97 = class(TCustomToolWindow97)
  private
    FToolbarParams: TToolbarParams;
    FFloatingRightX: Integer;
    FOrderListDirty: Boolean;
    SizeData: Pointer;

    { Lists }
    SlaveInfo,         { List of slave controls. Items are pointers to TSlaveInfo's }
    GroupInfo,         { List of the control "groups". List items are pointers to TGroupInfo's }
    LineSeps,          { List of the Y locations of line separators. Items are casted in TLineSep's }
    OrderList: TList;  { List of the child controls, arranged using the current "OrderIndex" values }

    { Property access methods }
    function GetOrderedControls (Index: Integer): TControl;
    function GetOrderIndex (Control: TControl): Integer;
    procedure SetFloatingWidth (Value: Integer);
    procedure SetOrderIndex (Control: TControl; Value: Integer);

    { Internal }
    procedure CleanOrderList;
    procedure SetControlVisible (const Control: TControl;
      const LeftOrRight: Boolean);
    function ShouldControlBeVisible (const Control: TControl;
      const LeftOrRight: Boolean): Boolean;
    procedure FreeGroupInfo (const List: TList);
    procedure BuildGroupInfo (const List: TList; const TranslateSlave: Boolean;
      const OldDockType, NewDockType: TDockType);

    { Messages }
    procedure CMControlListChange (var Message: TCMControlListChange); message CM_CONTROLLISTCHANGE;
    procedure WMWindowPosChanging (var Message: TWMWindowPosChanging); message WM_WINDOWPOSCHANGING;
  protected
    property ToolbarParams: TToolbarParams read FToolbarParams;

    procedure Paint; override;

    procedure BuildPotentialSizesList (SizesList: TList); dynamic;
    function ChildControlTransparent (Ctl: TControl): Boolean; override;
    procedure GetParams (var Params: TToolWindowParams); override;
    procedure GetToolbarParams (var Params: TToolbarParams); dynamic;
    procedure ResizeBegin (ASizeHandle: TToolWindowSizeHandle); override;
    procedure ResizeTrack (var Rect: TRect; const OrigRect: TRect); override;
    procedure ResizeEnd (Accept: Boolean); override;

    procedure GetBarSize (var ASize: Integer; const DockType: TDockType); override;
    procedure GetMinimumSize (var AClientWidth, AClientHeight: Integer); override;
    procedure InitializeOrdering; override;
    function OrderControls (CanMoveControls: Boolean; PreviousDockType: TDockType;
      DockingTo: TDock97): TPoint; override;
  public
    property OrderedControls[Index: Integer]: TControl read GetOrderedControls;
    property OrderIndex[Control: TControl]: Integer read GetOrderIndex write SetOrderIndex;
    property FloatingWidth: Integer read FFloatingRightX write SetFloatingWidth;

    constructor Create (AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReadPositionData (const ReadIntProc: TPositionReadIntProc;
      const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer); override;
    procedure WritePositionData (const WriteIntProc: TPositionWriteIntProc;
      const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer); override;

    procedure SetSlaveControl (const ATopBottom, ALeftRight: TControl);
  end;

  { TToolbar97 }

  TToolbar97 = class(TCustomToolbar97)
  published
    property ActivateParent;
    property BorderStyle;
    property Caption;
    property Color;
    property CloseButton;
    property CloseButtonWhenDocked;
    property DefaultDock;
    property DockableTo;
    property DockedTo;
    property DockMode;
    property DockPos;
    property DockRow;
    property DragHandleStyle;
    property FloatingMode;
    property Font;
    property FullSize;
    property HideWhenInactive;
    property LastDock;
    property ParentFont;
    property ParentShowHint;
    property PopupMenu;
    property ShowCaption;
    property ShowHint;
    property TabOrder;
    property UseLastDock;
    property Version;
    property Visible;

    property OnClose;
    property OnCloseQuery;
    property OnDragDrop;
    property OnDragOver;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnMove;
    property OnRecreated;
    property OnRecreating;
    property OnDockChanged;
    property OnDockChanging;
    property OnDockChangingEx;
    property OnDockChangingHidden;
    property OnResize;
    property OnVisibleChanged;
  end;

  { TToolbarSep97 }

  TToolbarSepSize = 1..MaxInt;

  TToolbarSep97 = class(TGraphicControl)
  private
    FBlank: Boolean;
    FSizeHorz, FSizeVert: TToolbarSepSize;
    procedure SetBlank (Value: Boolean);
    procedure SetSizeHorz (Value: TToolbarSepSize);
    procedure SetSizeVert (Value: TToolbarSepSize);
  protected
    procedure MouseDown (Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
    procedure Paint; override;
    procedure SetParent (AParent: TWinControl); override;
  public
    constructor Create (AOwner: TComponent); override;
  published
    { These two properties don't need to be stored since it automatically gets
      resized based on the setting of SizeHorz and SizeVert }
    property Width stored False;
    property Height stored False;
    property Blank: Boolean read FBlank write SetBlank default False;
    property SizeHorz: TToolbarSepSize read FSizeHorz write SetSizeHorz default 6;
    property SizeVert: TToolbarSepSize read FSizeVert write SetSizeVert default 6;
    property Visible;
  end;


{$IFOPT J+}
  {$DEFINE _TB97_OPT_J}
  {$J-}  { don't let the following typed constants be modified }
{$ENDIF}
const
  tb97DefaultBarWidthHeight = 8;

  tb97TopMarginFloating = 2;
  tb97TopMarginDocked = 0;
  tb97TopMargin: array[Boolean] of Integer = (tb97TopMarginFloating, tb97TopMarginDocked);
  tb97BottomMarginFloating = 1;
  tb97BottomMarginDocked = 0;
  tb97BottomMargin: array[Boolean] of Integer = (tb97BottomMarginFloating, tb97BottomMarginDocked);
  tb97LeftMarginFloating = 4;
  tb97LeftMarginDocked = 0;
  tb97LeftMargin: array[Boolean] of Integer = (tb97LeftMarginFloating, tb97LeftMarginDocked);
  tb97RightMarginFloating = 4;
  tb97RightMarginDocked = 0;
  tb97RightMargin: array[Boolean] of Integer = (tb97RightMarginFloating, tb97RightMarginDocked);
  tb97LineSpacing = 6;
{$IFDEF _TB97_OPT_J}
  {$J+}
  {$UNDEF _TB97_OPT_J}
{$ENDIF}

{$ENDIF}
implementation

{$IFDEF USE_INTERNALTB97}
uses
  SysUtils, RM_TB97Cmn, RM_TB97Cnst;

const
  { Constants for registry values. Do not localize! }
  { TCustomToolbar97 specific }
  rvFloatRightX = 'FloatRightX';

type
  { Used internally by the TCustomToolbar97.Resize* procedures }
  PToolbar97SizeData = ^TToolbar97SizeData;
  TToolbar97SizeData = record
    SizeHandle: TToolWindowSizeHandle;
    NewSizes: TList;  { List of valid new sizes. Items are casted into TSmallPoints }
    CurRightX: Integer;
    DisableSensCheck, OpSide: Boolean;
    SizeSens: Integer;
  end;

  { Used in TCustomToolbar97.GroupInfo lists }
  PGroupInfo = ^TGroupInfo;
  TGroupInfo = record
    GroupWidth,           { Width in pixels of the group, if all controls were
                            lined up left-to-right }
    GroupHeight: Integer; { Heights in pixels of the group, if all controls were
                            lined up top-to-bottom }
    Members: TList;
  end;

  { Used in TCustomToolbar97.SlaveInfo lists }
  PSlaveInfo = ^TSlaveInfo;
  TSlaveInfo = record
    LeftRight,
    TopBottom: TControl;
  end;

  { Used in TCustomToolbar97.LineSeps lists }
  TLineSep = packed record
    Y: SmallInt;
    Blank: Boolean;
    Unused: Boolean;
  end;

  { Use by CompareControls }
  PCompareExtra = ^TCompareExtra;
  TCompareExtra = record
    Toolbar: TCustomToolbar97;
    ComparePositions: Boolean;
    CurDockType: TDockType;
  end;


{ TCustomToolbar97 }

constructor TCustomToolbar97.Create (AOwner: TComponent);
begin
  inherited;
  GetToolbarParams (FToolbarParams);
  GroupInfo := TList.Create;
  SlaveInfo := TList.Create;
  LineSeps := TList.Create;
  OrderList := TList.Create;
end;

destructor TCustomToolbar97.Destroy;
var
  I: Integer;
begin
  OrderList.Free;
  LineSeps.Free;
  if Assigned(SlaveInfo) then begin
    for I := SlaveInfo.Count-1 downto 0 do
      FreeMem (SlaveInfo.Items[I]);
    SlaveInfo.Free;
  end;
  FreeGroupInfo (GroupInfo);
  GroupInfo.Free;
  inherited;
end;

procedure TCustomToolbar97.ReadPositionData (const ReadIntProc: TPositionReadIntProc;
  const ReadStringProc: TPositionReadStringProc; const ExtraData: Pointer);
begin
  inherited;
  FFloatingRightX := ReadIntProc(Name, rvFloatRightX, 0, ExtraData);
end;

procedure TCustomToolbar97.WritePositionData (const WriteIntProc: TPositionWriteIntProc;
  const WriteStringProc: TPositionWriteStringProc; const ExtraData: Pointer);
begin
  inherited;
  WriteIntProc (Name, rvFloatRightX, FFloatingRightX, ExtraData);
end;

procedure TCustomToolbar97.GetMinimumSize (var AClientWidth, AClientHeight: Integer);
begin
  AClientWidth := 0;
  AClientHeight := 0;
end;

procedure TCustomToolbar97.CleanOrderList;
{ TCustomToolbar97 uses a CM_CONTROLLISTCHANGE handler to detect when new
  controls are added to the toolbar. The handler adds the new controls to
  OrderList, which can be manipulated by the application using the OrderIndex
  property.
  The only problem is, the VCL relays CM_CONTROLLISTCHANGE messages
  to all parents of a control, not just the immediate parent. In pre-1.76
  versions of Toolbar97, OrderList contained not only the immediate children
  of the toolbar, but their children too. So this caused the OrderIndex
  property to return unexpected results.
  What this method does is clear out all controls in OrderList that aren't
  immediate children of the toolbar. (A check of Parent can't be put into the
  CM_CONTROLLISTCHANGE handler because that message is sent before a new
  Parent is assigned.) }
var
  I: Integer;
begin
  if not FOrderListDirty then
    Exit;
  I := 0;
  while I < OrderList.Count do begin
    if TControl(OrderList.List[I]).Parent <> Self then
      OrderList.Delete (I)
    else
      Inc (I);
  end;
  FOrderListDirty := False;
end;

function CompareControls (const Item1, Item2, ExtraData: Pointer): Integer; far;
begin
  with PCompareExtra(ExtraData)^ do
    if ComparePositions then begin
      if CurDockType <> dtLeftRight then
        Result := TControl(Item1).Left - TControl(Item2).Left
      else
        Result := TControl(Item1).Top - TControl(Item2).Top;
    end
    else
      with Toolbar.OrderList do
        Result := IndexOf(Item1) - IndexOf(Item2);
end;

procedure TCustomToolbar97.InitializeOrdering;
var
  Extra: TCompareExtra;
begin
  inherited;
  { Initialize order of items in OrderList }
  if ToolbarParams.InitializeOrderByPosition then begin
    with Extra do begin
      Toolbar := Self;
      ComparePositions := True;
      CurDockType := GetDockTypeOf(DockedTo);
    end;
    CleanOrderList;
    ListSortEx (OrderList, CompareControls, @Extra);
  end;
end;

procedure TCustomToolbar97.GetBarSize (var ASize: Integer; const DockType: TDockType);
var
  I: Integer;
begin
  ASize := tb97DefaultBarWidthHeight;
  for I := 0 to ControlCount-1 do
    if not(Controls[I] is TToolbarSep97) then
      with Controls[I] do begin
        if ShouldControlBeVisible(Controls[I], DockType = dtLeftRight) then begin
          if DockType = dtLeftRight then begin
            if Width > ASize then ASize := Width;