cxpropertiesstore.pas

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

{*******************************************************************}
{                                                                   }
{       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 cxPropertiesStore;

{$I cxVer.inc}

interface

uses
  Classes, SysUtils, TypInfo, Controls, Forms,
{$IFDEF DELPHI6}
  Variants,
{$ENDIF}
  cxStorage;

type
  TcxCustomPropertiesStore = class;

  { TcxPropertiesStoreComponent }
  TcxPropertiesStoreComponent = class(TCollectionItem,
    {$IFNDEF DELPHI6}IUnknown, {$ENDIF}IcxStoredObject, IcxStoredParent)
  private
    FComponent: TComponent;
    FProperties: TStrings;
    FPropertiesEx: TStrings;

    procedure ExtractProperties;
    function ExtractPersistentAndPropertyName(AStartPersistent: TPersistent;
      const AStartName: string; var AResultName: string): TPersistent;
    function GetCollectionItemByName(ACollection: TCollection;
      const AName: string): TCollectionItem;
    function GetPersistentAndPropertyName(const AStartName: string;
      var AResultName: string): TPersistent;
    function GetStorageModes: TcxStorageModes;
    function GetComponentByName(const AName: string): TComponent;
    function GetUseInterfaceOnly: Boolean;
    procedure InternalGetPropertyValue(const AName: string; var AValue: Variant);
    procedure InternalSetPropertyValue(const AName: string; const AValue: Variant);
    procedure SetComponent(const Value: TComponent);
    procedure SetProperties(const Value: TStrings);
    function TestClassProperty(const AName: string; AObject: TObject): Boolean;
    procedure AssignStorageProperties(AStorage: TcxStorage);
  protected
    // IcxStoredParent
    function CreateChild(const AObjectName, AClassName: string): TObject;
    procedure DeleteChild(const AObjectName: string; AObject: TObject);
    procedure GetChildren(AChildren: TStringList);
    // IcxStoredObject
    function GetObjectName: string;
    function GetProperties(AProperties: TStrings): Boolean;
    procedure GetPropertyValue(const AName: string; var AValue: Variant);
    procedure SetPropertyValue(const AName: string; const AValue: Variant);
    // IInterface
    function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
    function _AddRef: Integer; stdcall;
    function _Release: Integer; stdcall;

    function GetPropertiesStore: TcxCustomPropertiesStore;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;

    procedure RestoreFrom(AStorage: TcxStorage; AReader: TcxCustomReader);
    procedure RestoreFromIniFile(const AStorageName: string);
    procedure RestoreFromRegistry(const AStorageName: string);
    procedure RestoreFromStream(const AStream: TStream);
    procedure StoreTo(AStorage: TcxStorage; AWriter: TcxCustomWriter);
    procedure StoreToIniFile(const AStorageName: string; const AReCreate: Boolean);
    procedure StoreToRegistry(const AStorageName: string; const AReCreate: Boolean);
    procedure StoreToStream(const AStream: TStream; const AReCreate: Boolean);
  published
    property Component: TComponent read FComponent write SetComponent;
    property Properties: TStrings read FProperties write SetProperties;
  end;

  { TcxPropertiesStoreComponents }
  TcxPropertiesStoreComponents = class(TOwnedCollection)
  private
    function GetComponentItem(Index: Integer): TcxPropertiesStoreComponent;
    procedure SetComponentItem(Index: Integer;
      const Value: TcxPropertiesStoreComponent);
  protected
    function GetPropertiesStore: TcxCustomPropertiesStore;
    procedure RemoveComponent(const AComponent: TComponent);
  public
    property ComponentItems[Index: Integer]: TcxPropertiesStoreComponent read
      GetComponentItem write SetComponentItem; default;
  end;

  { TcxCustomPropertiesStore }
  TcxCustomPropertiesStore = class(TComponent)
  private
    FActive: Boolean;
    FComponents: TcxPropertiesStoreComponents;
    FStorageName: string;
    FStorageStream: TStream;
    FStorageType: TcxStorageType;
    FOnCreateHandler: TNotifyEvent;
    FOnDestroyHandler: TNotifyEvent;

    function GetStorageName: string;
    procedure SetComponents(const Value: TcxPropertiesStoreComponents);
  protected
    procedure Loaded; override;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure OwnerCreate(Sender: TObject);
    procedure OwnerDestroy(Sender: TObject);
    function CreateReader: TcxCustomReader;
    function CreateWriter(AReCreate: Boolean = True): TcxCustomWriter;
    function CreateStorage: TcxStorage;

    property Active: Boolean read FActive write FActive default True;
    property Components: TcxPropertiesStoreComponents read FComponents write SetComponents;
    property StorageName: string read GetStorageName write FStorageName;
    property StorageType: TcxStorageType read FStorageType write FStorageType default stIniFile;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure RestoreFrom;
    procedure StoreTo(const AReCreate: Boolean = True);

    property StorageStream: TStream read FStorageStream write FStorageStream;
  end;

  { TcxPropertiesStore }
  TcxPropertiesStore = class(TcxCustomPropertiesStore)
  published
    property Active;
    property Components;
    property StorageName;
    property StorageType;
  end;

implementation

{ TcxPropertiesStoreComponent }

constructor TcxPropertiesStoreComponent.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  FProperties := TStringList.Create;
  FPropertiesEx := TStringList.Create;
end;

destructor TcxPropertiesStoreComponent.Destroy;
begin
  FPropertiesEx.Free;
  FProperties.Free;
  inherited Destroy;
end;

procedure TcxPropertiesStoreComponent.Assign(Source: TPersistent);
begin
  if Source is TcxPropertiesStoreComponent then
    with TcxPropertiesStoreComponent(Source) do
    begin
      Self.Component := Component;
      Self.Properties := Properties;
    end
  else
    inherited;
end;

procedure TcxPropertiesStoreComponent.RestoreFrom(AStorage: TcxStorage; AReader: TcxCustomReader);
begin
  ExtractProperties;
  with AStorage do
  begin
    AssignStorageProperties(AStorage);
    RestoreWithExistingReader(Self, AReader);
  end;
end;

procedure TcxPropertiesStoreComponent.RestoreFromIniFile(const AStorageName: string);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStorageName);
  try
    AssignStorageProperties(AStorage);
    AStorage.RestoreFromIni(Self);
  finally
    AStorage.Free;
  end;
