aqdockcustform.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 aqDockCustForm;

{$I aqDockingVer.inc}

interface

uses
  SysUtils, Types, Contnrs,
{$IFDEF VCL}
  Graphics, Controls, Forms, Dialogs, StdCtrls, ComCtrls, ExtCtrls,
  AppEvnts, Menus, Buttons,
{$ELSE}
  QGraphics, QControls, QForms, QDialogs, QStdCtrls, QComCtrls, QExtCtrls,
  QMenus, QTypes,
{$ENDIF}
  Classes, aqDocking, aqDockingBase, aqDockingUI;

type
  TaqDockingManagerFriend = class(TaqDockingManager);
  
  TfrmDockingSetup = class(TForm)
    pgcDockSetup: TPageControl;
    Panel1: TPanel;
    btnClose: TButton;
    tsPanels: TTabSheet;
    Panel3: TPanel;
    Panel2: TPanel;
    Panel4: TPanel;
    tsStyles: TTabSheet;
    tsSettings: TTabSheet;
    chkAutoDrag: TCheckBox;
    GroupBox2: TGroupBox;
    chkHelp: TCheckBox;
    chkHide: TCheckBox;
    chkUndock: TCheckBox;
    chkMax: TCheckBox;
    chkAutoHideButtons: TCheckBox;
    chkFloatOnTop: TCheckBox;
    GroupBox1: TGroupBox;
    chkShowInside: TCheckBox;
    chkShowVert: TCheckBox;
    chkShowHor: TCheckBox;
    pnlStyleWarn: TPanel;
    Label1: TLabel;
    Image1: TImage;
    Panel6: TPanel;
    lblStyles: TLabel;
    lvStyles: TListView;
    btnApply: TButton;
    pnlSiteWarn: TPanel;
    Label2: TLabel;
    Image2: TImage;
    Panel7: TPanel;
    lblPanels: TLabel;
    lvPanels: TListView;
    btnNew: TButton;
    btnRename: TButton;
    btnDelete: TButton;
    Bevel1: TBevel;
    btnShow: TButton;
    chkMenu: TCheckBox;
    chkShowHint: TCheckBox;
    btnHide: TButton;
    chkCustom: TCheckBox;
    procedure btnNewClick(Sender: TObject);
{$IFDEF VCL}
    procedure lvPanelsEdited(Sender: TObject; Item: TListItem;
      var S: String);
{$ELSE}
    procedure lvPanelsEdited(Sender: TObject; Item: TListItem;
      var S: WideString);
{$ENDIF}
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure btnCloseClick(Sender: TObject);
    procedure btnRenameClick(Sender: TObject);
    procedure lvPanelsEditing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure btnDeleteClick(Sender: TObject);
    procedure btnApplyClick(Sender: TObject);
    procedure btnShowClick(Sender: TObject);
    procedure btnHideClick(Sender: TObject);
    procedure pgcDockSetupChange(Sender: TObject);
    procedure chkAutoDragClick(Sender: TObject);
    procedure chkShowInsideClick(Sender: TObject);
    procedure chkButtonClick(Sender: TObject);
    procedure chkShowHintClick(Sender: TObject);
    procedure chkAutoHideButtonsClick(Sender: TObject);
    procedure lvPanelsSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lvPanelsChanging(Sender: TObject; Item: TListItem;
      Change: TItemChange; var AllowChange: Boolean);
    procedure lvStylesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure lvStylesChanging(Sender: TObject; Item: TListItem;
      Change: TItemChange; var AllowChange: Boolean);
    procedure chkFloatOnTopClick(Sender: TObject);
    procedure chkShowVertClick(Sender: TObject);
    procedure chkShowHorClick(Sender: TObject);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
  private
    FManager: TaqDockingManagerFriend;
    FUpdatePanels, FUpdateSettings, FUpdateStyles: Boolean;
    FDesigning: Boolean;
    FStayOnTop: Boolean;
    FDockSetupDestroying: Boolean;
    function GetSelectedPanel: TaqCustomDockingControl;
    function GetSelectedStyle: TaqDockingUIStyle;
    procedure UpdatePanelList;
    procedure UpdateStyleList;
    procedure UpdateSettings;
    procedure NewPanel;
    procedure RenamePanel;
    procedure DeletePanel;
