aqstyleeditorform.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 aqStyleEditorForm;

interface

{$I aqDockingVer.inc}

uses
  Variants, Classes, SysUtils,
{$IFDEF VCL}
  Windows, Messages, Graphics, Controls, Forms, Dialogs, ImgList, ActnList,
  ToolWin, ComCtrls, ExtCtrls, Menus,
{$ELSE}
  QGraphics, QControls, QForms, QDialogs, QImgList, QActnList, QComCtrls,
  QExtCtrls, QMenus, QTypes,
{$ENDIF}
  aqDockingUI, aqDockingBase, aqDockingUtils;

type
  TfrmStyleEditor = class(TForm)
    ControlBar1: TControlBar;
    tlbStyles: TToolBar;
    alStyles: TActionList;
    ilStyles: TImageList;
    lvStyles: TListView;
    actStyleNew: TAction;
    actStyleReset: TAction;
    actStyleDelete: TAction;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    pmStyles: TPopupMenu;
    Delete1: TMenuItem;
    Reset1: TMenuItem;
    N1: TMenuItem;
    actStyleRename: TAction;
    Rename1: TMenuItem;
    pmPredefinedStyles: TPopupMenu;
    miNew: TMenuItem;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormActivate(Sender: TObject);
    procedure actStyleNewExecute(Sender: TObject);
    procedure lvStylesChanging(Sender: TObject; Item: TListItem;
      Change: TItemChange; var AllowChange: Boolean);
    procedure lvStylesSelectItem(Sender: TObject; Item: TListItem;
      Selected: Boolean);
    procedure actStyleDeleteUpdate(Sender: TObject);
    procedure actStyleDeleteExecute(Sender: TObject);
    procedure actStyleResetExecute(Sender: TObject);
    procedure actStyleRenameUpdate(Sender: TObject);
    procedure actStyleRenameExecute(Sender: TObject);
    procedure lvStylesEditing(Sender: TObject; Item: TListItem;
      var AllowEdit: Boolean);
    procedure pmPredefinedStylesPopup(Sender: TObject);
    procedure pmStylesPopup(Sender: TObject);
{$IFDEF VCL}
    procedure lvStylesEdited(Sender: TObject; Item: TListItem;
      var S: String);
{$ELSE}
    procedure lvStylesEdited(Sender: TObject; Item: TListItem;
      var S: WideString);
{$ENDIF}
  private
    FManager: TaqStyleManager;
    FLink: TaqStylesChangeLink;
    FUpdating: Boolean;
    procedure StyleRegister(Style: TaqDockingUIStyle);
    procedure StyleUnregister(Style: TaqDockingUIStyle);
    procedure StyleChange(Style: TaqDockingUIStyle);
    function GetSelected: TaqDockingUIStyle;
    procedure SetSelected(const Value: TaqDockingUIStyle);
    procedure PredefinedStyleClick(Sender: TObject);
    procedure UpdateDesigner;
    procedure UpdateForm;
  protected
    procedure Notification(AComponent: TComponent;
      Operation: TOperation); override;
  public
    constructor CreateEx(AManager: TaqStyleManager);
    destructor Destroy; override;

    property Manager: TaqStyleManager read FManager;
    property Selected: TaqDockingUIStyle read GetSelected write SetSelected;
  end;

procedure ShowStyleEditor(AManager: TaqStyleManager; AShow: Boolean);

implementation

uses
  Contnrs, aqDockingUIDefault;

resourcestring
  SStyleEditorCaption = 'Editing %s';
  SResetConfirm = 'Clear all user-defined styles and add the set of default styles ?';
  SDeleteConfirm = 'Delete selected style ?';
  
var
  FEditors: TObjectBucketList;

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

procedure ShowStyleEditor(AManager: TaqStyleManager; AShow: Boolean);
var
  EditorForm: TfrmStyleEditor;
begin
  if AShow then
    if FEditors.Find(AManager, Pointer(EditorForm)) then
      EditorForm.BringToFront
    else
    begin
      EditorForm := TfrmStyleEditor.CreateEx(AManager);
      EditorForm.Show;
    end
  else if FEditors.Find(AManager, Pointer(EditorForm)) then
    EditorForm.Free;
end;

{ TfrmStyleEditor }

