aqdockingui.pas

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

      AOrientation: TaqHideZoneOrientation);
    procedure DrawHiddenTabItem(ACanvas: TCanvas; ARect: TRect;
      const AText: string; AState: TaqTabItemState;
      AOrientation: TaqHideZoneOrientation; APosition: TaqTabItemPosition; ADrawImage, ADrawText: Boolean;
      AImages: TCustomImageList; AImageIndex: Integer);

    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    procedure SetParentComponent(AParent: TComponent); override;
    function GetNamePath: string; override;

    function GetCaptionButtonSize: TPoint;

    property ActiveHiddenTabFont: TFont read FActiveHiddenTabFont write SetActiveHiddenTabFont;
    property ActiveCaptionFont: TFont read FActiveCaptionFont write SetActiveCaptionFont;
    property ActiveTabFont: TFont read FActiveTabFont write SetActiveTabFont;
    property HiddenTabFont: TFont read FHiddenTabFont write SetHiddenTabFont;
    property Caption: string read GetCaption write SetCaption;
    property CaptionButtonSize: Integer read FCaptionButtonSize write SetCaptionButtonSize;
    property CaptionButtonWidthRatio: Real read FCaptionButtonWidthRatio write SetCaptionButtonWidthRatio;
    property CaptionButtonPositions: TaqCaptionButtonPostions read GetCaptionButtonsPosition;
    property CaptionFont: TFont read FCaptionFont write SetCaptionFont;
    property Index: Integer read GetIndex;
    property Metrics[AMetric: TaqDockingUIMetric]: Integer read GetMetric write SetMetric; default;
    property Predefined: Boolean read FPredefined;
    property ShowAccelChar: TaqShowAccelChar read FShowAccelChar write SetShowAccelChar;
    property SplitterHeight: Integer read FSplitterHeight write SetSplitterHeight;
    property SplitterWidth: Integer read FSplitterWidth write SetSplitterWidth;
    property StyleManager: TaqStyleManager read FStyleManager write SetStyleManager;
    property TabFont: TFont read FTabFont write SetTabFont;
    property TabIndent: Integer read FTabIndent write SetTabIndent;
    property UniformTabWidth: Boolean read FUniformTabWidth write SetUniformTabWidth default True;
  end;

  TaqStyles = class(TPersistent)
  private
    FChangeLink: TaqStyleChangeLink;
    FOwner: TaqStyleManager;
    FStyles: TStringList;
    function GetItem(Index: Integer): TaqDockingUIStyle;
    procedure InternalAdd(AStyle: TaqDockingUIStyle);
    procedure InternalRemove(AStyle: TaqDockingUIStyle);
    function GetStyleByName(const AStyleName: TaqStyleName): TaqDockingUIStyle;
    procedure StyleChange(Sender: TObject);
    function GetCount: Integer;
    function GetName(Index: Integer): TaqStyleName;
  protected
    procedure AssignTo(Dest: TPersistent); override;
    function GetOwner: TPersistent; override;
    function NewStyleName(AStyle: TaqDockingUIStyle): string;
  public
    constructor Create(AOwner: TaqStyleManager);
    destructor Destroy; override;

    procedure Clear;
    function Add(StyleClass: TaqDockingUIStyleClass): TaqDockingUIStyle;
    function Clone(AIndex: Integer): Integer; overload;
    function Clone(AStyle: TaqDockingUIStyle): TaqDockingUIStyle; overload;
    function Find(AStyle: TaqDockingUIStyle): Integer; overload;
    function Find(const AStyleName: TaqStyleName): Integer; overload;

    property Count: Integer read GetCount;
    property Items[Index: Integer]: TaqDockingUIStyle read GetItem; default;
    property Names[Index: Integer]: TaqStyleName read GetName;
    property StyleByName[const AStyleName: TaqStyleName]: TaqDockingUIStyle read GetStyleByName;
  end;

  TaqStyleManager = class(TComponent)
  private
    FOnChange: TaqStyleNotifyEvent;
    FOnRegister: TaqStyleNotifyEvent;
    FOnUnRegister: TaqStyleNotifyEvent;
    FLinks: TList;
    FItems: TaqStyles;
    procedure SetItems(Value: TaqStyles);
  protected
    procedure DoChangeStyle(Sender: TaqDockingUIStyle);
    procedure DoRegisterStyle(Sender: TaqDockingUIStyle);
    procedure DoUnregisterStyle(Sender: TaqDockingUIStyle);

    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetChildOwner: TComponent; override;

    procedure ValidateRename(AComponent: TComponent;
      const CurName, NewName: string); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure RegisterChanges(ALink: TaqStylesChangeLink);
    procedure UnRegisterChanges(ALink: TaqStylesChangeLink);

    procedure Reset;
  published
    property Items: TaqStyles read FItems write SetItems;

    property OnChange: TaqStyleNotifyEvent read FOnChange write FOnChange;
    property OnRegister: TaqStyleNotifyEvent read FOnRegister write FOnRegister;
    property OnUnRegister: TaqStyleNotifyEvent read FOnUnRegister write FOnUnRegister;
  end;