//    procedure UndockPanel;
    procedure ShowPanel;
    procedure HidePanel;
    function GetItemByControl(AControl: TaqCustomDockingControl): TListItem;
    function GetItemByStyle(AStyle: TaqDockingUIStyle): TListItem;
    function AddPanel(AControl: TaqCustomDockingControl): TListItem;
    function AddStyle(AStyle: TaqDockingUIStyle; const AStyleName: string): TListItem;
    procedure UpdatePage(APage: TTabSheet);
    procedure SelectComponent(AComponent: TPersistent);
    procedure ApplicationEventsActivate(Sender: TObject);
    procedure ApplicationEventsRestore(Sender: TObject);

    property SelectedPanel: TaqCustomDockingControl read GetSelectedPanel;
    property SelectedStyle: TaqDockingUIStyle read GetSelectedStyle;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;

    property Designing: Boolean read FDesigning;
  public
    constructor CreateEx(AManager: TaqDockingManager);
    destructor Destroy; override;

    procedure UpdatePanel(AControl: TaqCustomDockingControl);
    procedure SelectPanel(AControl: TaqCustomDockingControl; AEdit: Boolean);

    procedure SelectPage(const APageName: string);
  end;

   TaqDockingManagerCustomizer = class(TInterfacedObject, IaqDockingManagerCustomizer)
  private
    FCustomizing: Boolean;
    FForm: TfrmDockingSetup;
    FDisabledWindows: TComponentList;
    procedure FormDestroy(Sender: TObject);
  protected
    { IaqDockingManagerCustomizer }
    procedure EnableParentForms(AEnable: Boolean);
    procedure SelectPanel(AControl: TaqCustomDockingControl; AEdit: Boolean);
    procedure ShowDockingSetup(ADockingManager: TaqDockingManager;
      AShow: Boolean = True; const ActivePage: string = '');
    procedure UpdatePanel(AControl: TaqCustomDockingControl);
    function GetCustomizing: Boolean;
  public
    destructor Destroy; override;
  end;

implementation

{$IFDEF VCL}
{$R *.dfm}
{$ELSE}
{$R *.xfm}
{$ENDIF}

uses
{$IFDEF VCL}
  Windows,
{$ELSE}
  Qt,
{$ENDIF}
  aqDockingConst, aqDockingUtils;

type
  TaqControlFriend = class(TaqControl);
  TListViewFriend = class(TListView);

{$J+}
const
  LastPos: TPoint = (X: -1; Y: -1);
{$J-}

destructor TaqDockingManagerCustomizer.Destroy;
begin
  ShowDockingSetup(nil, False);
  inherited;
end;

procedure TaqDockingManagerCustomizer.EnableParentForms(AEnable: Boolean);
var
  I: Integer;
begin
  if AEnable then
  begin
    if FDisabledWindows <> nil then
      for I := 0 to FDisabledWindows.Count - 1 do
      begin
{$IFDEF VCL}
        EnableWindow(TCustomForm(FDisabledWindows[i]).Handle, True);
{$ELSE}
        QWidget_setEnabled(TCustomForm(FDisabledWindows[i]).Handle, True);
{$ENDIF}
        TCustomForm(FDisabledWindows[i]).Enabled := True;
      end;
    FreeAndNil(FDisabledWindows);
  end
  else
  begin
    FDisabledWindows := TComponentList.Create(False);
    for I := 0 to aqDockingManagers.Count - 1 do
      with TaqDockingManagerFriend(aqDockingManagers[I]) do
        if OwnerForm.HandleAllocated and OwnerForm.Enabled then
        begin
{$IFDEF VCL}
          EnableWindow(OwnerForm.Handle, False);
{$ELSE}
          QWidget_setEnabled(OwnerForm.Handle, False);
{$ENDIF}
          FDisabledWindows.Add(OwnerForm);
        end;
  end;
