aqdockingreg.pas.~1~

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 aqDockingReg;

{$I aqDockingVer.inc}

interface

uses
  Classes;

procedure Register;

implementation

uses
  SysUtils, Types, ToolsAPI, ComponentDesigner, DesignEditors, DesignIntf,
  TypInfo, StrUtils,
{$IFDEF VCL}
  Graphics, Controls, Forms, Dialogs, Windows, VCLEditors, ShellAPI,
  aqDockingUIThemed,
{$ELSE}
  QGraphics, QControls, QForms, QDialogs,
{$ENDIF}
  aqDockingConst, aqDocking, aqDockingBase, aqDockingUtils, aqDockingUI,
  aqStyleEditorForm;

resourcestring
  SPalletteName = 'AutomatedQA';
  SDockingSetupItem = '&Setup...';
  SStylesEditItem = '&Edit Styles...';

  SEManagerPropertyNotAssigned = 'Cannot customize docking manager. Please associate the docking site "%s" with the docking manager';

type
  TaqDockingControlFriend = class(TaqDockingControl);
  TPersistentFriend = class(TPersistent);
  TComponentFriend = class(TComponent);
  TaqDockingManagerFriend = class(TaqDockingManager);
  TaqStyleManagerFriend = class(TaqStyleManager);

  { TaqDelphiDesigner impements designer interface for Delphi IDE }

  TaqDelphiDesigner = class(TInterfacedObject, IaqCustomDesigner)
  protected
    procedure Modified(Instance: TPersistent);
    procedure SelectComponent(Manager: TComponent; Component: TPersistent); overload;
    procedure SelectComponent(Component: TPersistent); overload;
    function UniqueName(Owner: TComponent; const BaseName: string): string;
  end;

  TaqDockingManagerEditor = class(TComponentEditor)
  protected
    function GetManager: TaqDockingManagerFriend; virtual;
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TaqDockingSiteEditor = class(TaqDockingManagerEditor)
  protected
    function GetManager: TaqDockingManagerFriend; override;
  end;

  TaqDockingControlEditor = class(TaqDockingManagerEditor)
  protected
    function GetManager: TaqDockingManagerFriend; override;
  end;

  TaqDockingControlsEditor = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

{$IFDEF VCL}
  TaqCaptionButtonFriend = class(TaqCaptionButton);
  TaqCaptionButtonWidgetsFriend = class(TaqCaptionButtonWidgets);
  TaqThemedUIStyleFriend = class(TaqThemedUIStyle);

  TaqCaptionButtonProperty = class(TComponentProperty)
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

  TaqButtonWidgetProperty = class(TEnumProperty, ICustomPropertyListDrawing)
  private
    FWidgetSize: Integer;
    function GetStyle: TaqThemedUIStyleFriend;
  protected
    function StrToWidget(const AText: string): TaqCaptionButtonWidget;
    property Style: TaqThemedUIStyleFriend read GetStyle;
  public
    constructor Create(const ADesigner: IDesigner; APropCount: Integer); override;
    function GetAttributes: TPropertyAttributes; override;
    procedure ListDrawValue(const Value: string; ACanvas: TCanvas;
      const ARect: TRect; ASelected: Boolean);
    procedure ListMeasureHeight(const Value: string; ACanvas: TCanvas;
      var AHeight: Integer);
    procedure ListMeasureWidth(const Value: string; ACanvas: TCanvas;
      var AWidth: Integer);
  end;

{$ENDIF}

  TaqStyleProperty = class(TComponentProperty)
  private
    function GetManager: TaqDockingManager;
  protected
    property Manager: TaqDockingManager read GetManager;
  public
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

  TaqStyleManagerEditor = class(TComponentEditor)
  private
    function GetManager: TaqStyleManager;
  public
    procedure Edit; override;
    procedure ExecuteVerb(Index: Integer); override;
    function GetVerb(Index: Integer): string; override;
    function GetVerbCount: Integer; override;
  end;

  TaqStylesEditor = class(TPropertyEditor)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
  end;

  TActiveControlProperty = class(TComponentProperty)
  private
    FNames: TStrings;
    procedure DoAddComponentName(const AName: string);
    function GetDockingControl: TaqDockingControl;
  protected
    property DockingControl: TaqDockingControl read GetDockingControl;
  public
    procedure GetValues(Proc: TGetStrProc); override;
  end;

  TaqDockingStyleStyleProperty = class(TClassProperty)
  protected
    function HasSubProperties: Boolean;
  public
    function GetAttributes: TPropertyAttributes; override;
    function GetValue: string; override;
    procedure GetValues(Proc: TGetStrProc); override;
    procedure SetValue(const Value: string); override;
  end;

{$IFDEF VCL}
const
  FWidgetNames: array [TaqCaptionButtonWidget] of string = (
    'bwNone', 'bwDropDown', 'bwSysButton', 'bwMDISysButton',
    'bwMinButton', 'bwMDIMinButton', 'bwMaxButton', 'bwCloseButton',
    'bwSmallCloseButton', 'tbwMDICloseButton', 'bwRestoreButton', 'bwMDIRestoreButton',
    'bwHelpButton', 'bwMDIHelpButton', 'bwPushButton', 'bwSpinUp',
    'bwSpinDown', 'bwSpinRight', 'bwSpinLeft', 'bwPin', 'bwRotatedPin');

