aqdocking.pas

AutomatedDocking Library 控件源代码修改 适合Delphi 2009 和C++ Builder 20009 使用。 修正汉字不能正确显示问题

{*******************************************************************}
{                                                                   }
{       AutomatedDocking Library (Cross-Platform Edition)           }
{                                                                   }
{       Copyright (c) 1999-2008 AutomatedQA Corp.                   }
{       ALL RIGHTS RESERVED                                         }
{                                                                   }
{   The entire contents of this file is protected by U.S. and       }
{   International Copyright Laws. Unauthorized reproduction,        }
{   reverse-engineering, and distribution of all or any portion of  }
{   the code contained in this file is strictly prohibited and may  }
{   result in severe civil and criminal penalties and will be       }
{   prosecuted to the maximum extent possible under the law.        }
{                                                                   }
{   RESTRICTIONS                                                    }
{                                                                   }
{   THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES           }
{   (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE    }
{   SECRETS OF AUTOMATEDQA CORP. THE REGISTERED DEVELOPER IS        }
{   LICENSED TO DISTRIBUTE THE AUTOMATEDDOCKING LIBRARY AND ALL     }
{   ACCOMPANYING VCL AND CLX CONTROLS AS PART OF AN EXECUTABLE      }
{   PROGRAM ONLY.                                                   }
{                                                                   }
{   THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED      }
{   FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE        }
{   COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE       }
{   AVAILABLE TO OTHER INDIVIDUALS WITHOUT WRITTEN CONSENT          }
{   AND PERMISSION FROM AUTOMATEDQA CORP.                           }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}

unit aqDocking;

{$I aqDockingVer.inc}
{$DEFINE DefaultCustomizer}
 {$H- }  // 去掉Unicode  zuojin add
interface

uses
  Types, Classes, Contnrs,
{$IFDEF VCL}
  Windows, Controls, Forms, Graphics, Messages, Menus, StdCtrls, ExtCtrls,
{$ELSE}
  Qt, QControls, QForms, QGraphics, QMenus, QStdCtrls,
{$ENDIF}
  aqDockingUI, aqDockingBase, aqDockingUtils, aqUIHelpers;

type
  TaqDockingRegionType = (drtLeft, drtTop, drtRight, drtBottom, drtInside,
    drtDetachedLeft, drtDetachedTop, drtDetachedRight, drtDetachedBottom, drtInsideBefore, drtNone);
  TaqContainerType = (cntInside, cntVertical, cntHorizontal, cntInsideTop, cntInsideBottom);
  TaqContainerTypes = set of TaqContainerType;
  TaqCaptionType = set of (ctCaption, ctTab, ctHiddenTab);
  TaqDockingStoreKind = (dskFile, {$IFDEF VCL}dskRegistry,{$ENDIF} dskNone);
  TaqDockingStoreOptions = set of (dsoFormPosition, dsoFormState, dsoFormConstraints,
    dsoActiveDockingControl);
  TaqChildAlignment = array [TaqChildInsertOrder] of TaqDockingAlignment;
  TaqAutoHideStartAction = (ahsHover, ahsClick);
  TaqAutoHideCaptions = (ahcActiveOnly, ahcAll, ahcNone);
  TaqAutoHideTabs = (ahtNone, ahtActiveTab, ahtAllTabs);

const
  cntAll = [cntInside, cntVertical, cntHorizontal, cntInsideTop, cntInsideBottom];