end;

procedure TaqDockingManagerCustomizer.FormDestroy(Sender: TObject);
begin
  EnableParentForms(True);
  FForm := nil;
end;

procedure TaqDockingManagerCustomizer.SelectPanel(AControl: TaqCustomDockingControl; AEdit: Boolean);
begin
  if FForm <> nil then
    FForm.SelectPanel(AControl, AEdit);
end;

procedure TaqDockingManagerCustomizer.ShowDockingSetup(ADockingManager: TaqDockingManager;
  AShow: Boolean = True; const ActivePage: string = '');
begin
  if AShow then
  begin
    if FForm <> nil then
      with FForm do
      begin
        SelectPage(ActivePage);
        BringToFront;
      end
    else
    begin
      FCustomizing := True;
      EnableParentForms(False);
      FForm := TfrmDockingSetup.CreateEx(ADockingManager);
      with FForm do
      begin
        OnDestroy := FormDestroy;
        SelectPage(ActivePage);
        Show;
        BringToFront;
        SetFocus;
      end;
    end;
  end
  else
  begin
    FCustomizing := False;
    if (FForm <> nil) and not FForm.FDockSetupDestroying then
    begin
      FForm.Release;
      FForm := nil;
    end;
  end;
end;

procedure TaqDockingManagerCustomizer.UpdatePanel(AControl: TaqCustomDockingControl);
begin
  if FForm <> nil then
    FForm.UpdatePanel(AControl);
end;

function TaqDockingManagerCustomizer.GetCustomizing: Boolean;
begin
  Result := FCustomizing;
end;

{ TfrmDockingSetup }

constructor TfrmDockingSetup.CreateEx(AManager: TaqDockingManager);
var
  i: Integer;
  Page: TTabSheet;
  GetCaption: function: string of object;
begin
  Assert(AManager <> nil);
  FManager := TaqDockingManagerFriend(AManager);
  FDesigning := csDesigning in FManager.ComponentState;

  inherited Create(Application);

  BorderIcons := [biSystemMenu];
  // Store the FloatingFormsOnTop setting and disable it.
  FStayOnTop := FManager.FloatingFormOnTop;
  FManager.FloatingFormOnTop := False;
{$IFDEF VCL}
  lvPanels.SmallImages := FManager.Images;
{$ELSE}
  lvPanels.Images := FManager.Images;
{$ENDIF}

  if (LastPos.X <> -1) or (LastPos.Y <> -1) then
  begin
    Position := poDesigned;
    SetBounds(LastPos.X, LastPos.Y, Width, Height);
  end
  else
    Position := poScreenCenter;

  if not Designing then
     tsPanels.PageControl := nil;

  UpdatePanelList;
  UpdateStyleList;
  UpdateSettings;

  if not FDesigning then
  begin
    for i := 0 to FManager.CustomPages.Count - 1 do
    begin
      Page := TTabSheet.Create(pgcDockSetup);
      Page.PageControl := pgcDockSetup;
      with TCustomFrame(FManager.CustomPages[i]) do
      begin
        Parent := Page;
        Align := alClient;
        Visible := True;
      end;

      TMethod(GetCaption).Data := FManager.CustomPages[i];
      TMethod(GetCaption).Code := FManager.CustomPages[i].MethodAddress('GetCaption');
      if TMethod(GetCaption).Code <> nil then
        Page.Caption := GetCaption;
    end;
  end;