{$ENDIF}

{ private routines }

procedure GetDesigner(Obj: TPersistent; out Result: IDesignerNotify);
var
  Temp: TPersistent;
begin
  Result := nil;
  if Obj = nil then
    Exit;
  Temp := TPersistentFriend(Obj).GetOwner;
  if Temp <> nil then
  begin
    if (Obj is TComponent) and not (csDesigning in TComponent(Obj).ComponentState) then
      Exit;
    GetDesigner(Temp, Result);
  end
  else if (Obj is TComponent) and (csDesigning in TComponent(Obj).ComponentState) then
    TComponentFriend(Obj).QueryInterface(IDesignerNotify, Result);
end;

{ TaqDelphiDesigner }

procedure TaqDelphiDesigner.Modified(Instance: TPersistent);
var
  Designer: IDesignerNotify;
begin
  if Instance <> nil then
  begin
    GetDesigner(Instance, Designer);
    if Designer <> nil then
      Designer.Modified;
  end;
end;

procedure TaqDelphiDesigner.SelectComponent(
  Manager: TComponent; Component: TPersistent);
{$IFDEF VCL}
var
  Designer: IDesigner;
  DesignerHook: IDesignerHook;
{$ENDIF}
begin
{$IFDEF VCL}
  if (Component = nil) or not (Manager is TaqCustomDockingManager) or
    ((Component is TComponent) and (csDestroying in TComponent(Component).ComponentState)) or
    (csDestroying in Manager.ComponentState) then
      Exit;

  if (Manager is TaqDockingManager) and (TaqDockingManagerFriend(Manager).OwnerForm <> nil) and
    (TaqDockingManagerFriend(Manager).UpdateCount = 0) then
  begin
    DesignerHook := TaqDockingManagerFriend(Manager).OwnerForm.Designer;
    if DesignerHook <> nil then
    begin
      if Supports(DesignerHook, IDesigner, Designer) then
        Designer.SelectComponent(Component)
      else
      begin
        Assert(False);
        Exit;
      end;
    end
    else
      SelectComponent(Component);
  end;
{$ELSE}
  SelectComponent(Component);
{$ENDIF}
end;

procedure TaqDelphiDesigner.SelectComponent(
  Component: TPersistent);
var
  Designer: IDesigner;
  List: IDesignerSelections;
begin
  if ComponentDesigner.ActiveRoot <> nil then
  begin
    Designer := ComponentDesigner.ActiveRoot.GetDesigner;
    if Designer <> nil then
    begin
      List := CreateSelectionList;
      try
        Designer.GetSelections(List);
        if (List.Count <> 1) or (List.Items[0] <> Component) then
          Designer.SelectComponent(Component);
      except
        // Sometimes this code results in AV.
      end;
    end;
  end;
end;

function TaqDelphiDesigner.UniqueName(Owner: TComponent; const BaseName: string): string;
var
  Designer: IDesigner;
begin
  if ComponentDesigner.ActiveRoot <> nil then
  begin
    Designer := ComponentDesigner.ActiveRoot.GetDesigner;
    if Designer <> nil then
      Result := Designer.UniqueName(BaseName)
  end
  else
    Result := BaseName;
end;

{ TaqDockingManagerEditor }

procedure TaqDockingManagerEditor.Edit;
begin
{$IFDEF VCL}
  ExecuteVerb(0);
{$ELSE}
  // The docking manager's setup dialog cannot be called here,
  // since double-click events are not processed in CLX.
{$ENDIF}
end;

procedure TaqDockingManagerEditor.ExecuteVerb(Index: Integer);
begin
  case Index of
    0: GetManager.Customize(True);
{$IFDEF VCL}
    3: ShellExecute(0, '', SAutomatedQAUrl, '', '', 0);
{$ENDIF}
  end;
end;

function TaqDockingManagerEditor.GetManager: TaqDockingManagerFriend;
begin
  Result := TaqDockingManagerFriend(Component);
end;

function TaqDockingManagerEditor.GetVerb(Index: Integer): string;
begin
  case Index of
    0: Result := SDockingSetupItem;
    1: Result := '-';
    2: Result := Format('%s %s', [SProductName, SProductVersion]);
    3: Result := SAutomatedQA;
  end;
end;

function TaqDockingManagerEditor.GetVerbCount: Integer;
begin
  Result := 4;
end;

{ TaqDockingSiteEditor }

function TaqDockingSiteEditor.GetManager: TaqDockingManagerFriend;
begin
  Result := TaqDockingManagerFriend(TaqDockingSite(Component).DockingManager);
  if Result = nil then
    raise Exception.CreateFmt(SEManagerPropertyNotAssigned, [Component.Name]);
end;