type
  TaqDockingControl = class;
  TaqDockingStyle = class;
  TaqDockingManager = class;
  TaqDockingSite = class;
  TaqDockingFrame = class;
  TaqSizer = class;
  TaqMover = class;
  TaqDocker = class;
  TaqDockingFrameClass = class of TaqDockingFrame;
  TaqSizerClass = class of TaqSizer;
  TaqMoverClass = class of TaqMover;
  TaqDockerClass = class of TaqDocker;

  TaqPlacementInfo = class(TaqCustomPlacementInfo)
  private
    FParentKey: TGUID;
    FParent: TaqCustomDockingControl;
    FContainer: TaqCustomDockingContainerClass;
    FOrder: TaqChildInsertOrder;
    FAlignment: TaqDockingAlignment;
    FTabOrientation: TaqTabOrientation;
    FHideSize: Integer;
    function GetDockingManager: TaqDockingManager;
    procedure ClearHideSize;
    function DoCollision(Target: TaqCustomDockingControl): Boolean;
  protected
    function GetHideSize: Integer;
    property DockingManager: TaqDockingManager read GetDockingManager;
  public
    { TaqCustomPlacementInfo }
    procedure SavePosition; override;
    function DockToPosition: Boolean; override;
    procedure LoadFromStream(Reader: TaqCustomDockingReader); override;
    procedure SaveToStream(Writer: TaqCustomDockingWriter); override;
    procedure AfterDockingRead; override;

    property Parent: TaqCustomDockingControl read FParent;
    property Container: TaqCustomDockingContainerClass read FContainer;
    property Order: TaqChildInsertOrder read FOrder;
    property Alignment: TaqDockingAlignment read FAlignment;
    property HideSize: Integer read GetHideSize write FHideSize;
  end;

  TaqDockZoneEvent = procedure (Sender: TaqDockingControl; Source: TaqCustomDockingControl;
    Coord: TPoint; var Region: TaqDockingRegionType) of object;

  TaqDockingControl = class(TaqCustomDockingControl)
  private
    FDesignClientArea: TPoint;
    FClientAreaAdjust: Boolean;
    FOnCreate: TNotifyEvent;
    FOnDestroy: TNotifyEvent;
    FOnDockZone: TaqDockZoneEvent;
    procedure ReadClientHeight(Reader: TReader);
    procedure WriteClientHeight(Writer: TWriter);
    procedure ReadClientWidth(Reader: TReader);
    procedure WriteClientWidth(Writer: TWriter);
    function GetLastPos: TaqPlacementInfo;
    function GetDockingManager: TaqDockingManager;
  protected
    procedure DoDockZone(Source: TaqCustomDockingControl;
      Coord: TPoint; var Region: TaqDockingRegionType); virtual;
    procedure Paint; override;
    procedure DrawCaption; override;
    function IsImageVisible: Boolean; override;
    function GetClientRect: TRect; override;
    procedure AdjustClientRect(var Rect: TRect); override;
    function GetChildParent: TComponent; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure ReadState(Reader: TReader); override;
    procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer); override;
{$IFDEF VCL}
    procedure WMParentNotify(var Message: TWMParentNotify); message WM_PARENTNOTIFY;
{$ELSE}
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
{$ENDIF}
    procedure DefineProperties(Filer: TFiler); override;
    procedure DoCreate; virtual;
    procedure DoDestroy; virtual;
    class function GetPlacementInfoClass: TaqCustomPlacementInfoClass; override;

    property LastPos: TaqPlacementInfo read GetLastPos;
    property DockingManager: TaqDockingManager read GetDockingManager;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Loaded; override;

    function CanShowCaption: Boolean; override;
    procedure AfterConstruction; override;
    procedure BeforeDestruction; override;
  published
    property ActiveControl;
    property Caption;
    property Color;
    property Font;
    property Height;
    property HelpType;
    property HelpKeyword;
    property HelpContext;
    property ImageIndex;
    property Left stored False;
    property MinWidth;
    property MinHeight;
    property ParentColor;
    property ParentFont;
    property PreferredWidth;
    property PreferredHeight;
    property ShowCaption;
    property ShowImage;
    property Top stored False;
    property Visible;
    property Width;

    property OnAutoHideCalc;
    property OnAutoHideChanged;
    property OnAutoHideChanging;
    property OnCaptionPopup;
    property OnChange;
    property OnCloseQuery;
    property OnCreate: TNotifyEvent read FOnCreate write FOnCreate;
    property OnCustomButtonClick;
    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
    property OnDockDrop;
    property OnDockOver;
    property OnDockZone: TaqDockZoneEvent read FOnDockZone write FOnDockZone;
    property OnDragDock;
    property OnEndDock;
    property OnEnter;
    property OnExit;
    property OnHide;
    property OnHideEx;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseUp;
    property OnPopupMenuCreate;
    property OnResize;
    property OnShow;
    property OnStartDock;
    property OnUpdateActions;
  end;

  TaqSplitContainer = class(TaqCustomDockingContainer)
  private
    FFirstAlign: TaqDockingAlignment;
    FLastAlign: TaqDockingAlignment;
    FHasSplitters: Boolean;
    FSplitterCursor: TCursor;
    procedure SetHasSplitters(const Value: Boolean);
  protected
    function GetSplitterCursor: TCursor; override;
    procedure ValidateAlignment(Child: TaqCustomDockingControl;
      var AAlignment: TaqDockingAlignment); override;
    function IsValidChildAlignment(AAlign: TaqDockingAlignment): Boolean; override;
    class function GetChildAlignment: TaqChildAlignment; virtual;
    class function GetPlacementInfoClass: TaqCustomPlacementInfoClass; override;

