cxpropertiesstore.pas

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

    APersistent := GetPersistentAndPropertyName(AName, APropName);
    if (APersistent <> nil) and (APropName <> '') then
    begin
      ATypeInfo := APersistent.ClassInfo;
      if ATypeInfo <> nil then
      begin
        APropInfo := GetPropInfo(ATypeInfo, APropName);
        if APropInfo <> nil then
        begin
          case APropInfo^.PropType^.Kind of
            tkInteger, tkChar, tkWChar:
              SetOrdProp(APersistent, APropInfo, AValue);
            tkEnumeration:
              {$IFDEF DELPHI6}
              SetEnumProp(APersistent, APropInfo, AValue);
              {$ELSE}
              {$IFDEF DELPHI5}
              SetEnumProp(APersistent, APropName, VarToStr(AValue));
              {$ELSE}
              SetOrdProp(APersistent, APropInfo, GetEnumValue(APropInfo^.PropType^, AValue));
              {$ENDIF}
              {$ENDIF}
            tkFloat:
              SetFloatProp(APersistent, APropInfo, AValue);
            tkString, tkLString:
              {$IFDEF DELPHI5}
              SetStrProp(APersistent, APropName, VarToStr(AValue));
              {$ELSE}
              SetStrProp(APersistent, APropInfo, AValue);
              {$ENDIF}
            {$IFDEF DELPHI6}
            tkWString:
              SetWideStrProp(APersistent, APropInfo, AValue);
            {$ENDIF}
            tkSet:
              {$IFDEF DELPHI6}
              SetSetProp(APersistent, APropInfo, AValue);
              {$ELSE}
              {$IFDEF DELPHI5}
              SetSetProp(APersistent, APropName, VarToStr(AValue));
              {$ELSE}
              SetOrdProp(APersistent, APropInfo, SetSetProp(APropInfo, AValue));
              {$ENDIF}
              {$ENDIF}
            tkVariant:
              SetVariantProp(APersistent, APropInfo, AValue);
            {$IFDEF DELPHI6}
            tkInt64:
            begin
              AInt64 := AValue;
              SetInt64Prop(APersistent, APropInfo, AInt64);
            end;
            {$ENDIF}
            tkClass:
            begin
              AComponentName := AValue;
              if AComponentName = '' then
                SetObjectProp(APersistent, APropInfo, nil)
              else
              begin
                AComponent := nil;
                if FComponent is TControl then
                  AComponent := GetParentForm(FComponent as TControl).FindComponent(AComponentName);
                if AComponent = nil then
                begin
                  AParentComponent := FComponent.GetParentComponent;
                  if AParentComponent <> nil then
                    AComponent := AParentComponent.FindComponent(AComponentName);
                  if AComponent = nil then
                  begin
                    AOwner := FComponent.Owner;
                    if AOwner <> nil then
                      AComponent := AOwner.FindComponent(AComponentName);
                  end;
                end;
                if AComponent <> nil then
                  SetObjectProp(APersistent, APropInfo, AComponent);
              end;
            end;
          end;
        end;
      end;
    end;
  end;
end;

procedure TcxPropertiesStoreComponent.SetComponent(const Value: TComponent);
begin
  if Component <> Value then
  begin
    {$IFDEF DELPHI5}
    if (Component <> nil) and not (csDestroying in Component.ComponentState) then
      Component.RemoveFreeNotification(GetPropertiesStore);
    {$ENDIF}
    FComponent := Value;
    if (Component <> nil) then
      Component.FreeNotification(GetPropertiesStore);
  end;
end;

procedure TcxPropertiesStoreComponent.SetProperties(const Value: TStrings);
begin
  FProperties.Assign(Value);
end;

function TcxPropertiesStoreComponent.TestClassProperty(const AName: string;
  AObject: TObject): Boolean;
begin
  Result := (AObject is TPersistent) and not (AObject is TComponent);
end;

procedure TcxPropertiesStoreComponent.AssignStorageProperties(AStorage: TcxStorage);
begin
  with AStorage do
  begin
    Modes := [smSavePublishedClassProperties, smChildrenCreating, smChildrenDeleting];
    OnGetStorageModes := GetStorageModes;
    OnTestClassProperty := TestClassProperty;
    OnGetComponentByName := GetComponentByName;
    OnGetUseInterfaceOnly := GetUseInterfaceOnly;
    SaveComponentPropertiesByName := True;
  end;
end;

{ TcxPropertiesStoreComponents }

function TcxPropertiesStoreComponents.GetPropertiesStore: TcxCustomPropertiesStore;
begin
  Result := TcxPropertiesStore({$IFDEF DELPHI6}Owner{$ELSE}GetOwner{$ENDIF});
end;

procedure TcxPropertiesStoreComponents.RemoveComponent(
  const AComponent: TComponent);
var
  AList: TList;
  I: Integer;
begin
  AList := TList.Create;
  try
    for I := 0 to Count - 1 do
      if ComponentItems[I].Component = AComponent then
        AList.Add(ComponentItems[I]);
    for I := 0 to AList.Count - 1 do
      TcxPropertiesStoreComponent(AList[I]).Free;
  finally
    AList.Free;
  end;
end;