const
  HOrientations: array [TaqHideZoneOrientation] of TaqOrientation =
    // hzoLeft, hzoTop, hzoRight, hzoBottom, hzoDefault
    (orLeft, orTop, orRight, orBottom, orTop);
  Orientations: array [TaqTabOrientation] of TaqOrientation = (
    orTop,    // dtoTop
    orBottom  // dtoBottom
    );

function aqDockingUIStyles: TaqClassList;

implementation

uses
  aqDockingConst, aqDockingUIDefault, aqDockingUIFlat, aqDockingUIStandard,
  aqDockingUIEnhanced, aqDockingUIVS2005,
{$IFDEF VCL}
  aqDockingUIOfficeXP, aqDockingUIThemed, StdCtrls, Windows, Menus,
{$ELSE}
  QStdCtrls, QMenus,
{$ENDIF}
  Math, SysUtils;

const
  SHeightTestText = 'Wkg';

  MetricBounds: array [TaqDockingUIMetric] of record
    Low: Integer;
    High: Integer;
  end = (
    (Low: 0; High: 30),   // dumTextSpacingX
    (Low: 0; High: 30),   // dumTextSpacingY
    (Low: 0; High: 10),   // uidsCaptionBorderX
    (Low: 0; High: 10),   // uidsCaptionBorderY
    (Low: 0; High: 100),  // dumTabPadding
    (Low: 0; High: 100),  // dumTabTopOffset
    (Low: 0; High: 10),   // dumTabItemBorderX
    (Low: 0; High: 10),   // dumTabItemBorderY
    (Low: 0; High: 10),   // dumTabPaneBorderX
    (Low: 0; High: 10),   // dumTabPaneBorderY
    (Low: 0; High: 100)   // dumTabDefaultButtonSize
  );

var
  FaqDockingUIStyles: TaqClassList;

function aqDockingUIStyles: TaqClassList;
begin
  Result := FaqDockingUIStyles;
end;

{ private routines }

function GetValidName(AComponent: TComponent; const AName: string;
  AIsBaseName: Boolean = False): string;
var
  AOwner: TComponent;
  I: Integer;

  function GetNextName: string;
  begin
    Result := AName + IntToStr(I);
    Inc(I);
  end;

begin
  Result := AName;
  AOwner := AComponent.Owner;
  if AOwner = nil then
    Exit;
  I := 1;
  if AIsBaseName then
    Result := GetNextName;
  while AOwner.FindComponent(Result) <> nil do
    Result := GetNextName;
end;

{ TaqStyleManager }

constructor TaqStyleManager.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLinks := TList.Create;
  FItems := TaqStyles.Create(Self);

  if (AOwner = nil) or not (csLoading in AOwner.ComponentState) then
    Reset;
end;

destructor TaqStyleManager.Destroy;
var
  I: Integer;
begin
  FItems.Free;
  for I := 0 to FLinks.Count - 1 do
    TaqStylesChangeLink(FLinks[I]).Sender := nil;
  FreeAndNil(FLinks);
  inherited Destroy;
end;