{$IFDEF VCL}
    procedure CMVisibleChanged(var Message: TMessage); override;
{$ELSE}
    procedure VisibleChanged; override;
{$ENDIF}

    property FirstAlign: TaqDockingAlignment read FFirstAlign;
    property LastAlign: TaqDockingAlignment read FLastAlign;
  public
    constructor Create(AOwner: TComponent); override;

    procedure MaximizeChild(Child: TaqCustomDockingControl); override;
    procedure ArrangeChildren; override;
    procedure ArrangeChildren(StartIndex: Integer; EndIndex: Integer); override;
    procedure RestoreChildren; override;

    property SplitterCursor: TCursor read FSplitterCursor write FSplitterCursor;
    property HasSplitters: Boolean read FHasSplitters write SetHasSplitters;
  end;

  TaqSplitContainerClass = class of TaqSplitContainer;

  TaqVerticalContainer = class(TaqSplitContainer)
  protected
    function GetSplitterSize: Integer; override;
    function GetSplitterConstraints: TPoint; override;
    procedure EndSplitterMove(Coord: Integer); override;
    function FindSplitterInfo(const Coord: TPoint; var Info: TaqSplitterItemInfo): Boolean; override;
    function GetSplitterInfo(var Info: TaqSplitterInfo): Boolean; override;
    function GetSplitterCursor: TCursor; override;
    function AdjustPanelState(Child: TaqCustomDockingControl; OldSize, NewSize: TPoint;
      AState: TaqDockingPanelState): TaqDockingPanelState; override;
    procedure DoChildDock(Index: Integer; Child: TaqCustomDockingControl); override;
    class function GetChildAlignment: TaqChildAlignment; override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetTypeId: Integer; override;
    function UpdateDockingConstraints: Boolean; override;
    procedure UpdateControl; override;
  end;

  TaqHorizontalContainer = class(TaqSplitContainer)
  protected
    function GetSplitterSize: Integer; override;
    function GetSplitterConstraints: TPoint; override;
    procedure EndSplitterMove(Coord: Integer); override;
    function FindSplitterInfo(const Coord: TPoint; var Info: TaqSplitterItemInfo): Boolean; override;
    function GetSplitterInfo(var Info: TaqSplitterInfo): Boolean; override;
    function GetSplitterCursor: TCursor; override;
    function AdjustPanelState(Child: TaqCustomDockingControl; OldSize, NewSize: TPoint;
      AState: TaqDockingPanelState): TaqDockingPanelState; override;
    procedure DoChildDock(Index: Integer; Child: TaqCustomDockingControl); override;
    class function GetChildAlignment: TaqChildAlignment; override;
  public
    constructor Create(AOwner: TComponent); override;
    class function GetTypeId: Integer; override;
    function UpdateDockingConstraints: Boolean; override;
    procedure UpdateControl; override;
  end;

  TaqTabInfo = class(TObject)
  public
    Index: Integer;
    Origin: Integer;
    Size: Integer;
    State: TaqTabItemState;
    Position: TaqTabItemPosition;
    Caption: String; // String --> zuojin
    ImageIndex: Integer;
  end;

  TaqTabInfoList = class(TObjectList)
  private
    function GetItems(Index: Integer): TaqTabInfo;
    procedure SetItems(Index: Integer; const Value: TaqTabInfo);
  public
    property Items[Index: Integer]: TaqTabInfo read GetItems write SetItems; default;
    procedure SetDirty(ChildIndex: Integer; Caption: String; ImageIndex: Integer);
  end;

  TaqTabHitInfo = (thNone, thButton, thTab, thTabButton);
  TaqTabHitInfoRec = record
    HitInfo: TaqTabHitInfo;