function TcxPropertiesStoreComponents.GetComponentItem(
  Index: Integer): TcxPropertiesStoreComponent;
begin
  Result := Items[Index] as TcxPropertiesStoreComponent;
end;

procedure TcxPropertiesStoreComponents.SetComponentItem(Index: Integer;
  const Value: TcxPropertiesStoreComponent);
begin
  ComponentItems[Index].Assign(Value);
end;

{ TcxCustomPropertiesStore }

constructor TcxCustomPropertiesStore.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FComponents := TcxPropertiesStoreComponents.Create(self, TcxPropertiesStoreComponent);
  FStorageName := '';
  FStorageType := stIniFile;
  FStorageStream := nil;
  FActive := True;
end;

destructor TcxCustomPropertiesStore.Destroy;
begin
  FComponents.Free;
  inherited Destroy;
end;

procedure TcxCustomPropertiesStore.RestoreFrom;
var
  I: Integer;
  AReader: TcxCustomReader;
  AStorage: TcxStorage;
begin
  AReader := CreateReader;
  AStorage := CreateStorage;
  try
    for I := 0 to Components.Count - 1 do
      Components[I].RestoreFrom(AStorage, AReader);
  finally
    AStorage.Free;
    AReader.Free;
  end;
end;

procedure TcxCustomPropertiesStore.StoreTo(const AReCreate: Boolean);
var
  I: Integer;
  AWriter: TcxCustomWriter;
  AStorage: TcxStorage;
begin
  AStorage := CreateStorage;
  try
    if Components.Count > 0 then
    begin
      AWriter := CreateWriter(AReCreate);
      try
        Components[0].StoreTo(AStorage, AWriter);
        AWriter.ReCreate := False;
        for I := 1 to Components.Count - 1 do
          Components[I].StoreTo(AStorage, AWriter);
      finally
        AWriter.Free;
      end;
    end;
  finally
    AStorage.Free;
  end;
end;

procedure TcxCustomPropertiesStore.Loaded;
var
  AMyOwnerCreate: TNotifyEvent;
begin
  inherited Loaded;
  if not (csDesigning in ComponentState) then
  begin
    if Owner <> nil then
    begin
      AMyOwnerCreate := OwnerCreate;
      if Owner is TForm then
      begin
        FOnCreateHandler := TForm(Owner).OnCreate;
        FOnDestroyHandler := TForm(Owner).OnDestroy;
        TForm(Owner).OnCreate := OwnerCreate;
        TForm(Owner).OnDestroy := OwnerDestroy;
      end
      else if Owner is TDataModule then
      begin
        FOnCreateHandler := TDataModule(Owner).OnCreate;
        FOnDestroyHandler := TDataModule(Owner).OnDestroy;
        TDataModule(Owner).OnCreate := OwnerCreate;
        TDataModule(Owner).OnDestroy := OwnerDestroy;
      end;
    end;
  end;
end;

procedure TcxCustomPropertiesStore.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if Operation = opRemove then
    if (AComponent <> Self) and (AComponent <> Owner) then
      Components.RemoveComponent(AComponent);
end;

procedure TcxCustomPropertiesStore.OwnerCreate(Sender: TObject);
begin
  if FActive then
    RestoreFrom;
  if Assigned(FOnCreateHandler) then
    FOnCreateHandler(Sender);
end;

procedure TcxCustomPropertiesStore.OwnerDestroy(Sender: TObject);
begin
  if Assigned(FOnDestroyHandler) then
    FOnDestroyHandler(Sender);
  if FActive then
  begin
    if StorageType <> stStream then
      StoreTo;
  end;
end;

function TcxCustomPropertiesStore.CreateReader: TcxCustomReader;
begin
  Result := nil;
  case FStorageType of
    stIniFile:
      Result := TcxIniFileReader.Create(StorageName);
    stRegistry:
      Result := TcxRegistryReader.Create(StorageName);
    stStream:
    begin
      Result := TcxStreamReader.Create(StorageName);
      (Result as TcxStreamReader).SetStream(FStorageStream);
    end;
  end;
end;

function TcxCustomPropertiesStore.CreateWriter(AReCreate: Boolean): TcxCustomWriter;
begin
  Result := nil;
  case FStorageType of
    stIniFile:
      Result := TcxIniFileWriter.Create(StorageName, AReCreate);
    stRegistry:
      Result := TcxRegistryWriter.Create(StorageName, AReCreate);
    stStream:
    begin
      Result := TcxStreamWriter.Create(StorageName, AReCreate);
      (Result as TcxStreamWriter).SetStream(FStorageStream);
    end;
  end;
end;

function TcxCustomPropertiesStore.CreateStorage: TcxStorage;
begin
  Result := nil;
  case FStorageType of
    stIniFile, stRegistry:
      Result := TcxStorage.Create(StorageName);
    stStream:
      Result := TcxStorage.Create(FStorageStream);
  end;
end;

function TcxCustomPropertiesStore.GetStorageName: string;
begin
  if FStorageName <> '' then
    Result := FStorageName
  else
    Result := Name;
end;

procedure TcxCustomPropertiesStore.SetComponents(
  const Value: TcxPropertiesStoreComponents);
begin
  Components.Assign(Value);
end;

end.