cxpropertiesstoreeditor.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 1,002 行 · 第 1/2 页

{*******************************************************************}
{                                                                   }
{       Developer Express Cross Platform Component Library          }
{       Express Cross Platform Library classes                      }
{                                                                   }
{       Copyright (c) 2001-2008 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 EXPRESSCROSSPLATFORMLIBRARY 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 EXPRESS WRITTEN CONSENT  }
{   AND PERMISSION FROM DEVELOPER EXPRESS INC.                      }
{                                                                   }
{   CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON       }
{   ADDITIONAL RESTRICTIONS.                                        }
{                                                                   }
{*******************************************************************}
unit cxPropertiesStoreEditor;

{$I cxVer.inc}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, ExtCtrls, StdCtrls, cxPropertiesStore, cxStorage, ActnList,
  {$IFDEF DELPHI6}
  DesignIntf,
  {$ELSE}
  DsgnIntf,
  {$ENDIF}
  cxControls, ImgList, cxDesignWindows;

type
  TfrmPropertiesStoreFilter = (psfNone, psfStored, psfUnStored);
  TfrmPropertiesStoreGrouping = (psgComponents, psgProperties);

  PfrmPropertiesStoreRecord = ^TfrmPropertiesStoreRecord;
  TfrmPropertiesStoreRecord = record
    Persistent: TPersistent;
    PropertyName: string;
    Stored: Boolean;
  end;

  TfrmPropertiesStoreEditor = class(TForm)
    pnlClient: TPanel;
    ToolBar: TToolBar;
    pnlLeftTree: TPanel;
    pnlLeftTreeTop: TPanel;
    Tree: TTreeView;
    pnlButtons: TPanel;
    lblFindComponent: TLabel;
    edFindComponent: TEdit;
    btnGroupByComponents: TToolButton;
    btnGroupByProperties: TToolButton;
    ToolButton3: TToolButton;
    btnReset: TToolButton;
    btnCheckAll: TToolButton;
    btnUncheckAll: TToolButton;
    ActionList1: TActionList;
    actGroupByComponents: TAction;
    actGroupByProperties: TAction;
    Panel1: TPanel;
    Panel2: TPanel;
    btnOK: TButton;
    btnCancel: TButton;
    btnInvertChecking: TToolButton;
    ImageList1: TImageList;
    procedure TreeDeletion(Sender: TObject; Node: TTreeNode);
    procedure TreeCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
      State: TCustomDrawState; var DefaultDraw: Boolean);
    procedure FormCreate(Sender: TObject);
    procedure actGroupByComponentsExecute(Sender: TObject);
    procedure actGroupByPropertiesExecute(Sender: TObject);
    procedure btnOKClick(Sender: TObject);
    procedure btnCancelClick(Sender: TObject);
    procedure TreeKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure btnCheckAllClick(Sender: TObject);
    procedure btnUncheckAllClick(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure btnResetClick(Sender: TObject);
    procedure btnInvertCheckingClick(Sender: TObject);
    procedure edFindComponentKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure TreeContextPopup(Sender: TObject; MousePos: TPoint;
      var Handled: Boolean);
  private
    FFilter: TfrmPropertiesStoreFilter;
    FGrouping: TfrmPropertiesStoreGrouping;
    FPropertiesStore: TcxPropertiesStore;
    FOwnerComponent: TComponent;
    FDesigner: IDesigner;
    procedure SetOwnerComponent(const Value: TComponent);
    procedure SetFilter(const Value: TfrmPropertiesStoreFilter);
    procedure SetGrouping(const Value: TfrmPropertiesStoreGrouping);
    procedure SetFindText;
    procedure ChangeCheckState(ANode: TTreeNode);
    procedure CheckNode(ANode: TTreeNode; AWithChildren: Boolean = True; AWithParents: Boolean = True);
    procedure UncheckNode(ANode: TTreeNode; AWithChildren: Boolean = True; AWithParents: Boolean = True);
    procedure InvertCheck;
    procedure LoadFromPropertiesStore(APropertiesStore: TcxPropertiesStore);
    procedure SaveToPropertiesStore(APropertiesStore: TcxPropertiesStore);
    function IsNodeChecked(ANode: TTreeNode): Boolean;
    function IsNodeFullChecked(ANode: TTreeNode): Boolean;
    procedure BeginUpdate;
    procedure EndUpdate;
    function FindNode(const AText: string): TTreeNode;
    procedure Reset;
    procedure CheckAll;
    procedure UncheckAll;
    procedure InvertChecking;
  protected
    procedure RefreshTree;
  public
    property Filter: TfrmPropertiesStoreFilter read FFilter write SetFilter;
    property Grouping: TfrmPropertiesStoreGrouping read FGrouping write SetGrouping;
    property OwnerComponent: TComponent read FOwnerComponent write SetOwnerComponent;
    property PropertiesStore: TcxPropertiesStore read FPropertiesStore write FPropertiesStore;
    Property Designer: IDesigner read FDesigner write FDesigner;
  end;

const
  scxFindComponent = 'Find Component:';
  scxFindProperty = 'Find Property:';

procedure ShowPropertiesStoreEditor(APropertiesStore: TcxPropertiesStore;
  AOwnerComponent: TComponent; ADesigner: IDesigner);

implementation

{$R *.dfm}

uses
  TypInfo;

procedure ShowPropertiesStoreEditor(APropertiesStore: TcxPropertiesStore;
  AOwnerComponent: TComponent; ADesigner: IDesigner);
var
  AForm: TfrmPropertiesStoreEditor;
begin
  AForm := TfrmPropertiesStoreEditor.Create(nil);
  {$IFDEF DELPHI9}
  AForm.PopupMode := pmAuto;
  {$ENDIF}
  AForm.OwnerComponent := AOwnerComponent;
  AForm.PropertiesStore := APropertiesStore;
  AForm.Designer := ADesigner;
  try
    AForm.ShowModal;
  finally
    AForm.Free;
  end;
end;

{ TfrmPropertiesStoreEditor }

procedure TfrmPropertiesStoreEditor.RefreshTree;
var
  ANullLevelNodeList: TList;

  function AddPropertyNode(const APropertyName: string; AParentNode: TTreeNode = nil): TTreeNode;
  var
    I: Integer;
    ANode: TTreeNode;
    AUpperCasePropertyName: string;
    AData: PfrmPropertiesStoreRecord;
  begin
    Result := nil;
    AUpperCasePropertyName := UpperCase(APropertyName);
    for I := 0 to ANullLevelNodeList.Count - 1 do
    begin
      ANode := TTreeNode(ANullLevelNodeList[I]);
      if UpperCase(ANode.Text) = AUpperCasePropertyName then
      begin
        Result := ANode;
        Break;
      end;
    end;
    if Result = nil then
    begin
      Result := Tree.Items.AddChild(nil, APropertyName);
      New(AData);
      Result.Data := AData;
      AData.Stored := False;
      ANullLevelNodeList.Add(Result);
    end;
  end;

  procedure AddPersistent(APersistent: TPersistent; const AName: string;
    AParentNode: TTreeNode = nil; APersistentObject: TPersistent = nil);
  var
    APersistentNode, ANode: TTreeNode;
    APropList: PPropList;
    APropCount, I: Integer;
    AData: PfrmPropertiesStoreRecord;
    AObject: TObject;
  begin
    {$IFDEF DELPHI6}
    APropCount := GetPropList(APersistent, APropList);
    {$ELSE}
    APropCount := GetTypeData(PTypeInfo(APersistent.ClassInfo))^.PropCount;
    GetMem(APropList,  APropCount * SizeOf(Pointer));
    GetPropInfos(PTypeInfo(APersistent.ClassInfo), APropList);
    {$ENDIF}
    try
      if Grouping = psgComponents then
      begin
        APersistentNode := Tree.Items.AddChild(AParentNode, AName);
        New(AData);
        APersistentNode.Data := AData;
        if APersistentObject = nil then
          AData.Persistent := APersistent
        else
          AData.Persistent := APersistentObject;
        AData.PropertyName := '';
        AData.Stored := False;
//        if APersistent is TCollection then
//          with TCollection(APersistent) do
//            for I := 0 to Count - 1 do
//              AddPersistent(Items[I], IntToStr(I), APersistentNode);
        for I := 0 to APropCount - 1 do
          if APropList[I].PropType^.Kind <> tkMethod then
          begin
            if APropList[I].PropType^.Kind = tkClass then
            begin
              AObject := GetObjectProp(APersistent, APropList[I]);
              if (AObject is TPersistent) and not (AObject is TComponent) then
              begin
                AddPersistent(AObject as TPersistent, APropList[I].Name,
                  APersistentNode);
                Continue;
              end;
            end;
            ANode := Tree.Items.AddChild(APersistentNode, APropList[I].Name);
            New(AData);
            ANode.Data := AData;
            AData.Persistent := APersistent;
            AData.PropertyName := APropList[I].Name;
            AData.Stored := False;
          end
      end
      else if Grouping = psgProperties then
      begin
        for I := 0 to APropCount - 1 do
          if APropList[I].PropType^.Kind <> tkMethod then
          begin
            ANode := AddPropertyNode(APropList[I].Name);
            if APropList[I].PropType^.Kind = tkClass then
            begin
              AObject := GetObjectProp(APersistent, APropList[I]);
              if (AObject is TPersistent) and not (AObject is TComponent) then
              begin
                FGrouping := psgComponents;
                try
                  AddPersistent(AObject as TPersistent, AName, ANode, APersistent);
                finally
                  FGrouping := psgProperties;
                end;
                Continue;
              end;
            end;
            APersistentNode := Tree.Items.AddChild(ANode, AName);
            New(AData);
            APersistentNode.Data := AData;
            AData.Persistent := APersistent;
            AData.PropertyName := APropList[I].Name;
            AData.Stored := False;
          end;
      end;
    finally
      if APropCount > 0 then
      	{$IFNDEF DELPHI5}
        FreeMem(APropList, APropCount * SizeOf(Pointer));
        {$ELSE}
        FreeMem(APropList);
        {$ENDIF}
    end;
  end;

var
  I: Integer;
begin
  Tree.Items.Clear;
  ANullLevelNodeList := TList.Create;
  try
    Tree.SortType := stNone;
    if FOwnerComponent <> nil then
    begin
      AddPersistent(FOwnerComponent, FOwnerComponent.Name);
      for I := 0 to FOwnerComponent.ComponentCount - 1 do
        AddPersistent(FOwnerComponent.Components[I], FOwnerComponent.Components[I].Name);
    end;
    Tree.SortType := stText;
  finally
    ANullLevelNodeList.Free;
  end;
end;

procedure TfrmPropertiesStoreEditor.SetFilter(
  const Value: TfrmPropertiesStoreFilter);
begin
  if Filter <> Value then
  begin
    FFilter := Value;
    RefreshTree;
  end;
end;

procedure TfrmPropertiesStoreEditor.SetGrouping(
  const Value: TfrmPropertiesStoreGrouping);
var
  APropertiesStore: TcxPropertiesStore;
  ALastValue: TfrmPropertiesStoreGrouping;
begin
  if Grouping <> Value then
  begin
    APropertiesStore := TcxPropertiesStore.Create(nil);
    try
      SaveToPropertiesStore(APropertiesStore);
      ALastValue := FGrouping;
      FGrouping := Value;
      try
        RefreshTree;
        LoadFromPropertiesStore(APropertiesStore);
        SetFindText;
      except
        FGrouping := ALastValue;
        raise;
      end;
    finally
      APropertiesStore.Free;
    end;
  end;
end;

procedure TfrmPropertiesStoreEditor.ChangeCheckState(ANode: TTreeNode);
begin
  if ANode.Data <> nil then
  begin
    if PfrmPropertiesStoreRecord(ANode.Data)^.Stored then
      UnCheckNode(ANode)
    else
      CheckNode(ANode);
  end;
end;

procedure TfrmPropertiesStoreEditor.CheckNode(ANode: TTreeNode;
  AWithChildren: Boolean; AWithParents: Boolean);
var
  I: Integer;
  AParentNode: TTreeNode;
begin
  PfrmPropertiesStoreRecord(ANode.Data)^.Stored := True;
  if AWithChildren then
    for I := 0 to ANode.Count - 1 do
      CheckNode(ANode[I], True, False);
  if AWithParents then
  begin
    AParentNode := ANode.Parent;
    if AParentNode <> nil then
      CheckNode(AParentNode, False, True);
  end;
end;

procedure TfrmPropertiesStoreEditor.UncheckNode(ANode: TTreeNode;
  AWithChildren: Boolean; AWithParents: Boolean);
var
  I: Integer;
  AParentNode: TTreeNode;
  ANeedUncheckParent: Boolean;
begin
  PfrmPropertiesStoreRecord(ANode.Data)^.Stored := False;
  if AWithChildren then
    for I := 0 to ANode.Count - 1 do
      UncheckNode(ANode[I], True, False);
  if AWithParents then
  begin
    AParentNode := ANode.Parent;
    if AParentNode <> nil then
    begin
      ANeedUncheckParent := True;
      for I := 0 to AParentNode.Count - 1 do
        if AParentNode[I].Data <> nil then
          if PfrmPropertiesStoreRecord(AParentNode[I].Data)^.Stored then
          begin
            ANeedUncheckParent := False;
            Break;
          end;
      if ANeedUncheckParent then
        UncheckNode(AParentNode, False, True);
    end;
  end;
end;

procedure TfrmPropertiesStoreEditor.SetOwnerComponent(
  const Value: TComponent);
begin
  if FOwnerComponent <> Value then
  begin
    FOwnerComponent := Value;
    try
      BeginUpdate;
      RefreshTree;
    finally
      EndUpdate;
    end;
  end;
end;

procedure TfrmPropertiesStoreEditor.TreeDeletion(Sender: TObject;
  Node: TTreeNode);
begin
  if (Node.Data <> nil) then
    Dispose(PfrmPropertiesStoreRecord(Node.Data));
end;

procedure TfrmPropertiesStoreEditor.TreeCustomDrawItem(
  Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState;
  var DefaultDraw: Boolean);
begin
  with Tree.Canvas do
  begin
    if Node.Data <> nil then
    begin
      if PfrmPropertiesStoreRecord(Node.Data)^.Stored then
      begin
        if Node.Selected and Tree.Focused then
          Font.Color := RGB(255, 255, 255)
        else
          Font.Color := RGB(0, 0, 255);
        Font.Style := [fsBold];
      end;
    end;
  end;
end;

procedure TfrmPropertiesStoreEditor.FormCreate(Sender: TObject);
begin
  FGrouping := psgComponents;
end;

procedure TfrmPropertiesStoreEditor.actGroupByComponentsExecute(
  Sender: TObject);
begin
  BeginUpdate;
  try
    Grouping := psgComponents;
  finally
    EndUpdate;
  end;
end;

procedure TfrmPropertiesStoreEditor.actGroupByPropertiesExecute(
  Sender: TObject);
begin
  BeginUpdate;
  try
    Grouping := psgProperties;
  finally
    EndUpdate;
  end;
end;

procedure TfrmPropertiesStoreEditor.btnOKClick(Sender: TObject);
begin
  SaveToPropertiesStore(nil);
  Designer.Modified;
  Close;
end;

procedure TfrmPropertiesStoreEditor.btnCancelClick(Sender: TObject);
begin
  Close;
end;

procedure TfrmPropertiesStoreEditor.TreeKeyDown(Sender: TObject;
  var Key: Word; Shift: TShiftState);
begin
  if TranslateKey(Key) = VK_RETURN then
    if Tree.Selected <> nil then
    begin
      BeginUpdate();
      try