constructor TfrmStyleEditor.CreateEx(AManager: TaqStyleManager);
begin
  inherited Create(Application);
  FEditors.Add(Amanager, Self);
  FManager := AManager;
  FLink := TaqStylesChangeLink.Create(Self);
  FLink.OnRegister := StyleRegister;
  FLink.OnUnRegister := StyleUnregister;
  FLink.OnChange := StyleChange;
  FManager.RegisterChanges(FLink);
  UpdateForm;
  if Manager.Items.Count > 0 then
    Selected := Manager.Items[0];
  pmPredefinedStylesPopup(pmPredefinedStyles);
end;

destructor TfrmStyleEditor.Destroy;
begin
  FEditors.Remove(FManager);
  FManager.UnRegisterChanges(FLink);
  FLink.Free;
  inherited;
end;

function TfrmStyleEditor.GetSelected: TaqDockingUIStyle;
begin
  if lvStyles.Selected <> nil then
    Result := TaqDockingUIStyle(lvStyles.Selected.Data)
  else
    Result := nil;
end;

procedure TfrmStyleEditor.StyleChange(Style: TaqDockingUIStyle);
begin
  UpdateForm;
end;

procedure TfrmStyleEditor.StyleRegister(Style: TaqDockingUIStyle);
begin
  UpdateForm;
end;

procedure TfrmStyleEditor.StyleUnregister(Style: TaqDockingUIStyle);
begin
  UpdateForm;
end;

procedure TfrmStyleEditor.UpdateForm;
var
  i: Integer;
  Style: TaqDockingUIStyle;
begin
  Caption := Format(SStyleEditorCaption, [Manager.GetNamePath]);
  FUpdating := True;
  lvStyles.Items.BeginUpdate;
  Style := Selected;
  try
    lvStyles.Items.Clear;
    for i := 0 to Manager.Items.Count - 1 do
      with lvStyles.Items.Add do
      begin
        Caption := Manager.Items[i].Caption;
        SubItems.Text := aqDockingUIStyles.Names[TPersistentClass(Manager.Items[i].ClassType)];
        Data := Manager.Items[i];
      end;
  finally
    Selected := Style;
    lvStyles.Items.EndUpdate;
    FUpdating := False;
    UpdateDesigner;
  end;
end;

procedure TfrmStyleEditor.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  if not (csDestroying in Manager.ComponentState) then
    aqIDEDesigner.SelectComponent(Manager);
  Action := caFree;
end;

procedure TfrmStyleEditor.actStyleNewExecute(Sender: TObject);
var
  Style, OldSelected: TaqDockingUIStyle;
begin
  if Selected <> nil then
  begin
    OldSelected := Selected;
    Style := Manager.Items.Add(TaqDockingUIStyleClass(OldSelected.ClassType));
    Style.Assign(OldSelected);
    Selected := Style;
  end
  else
    Selected := Manager.Items.Add(TaqDefaultUIStyle);
end;

procedure TfrmStyleEditor.lvStylesChanging(Sender: TObject;
  Item: TListItem; Change: TItemChange; var AllowChange: Boolean);
begin
  if FUpdating then Exit;
  lvStyles.Tag := lvStyles.Tag + 1;
end;

procedure TfrmStyleEditor.lvStylesSelectItem(Sender: TObject;
  Item: TListItem; Selected: Boolean);
begin
  if FUpdating then Exit;
  if ((lvStyles.Tag = 1) or Selected) and not (csDestroying in ComponentState) then
    UpdateDesigner;
  lvStyles.Tag := 0;
end;

procedure TfrmStyleEditor.actStyleDeleteUpdate(Sender: TObject);
begin
  TCustomAction(Sender).Enabled := Selected <> nil;
end;

function ShowQuestion(const Text, Caption: string): Boolean;
begin
{$IFDEF VCL}
  Result := Application.MessageBox(PChar(Text),
    PChar(Caption), mb_YesNo or mb_IconQuestion) = mrYes;
{$ELSE}
  Result := Application.MessageBox(Text,
    Caption, [smbYes, smbNo], smsWarning) = smbYes;
{$ENDIF}
end;

procedure TfrmStyleEditor.actStyleDeleteExecute(Sender: TObject);
begin
  if (Selected <> nil) and ShowQuestion(SDeleteConfirm, Caption) then
    Selected.Free;
end;

procedure TfrmStyleEditor.actStyleResetExecute(Sender: TObject);
begin
  if (Manager.Items.Count = 0) or ShowQuestion(SResetConfirm, Caption) then
    Manager.Reset;