end;

procedure TcxPropertiesStoreComponent.RestoreFromRegistry(const AStorageName: string);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStorageName);
  try
    AssignStorageProperties(AStorage);
    AStorage.RestoreFromRegistry(Self);
  finally
    AStorage.Free;
  end;
end;

procedure TcxPropertiesStoreComponent.RestoreFromStream(const AStream: TStream);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStream);
  try
    AssignStorageProperties(AStorage);
    AStorage.RestoreFromStream(Self);
  finally
    AStorage.Free;
  end;
end;

procedure TcxPropertiesStoreComponent.StoreTo(AStorage: TcxStorage; AWriter: TcxCustomWriter);
begin
  ExtractProperties;
  with AStorage do
  begin
    AssignStorageProperties(AStorage);
    ReCreate := AWriter.ReCreate;
    StoreWithExistingWriter(Self, AWriter);
  end;
end;

procedure TcxPropertiesStoreComponent.StoreToIniFile(const AStorageName: string; const AReCreate: Boolean);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStorageName);
  try
    AssignStorageProperties(AStorage);
    AStorage.ReCreate := AReCreate;
    AStorage.StoreToIni(Self);
  finally
    AStorage.Free;
  end;
end;

procedure TcxPropertiesStoreComponent.StoreToRegistry(const AStorageName: string; const AReCreate: Boolean);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStorageName);
  try
    AssignStorageProperties(AStorage);
    AStorage.ReCreate := AReCreate;
    AStorage.StoreToRegistry(Self);
  finally
    AStorage.Free;
  end;
end;

procedure TcxPropertiesStoreComponent.StoreToStream(const AStream: TStream; const AReCreate: Boolean);
var
  AStorage: TcxStorage;
begin
  ExtractProperties;
  AStorage := TcxStorage.Create(AStream);
  try
    AssignStorageProperties(AStorage);
    AStorage.ReCreate := AReCreate;
    AStorage.StoreToStream(Self);
  finally
    AStorage.Free;
  end;
end;

function TcxPropertiesStoreComponent.CreateChild(const AObjectName,
  AClassName: string): TObject;
begin
  Result := nil;
end;

procedure TcxPropertiesStoreComponent.DeleteChild(const AObjectName: string; AObject: TObject);
begin
  if AObject is TCollectionItem then
    AObject.Free;
end;

procedure TcxPropertiesStoreComponent.GetChildren(AChildren: TStringList);
var
  ATypeInfo: PTypeInfo;
  APropInfo: PPropInfo;
  I: Integer;
  APersistent: TPersistent;
  APropName: string;
  AChild: TObject;
begin
  AChildren.Clear;
  for I := 0 to FProperties.Count - 1 do
  begin
    APersistent := GetPersistentAndPropertyName(FProperties[I], APropName);
    if (APersistent <> nil) and (APropName <> '') then
    begin
      ATypeInfo := APersistent.ClassInfo;
      APropInfo := GetPropInfo(ATypeInfo, APropName);
      if APropInfo <> nil then
      begin
        if APropInfo^.PropType^.Kind = tkClass then
        begin