procedure TaqStyleManager.DoChangeStyle(Sender: TaqDockingUIStyle);
var
  I: Integer;
begin
   // Notify links.
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
      with TaqStylesChangeLink(FLinks[I]) do
      begin
        Sender := Self;
        Change(TaqDockingUIStyle(Sender));
      end;
   // Dispatch event to handler.
  if Assigned(FOnChange) then FOnChange(TaqDockingUIStyle(Sender));
end;

procedure TaqStyleManager.DoRegisterStyle(Sender: TaqDockingUIStyle);
var
  I: Integer;
begin
   // Notify links.
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
    begin
      TaqStylesChangeLink(FLinks[I]).Sender := Self;
      TaqStylesChangeLink(FLinks[I]).Register(Sender);
    end;
   // Dispatch event to handler.
  if Assigned(FOnRegister) then FOnRegister(Sender);
end;

procedure TaqStyleManager.DoUnregisterStyle(Sender: TaqDockingUIStyle);
var
  I: Integer;
begin
   // Notify links.
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
    begin
      TaqStylesChangeLink(FLinks[I]).Sender := Self;
      TaqStylesChangeLink(FLinks[I]).Unregister(Sender);
    end;
   // Dispatch event to handler.
  if Assigned(FOnUnregister) then FOnUnregister(Sender);
end;

procedure TaqStyleManager.Reset;
var
  i: Integer;
begin
  FItems.Clear;
   // Add predefined styles.
  for i := 0 to aqDockingUIStyles.Count - 1 do
    TaqDockingUIStyleClass(aqDockingUIStyles[i]).CreateEx(Self, True);
end;

procedure TaqStyleManager.RegisterChanges(ALink: TaqStylesChangeLink);
begin
  if FLinks <> nil then
  begin
    ALink.Sender := Self;
    if ALink.Owner <> nil then
      FreeNotification(ALink.Owner);
    FLinks.Add(ALink);
  end;
end;

procedure TaqStyleManager.UnRegisterChanges(ALink: TaqStylesChangeLink);
var
  I: Integer;
begin
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
      if FLinks[I] = ALink then
      begin
        ALink.Sender := nil;
        if ALink.Owner <> nil then
          RemoveFreeNotification(ALink.Owner);
        FLinks.Delete(I);
        Break;
      end;
end;

procedure TaqStyleManager.SetItems(Value: TaqStyles);
begin
  if Value <> nil then
    FItems.Assign(Value)
  else
    Reset;
end;

procedure TaqStyleManager.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
var
  i: Integer;
  AItem: TaqDockingUIStyle;
begin
  for i := 0 to Items.Count - 1 do
  begin
    AItem := Items[i];
    Proc(AItem);
  end;
end;

function TaqStyleManager.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TaqStyleManager.ValidateRename(AComponent: TComponent;
  const CurName, NewName: string);
begin
  if FindComponent(NewName) <> nil then
    FindComponent(NewName).Free;
  inherited;
end;

{ TaqDockingUIStyle }

procedure TaqDockingUIStyle.AssignTo(Dest: TPersistent);
begin
  if Dest is TaqDockingUIStyle then
    with TaqDockingUIStyle(Dest) do
    begin
      BeginUpdate;
      try
        SetMetrics(Self.FMetrics);
        ActiveCaptionFont.Assign(Self.ActiveCaptionFont);
        CaptionFont.Assign(Self.CaptionFont);
        ActiveTabFont.Assign(Self.ActiveTabFont);
        TabFont.Assign(Self.TabFont);
        ShowAccelChar := Self.ShowAccelChar;
      finally
        EndUpdate;
      end;
    end
  else
    inherited;
end;

procedure TaqDockingUIStyle.BeginUpdate;
begin
  Inc(FUpdateCount);
end;

procedure TaqDockingUIStyle.Change;
var
  I: Integer;
begin
  if FUpdateCount > 0 then Exit;
  if FLinks <> nil then
    for I := 0 to FLinks.Count - 1 do
      with TaqStyleChangeLink(FLinks[I]) do
      begin
        Sender := Self;
        Change;
      end;
  if Assigned(FOnChange) then FOnChange(Self);
end;