end;

procedure TfrmStyleEditor.actStyleRenameUpdate(Sender: TObject);
begin
  TCustomAction(Sender).Enabled := (Selected <> nil) and not Selected.Predefined;
end;

procedure TfrmStyleEditor.actStyleRenameExecute(Sender: TObject);
begin
  aqEditCaption(lvStyles.Selected);
end;

procedure TfrmStyleEditor.lvStylesEditing(Sender: TObject; Item: TListItem;
  var AllowEdit: Boolean);
begin
  AllowEdit := Selected <> nil;
  if AllowEdit then
    AllowEdit := not Selected.Predefined;
end;


{$IFDEF VCL}
procedure TfrmStyleEditor.lvStylesEdited(Sender: TObject; Item: TListItem;
  var S: String);
{$IFDEF DUMMY}begin end;{$ENDIF}
{$ELSE}
procedure TfrmStyleEditor.lvStylesEdited(Sender: TObject; Item: TListItem;
  var S: WideString);
{$ENDIF}
begin
  if (Selected <> nil) and not Selected.Predefined then
    Selected.Caption := S;
end;

procedure TfrmStyleEditor.SetSelected(const Value: TaqDockingUIStyle);
var
  Item: TListItem;
begin
  if Value <> nil then
  begin
    Item := lvStyles.FindData(0, Value, True, False);
    if lvStyles.ItemFocused <> Item then
    begin
      lvStyles.ItemFocused := Item;
      lvStyles.Selected := Item;
    end;
  end;
end;

procedure TfrmStyleEditor.pmPredefinedStylesPopup(Sender: TObject);
var
  i: Integer;
  Item: TMenuItem;
begin
  pmPredefinedStyles.Items.Clear;
  Item := TMenuItem.Create(pmPredefinedStyles);
  Item.Action := actStyleNew;
{$IFDEF VCL}
  Item.Default := True;
{$ENDIF}
  pmPredefinedStyles.Items.Add(Item);
  pmPredefinedStyles.Items.InsertNewLineAfter(Item);

  for i := 0 to aqDockingUIStyles.Count - 1 do
  begin
    Item := TMenuItem.Create(pmPredefinedStyles);
    Item.Tag := Integer(aqDockingUIStyles[i]);
    Item.Caption := aqDockingUIStyles.GetClassName(i);
    Item.OnClick := PredefinedStyleClick;
    pmPredefinedStyles.Items.Add(Item);
  end;
end;

procedure TfrmStyleEditor.PredefinedStyleClick(Sender: TObject);
begin
  Selected := Manager.Items.Add(TaqDockingUIStyleClass(TMenuItem(Sender).Tag));
end;

procedure TfrmStyleEditor.pmStylesPopup(Sender: TObject);
var
  i: Integer;
  Item: TMenuItem;
begin
  pmPredefinedStylesPopup(pmPredefinedStyles);
  miNew.Clear;
  for i := 0 to pmPredefinedStyles.Items.Count - 1 do
  begin
    Item := TMenuItem.Create(miNew);
    if pmPredefinedStyles.Items[i].Action <> nil then
      Item.Action := pmPredefinedStyles.Items[i].Action
    else
    begin
      Item.Tag := pmPredefinedStyles.Items[i].Tag;
      Item.ImageIndex := pmPredefinedStyles.Items[i].ImageIndex;
      Item.Caption := pmPredefinedStyles.Items[i].Caption;
      Item.OnClick := pmPredefinedStyles.Items[i].OnClick;
    end;
    miNew.Add(Item);
  end;
end;

procedure TfrmStyleEditor.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if Operation = opRemove then
  begin
    if AComponent = FManager then
      ShowStyleEditor(FManager, False);
  end
  else
    inherited;
end;

procedure TfrmStyleEditor.FormActivate(Sender: TObject);
begin
  UpdateDesigner;
end;

procedure TfrmStyleEditor.UpdateDesigner;
begin
  if (Selected <> nil) and not (csDestroying in Selected.ComponentState) then
    aqIDEDesigner.SelectComponent(Selected)
  else if not (csDestroying in Manager.ComponentState) then
    aqIDEDesigner.SelectComponent(Manager);
end;

initialization
  FEditors := TObjectBucketList.Create;
finalization
  FEditors.Free;
end.