cxoicollectioned.pas

delphi的的三方控件

{********************************************************************}
{                                                                    }
{       Developer Express Visual Component Library                   }
{       ExpressVerticalGrid                                          }
{                                                                    }
{       Copyright (c) 1998-2007 Developer Express Inc.               }
{       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 DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS    }
{   LICENSED TO DISTRIBUTE THE EXPRESSVERTICALGRID AND ALL           }
{   ACCOMPANYING VCL 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 EXPRESS WRITTEN CONSENT   }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                       }
{                                                                    }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON        }
{   ADDITIONAL RESTRICTIONS.                                         }
{                                                                    }
{********************************************************************}
unit cxOICollectionEd;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  StdCtrls, Menus, ExtCtrls, ComCtrls, ImgList, ActnList, ToolWin, cxOI;

const
  AM_DeferUpdate = WM_USER + 100;  // avoids break-before-make listview ugliness

type
  TcxColOption = (coAdd, coDelete, coMove);
  TcxColOptions = set of TcxColOption;

  { TcxCollectionEditor }

  TcxCollectionEditor = class(TForm, IcxRTTIInspectorHelper)
    acAdd: TAction;
    acDelete: TAction;
    acMoveDown: TAction;
    acMoveUp: TAction;
    acSelectAll: TAction;
    acTextLabels: TAction;
    acToolbar: TAction;
    ImageList: TImageList;
    ListView1: TListView;
    miAdd: TMenuItem;
    miDelete: TMenuItem;
    miMoveDown: TMenuItem;
    miMoveUp: TMenuItem;
    miTextLabels: TMenuItem;
    miToolbar: TMenuItem;
    N1: TMenuItem;
    Panel: TPanel;
    PopupMenu1: TPopupMenu;
    PopupMenu2: TPopupMenu;
    Toolbar1: TToolbar;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    ToolButton5: TToolButton;
    ActionList: TActionList;
    procedure acAddExecute(Sender: TObject);
    procedure acDeleteExecute(Sender: TObject);
    procedure acMoveDownExecute(Sender: TObject);
    procedure acMoveUpExecute(Sender: TObject);
    procedure acSelectAllExecute(Sender: TObject);
    procedure acTextLabelsExecute(Sender: TObject);
    procedure acToolbarExecute(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
    procedure FormKeyPress(Sender: TObject; var Key: Char);
    procedure FormShow(Sender: TObject);
    procedure ListView1Change(Sender: TObject; Item: TListItem; Change: TItemChange);
    procedure ListView1DragDrop(Sender, Source: TObject; X, Y: Integer);
    procedure ListView1DragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
    procedure ListView1KeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure ListView1KeyPress(Sender: TObject; var Key: Char);
    procedure SelectAllCommandUpdate(Sender: TObject);
    procedure SelectionUpdate(Sender: TObject);
  private
    FClosing: Boolean;
    FCollectionPropertyName: string;
    FStateLock: Integer;
    FItemIDList: TList;
    FCollectionClassName: string;
    FSelectionError: Boolean;
    FColOptions: TcxColOptions;
    FInspector: TcxCustomRTTIInspector;
    function GetRegKey: string;
    procedure SetCollectionPropertyName(const Value: string);
    procedure AMDeferUpdate(var Msg); message AM_DeferUpdate;
    procedure SetColOptions(Value: TcxColOptions);
    procedure CloseEditor;
    procedure WMActivate(var Message: TWMActivate); message WM_ACTIVATE;
  protected
    // IcxRTTIInspectorHelper
    procedure CloseNonModal(AInspector: TcxCustomRTTIInspector);
    procedure PropertyChanged(AInspector: TcxCustomRTTIInspector);
    //
    function  CanAdd(Index: Integer): Boolean; virtual;
    procedure Localize; virtual;
    procedure LockState;
    procedure UnlockState;
    property StateLock: Integer read FStateLock;
    procedure SelectAll(DoUpdate: Boolean = True);
    procedure SelectNone(DoUpdate: Boolean = True);
  public
    Collection: TCollection;
    Component: TComponent;
    property Options: TcxColOptions read FColOptions write SetColOptions;
    procedure ItemsModified(AInspector: TcxCustomRTTIInspector); virtual;
    function GetItemName(Index, ItemIndex: Integer): string;
    procedure GetSelection;
    procedure SetSelection;
    procedure UpdateListbox;
    property CollectionPropertyName: string read FCollectionPropertyName
      write SetCollectionPropertyName;
    property Inspector: TcxCustomRTTIInspector read FInspector;
  end;

  TcxCollectionEditorClass = class of TcxCollectionEditor;

  { TcxCollectionProperty }

  TcxCollectionProperty = class(TcxClassProperty)
  public
    destructor Destroy; override;
    procedure Edit; override;
    function GetAttributes: TcxPropertyAttributes; override;
    function GetEditorClass: TcxCollectionEditorClass; virtual;
    function GetColOptions: TcxColOptions; virtual;
    function IsDefaultValue: Boolean; override;
  end;

procedure cxShowCollectionEditor(AInspector: TcxCustomRTTIInspector; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string);
function cxShowCollectionEditorClass(AInspector: TcxCustomRTTIInspector;
  CollectionEditorClass: TcxCollectionEditorClass; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string;
  ColOptions: TcxColOptions = [coAdd, coDelete, coMove]): TcxCollectionEditor;

implementation

{$R *.dfm}

uses
{$IFDEF DELPHI6}
  Types,
{$ENDIF}
  Registry, TypInfo, cxClasses, cxVGridConsts;

type
  TCollectionAccess = class(TCollection); // used for protected method access
  TPersistentAccess = class(TPersistent);

var
  cxCollectionEditorsList: TList = nil;

function cxShowCollectionEditorClass(AInspector: TcxCustomRTTIInspector;
  CollectionEditorClass: TcxCollectionEditorClass; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string;
  ColOptions: TcxColOptions): TcxCollectionEditor;
var
  I: Integer;
begin
  if cxCollectionEditorsList = nil then
    cxCollectionEditorsList := TList.Create;
  for I := 0 to cxCollectionEditorsList.Count-1 do
  begin
    Result := TcxCollectionEditor(cxCollectionEditorsList[I]);
    with Result do
      if (Inspector = AInspector) and (Component = AComponent)
        and (Collection = ACollection)
        and (CompareText(CollectionPropertyName, PropertyName) = 0) then
      begin
        Show;
        BringToFront;
        Exit;
      end;
  end;
  Result := CollectionEditorClass.Create(Application);
  with Result do
  try
    Options := ColOptions;
    FInspector := AInspector;
    AInspector.AddListener(Result);
    Collection := ACollection;
    FCollectionClassName := ACollection.ClassName;
    Component := AComponent;
    CollectionPropertyName := PropertyName;
    UpdateListbox;
    Show;
  except
    Free;
  end;
end;

procedure cxShowCollectionEditor(AInspector: TcxCustomRTTIInspector; AComponent: TComponent;
  ACollection: TCollection; const PropertyName: string);
begin
  cxShowCollectionEditorClass(AInspector, TcxCollectionEditor, AComponent,
    ACollection, PropertyName);
end;

{ TcxCollectionProperty }

destructor TcxCollectionProperty.Destroy;
var
  I: Integer;
begin
  if Inspector.IsDestroying and (cxCollectionEditorsList <> nil) then
  begin
    for I := 0 to cxCollectionEditorsList.Count - 1 do
     with TcxCollectionEditor(cxCollectionEditorsList[I]) do
       if Inspector = Self.Inspector then CloseEditor;
  end;
  inherited Destroy;
end;

procedure TcxCollectionProperty.Edit;
var
  Obj: TPersistent;
begin
  Obj := GetComponent(0);
  while (Obj <> nil) and not (Obj is TComponent) do
    Obj := TPersistentAccess(Obj).GetOwner;
  cxShowCollectionEditorClass(Inspector, GetEditorClass,
    TComponent(Obj), TCollection(GetOrdValue), GetName, GetColOptions);
end;

function TcxCollectionProperty.GetAttributes: TcxPropertyAttributes;
begin
  Result := [ipaDialog, ipaReadOnly, ipaSubProperties];
end;

function TcxCollectionProperty.GetEditorClass: TcxCollectionEditorClass;
begin
  Result := TcxCollectionEditor;
end;

function TcxCollectionProperty.GetColOptions: TcxColOptions;
begin
  Result := [coAdd, coDelete, coMove];
end;

function TcxCollectionProperty.IsDefaultValue: Boolean;
begin
  Result := False;
end;

{ TcxCollectionEditor }

procedure TcxCollectionEditor.acAddExecute(Sender: TObject);
var
  Item: TListItem;
  PrevCount: Integer;
begin
  SelectNone(False);
  Collection.BeginUpdate;
  try
    PrevCount := Collection.Count + 1;
    Collection.Add;
    // Take into account collections that free items
    if PrevCount <> Collection.Count then
      UpdateListBox
    else
      ListView1.Selected := ListView1.Items.Add;
  finally
    Collection.EndUpdate;
  end;
  SetSelection;
  Item := ListView1.Items[ListView1.Items.Count-1];
  Item.Focused := True;
  Item.MakeVisible(False);
end;

procedure TcxCollectionEditor.acDeleteExecute(Sender: TObject);
var
  I, J: Integer;
begin
  Collection.BeginUpdate;
  try
    Inspector.InspectedObject := nil;
    if ListView1.Selected <> nil then
      J := ListView1.Selected.Index
    else
      J := -1;
    if ListView1.SelCount = Collection.Count then
      Collection.Clear
    else if ListView1.SelCount > 0 then
      for I := ListView1.Items.Count - 1 downto 0 do
        if ListView1.Items[I].Selected then
          Collection.Items[I].Free;
  finally
    Collection.EndUpdate;
  end;
  UpdateListbox;
  if J >= ListView1.Items.Count then
    J := ListView1.Items.Count - 1;
  if (J > -1) and (J < ListView1.Items.Count) then
    ListView1.Selected := ListView1.Items[J];
  SetSelection;
end;

procedure TcxCollectionEditor.acMoveDownExecute(Sender: TObject);
var
  I, InsPos: Integer;
begin
  if (ListView1.SelCount = 0) or
    (ListView1.SelCount = Collection.Count) then Exit;

  InsPos := ListView1.Items.Count - 1;
  while not ListView1.Items[InsPos].Selected do
    Dec(InsPos);
  if InsPos < (ListView1.Items.Count -1) then Inc(InsPos);

  Collection.BeginUpdate;
  try
     for I := ListView1.Items.Count - 1 downto 0 do
       if ListView1.Items[I].Selected then
       begin
         Collection.Items[I].Index := InsPos;
         Dec(InsPos);
       end;
  finally
    Collection.EndUpdate;
  end;
  GetSelection;
end;

procedure TcxCollectionEditor.acMoveUpExecute(Sender: TObject);
var
  I, InsPos: Integer;
begin
  if (ListView1.SelCount = 0) or
    (ListView1.SelCount = Collection.Count) then Exit;

  InsPos := 0;
  while not ListView1.Items[InsPos].Selected do
    Inc(InsPos);
  if InsPos > 0 then Dec(InsPos);

  Collection.BeginUpdate;
  try
     for I := 0 to ListView1.Items.Count - 1 do
       if ListView1.Items[I].Selected then
       begin
         Collection.Items[I].Index := InsPos;
         Inc(InsPos);
       end;
  finally
    Collection.EndUpdate;
  end;
  GetSelection;
end;

procedure TcxCollectionEditor.acSelectAllExecute(Sender: TObject);
begin
  SelectAll;
end;

procedure TcxCollectionEditor.acTextLabelsExecute(Sender: TObject);
begin
  with acTextLabels do
  begin
    Checked := not Checked;
    Toolbar1.ShowCaptions := Checked;
    if not Checked then
    begin
      Toolbar1.ButtonHeight := 24;
      Toolbar1.ButtonWidth := 24;
    end;
  end;
end;

procedure TcxCollectionEditor.acToolbarExecute(Sender: TObject);
begin
  with acToolbar do
  begin
    Checked := not Checked;
    Toolbar1.Visible := Checked;
  end;
end;

procedure TcxCollectionEditor.SetColOptions(Value: TcxColOptions);
begin
  FColOptions := Value;
  acAdd.Enabled := coAdd in Value;
end;

procedure TcxCollectionEditor.CloseEditor;
begin
  FClosing := True;
  Collection := nil;
  Component := nil;
  Close;
end;

procedure TcxCollectionEditor.WMActivate(var Message: TWMActivate);
begin
  inherited;
  if (Message.Active <> WA_INACTIVE) and (Collection <> nil) then
    SetSelection;
end;

procedure TcxCollectionEditor.ItemsModified(AInspector: TcxCustomRTTIInspector);
begin
  if FClosing then exit;
  if Collection <> nil then
  begin
    UpdateListbox;
    GetSelection;
  end;
end;

function TcxCollectionEditor.GetItemName(Index, ItemIndex: Integer): string;
begin
  with TCollectionAccess(Collection) do
    if GetAttrCount < 1 then
      Result := Format('%d - %s',[ItemIndex, Collection.Items[ItemIndex].DisplayName])
    else Result := GetItemAttr(Index, ItemIndex);
end;

function TcxCollectionEditor.GetRegKey: string;
begin
  Result := '\Software\Borland\Delphi\3.0\Collection Editor';
end;

procedure TcxCollectionEditor.GetSelection;
var
  I: Integer;
  Item: TCollectionItem;
{$IFDEF RTTIMULTISELECTION}
  List: TList;
{$ENDIF}
begin
  LockState;
  try
    ListView1.Selected := nil;
  finally
    UnlockState;
  end;
{$IFDEF RTTIMULTISELECTION}
  List := TList.Create;
  try
    Inspector.GetSelections(List);
    if (List.Count = 0) or (List.Count > Collection.Count) then Exit;
    if not ((List[0] = Component) or (List[0] = Collection)
      or (TcxCollectionEditor(List[0]).GetOwner = Collection)) then Exit;
    if List.Count > ListView1.Items.Count then
      UpdateListbox;
  finally
    List.Free;
  end;
{$ELSE}