{$IFDEF VCL}
  with TApplicationEvents.Create(Self) do
  begin
    OnActivate := ApplicationEventsActivate;
    OnRestore := ApplicationEventsRestore;
  end;
{$ELSE}
  Application.OnActivate := ApplicationEventsActivate;
  Application.OnRestore := ApplicationEventsRestore;
  lvPanels.Columns[0].Width := lvPanels.ClientWidth - 4;
  lvStyles.Columns[0].Width := lvStyles.ClientWidth - 4;
{$ENDIF}
  pgcDockSetup.ActivePageIndex := 0;
  TaqControlFriend(pgcDockSetup.ActivePage).SelectFirst;
  pgcDockSetupChange(pgcDockSetup);
end;

procedure TfrmDockingSetup.UpdatePanelList;
var
  i: Integer;
  Item: TListItem;
begin
  if tsPanels.PageControl = nil then Exit;

  FUpdatePanels := True;
  try
    lvPanels.Items.Clear;
    for i := 0 to FManager.Items.Count - 1 do
      AddPanel(FManager.Items[i]);
    if lvPanels.Items.Count > 0 then
    begin
      Item := lvPanels.Items[0];
      Item.Selected := True;
      Item.Focused := True;
      aqMakeVisible(Item);
    end;
    pnlSiteWarn.Visible := FManager.MainDockSite = nil;
  finally
    FUpdatePanels := False;
    UpdatePage(tsPanels);
  end;
end;

procedure TfrmDockingSetup.btnNewClick(Sender: TObject);
begin
  NewPanel;
end;

procedure TfrmDockingSetup.NewPanel;
var
  Control: TaqCustomDockingControl;
  Item: TListItem;
begin
  Control := FManager.Items.Add;
  Control.ForceVisible;

  Item := AddPanel(Control);
  Item.Focused := True;
  Item.Selected := True;
  aqMakeVisible(Item);

  SelectComponent(Control);
  TListViewFriend(lvPanels).Click;
end;

procedure TfrmDockingSetup.lvPanelsEdited(Sender: TObject; Item: TListItem;
  var S: {$IFDEF VCL}String{$ELSE}WideString{$ENDIF});
begin
  TaqCustomDockingControl(Item.Data).Caption := S;
  aqIDEDesigner.Modified(TaqCustomDockingControl(Item.Data));
  btnClose.Default := True;
end;

destructor TfrmDockingSetup.Destroy;
var
  AManager: TaqDockingManager;
  i: Integer;
begin
{$IFNDEF VCL}
  Application.OnActivate := nil;
  Application.OnRestore := nil;
  SetCaptureControl(nil);
{$ENDIF}
  if not FDockSetupDestroying then
  begin
    FDockSetupDestroying := True;
    if not FDesigning then
      for i := 0 to FManager.CustomPages.Count - 1 do
        with TCustomFrame(FManager.CustomPages[i]) do
        begin
          Align := alNone;
{$IFDEF VCL}
          Parent := nil;
{$ELSE}
          // Fix for CLX: a widget fails by assigning a nil parent to it.
          // So we are doomed to use a temporary parent for the frame.
          Parent := FManager.NullDockingSite;
{$ENDIF}
        end;
    // Apply back FloatingFormsOnTop setting.
    FManager.FloatingFormOnTop := FStayOnTop;
    // Hide this form in a standard manner.
    FManager.Customize(False);
  end;
  AManager := FManager;

  inherited Destroy;

  FDockSetupDestroying := False;

   // Select manager's component after the form closes.
  if (AManager <> nil) and not (csDestroying in AManager.ComponentState) then
    aqIDEDesigner.SelectComponent(AManager, AManager);
end;

procedure TfrmDockingSetup.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  Action := caFree;
  LastPos.X := Left; LastPos.Y := Top;
end;

procedure TfrmDockingSetup.btnCloseClick(Sender: TObject);
begin
  Close;
end;

function TfrmDockingSetup.AddPanel(AControl: TaqCustomDockingControl): TListItem;
begin