View Issue Details

Jump to NotesJump to History
IDProjectCategoryView StatusDate SubmittedLast Update
0006687JEDI VCL00 JVCL Componentspublic2020-04-08 00:202020-06-02 17:19
Reporternosek1969Assigned Tojfudickar 
PrioritynormalSeverityblockReproducibilityalways
Status resolvedResolutionfixed 
Product Version 
Target VersionFixed in Version 
Summary0006687: TJvFormStorage generate A.V. where set readonly property
Descriptioninto file JvAppStorage.pas change the procedure to:

procedure TJvCustomAppStorage.ReadProperty(const Path: string; const PersObj: TPersistent; const PropName: string; const
  Recursive, ClearFirst: Boolean; const IgnoreProperties: TStrings = nil);
var
  //Index: Integer;
  TmpValue: Integer;
  SubObj: TObject;
  P: PPropInfo;
begin
  if not Assigned(PersObj) then
    Exit;
  case PropType(PersObj, PropName) of
    {$IFDEF UNICODE} tkUString, {$ENDIF}
    tkLString, tkString:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
          SetStrProp(PersObj, PropName, ReadString(Path, GetStrProp(PersObj, PropName)));
      end;
    tkWString:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
          {$IFDEF RTL240_UP}SetStrProp{$ELSE}SetWideStrProp{$ENDIF RTL240_UP}(PersObj, PropName, ReadWideString(Path, {$IFDEF RTL240_UP}GetStrProp{$ELSE}GetWideStrProp{$ENDIF RTL240_UP}(PersObj, PropName)));
      end;
    tkEnumeration:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
        begin
          TmpValue := GetOrdProp(PersObj, PropName);
          ReadEnumeration(Path, GetPropInfo(PersObj, PropName).PropType^, TmpValue, TmpValue);
          SetOrdProp(PersObj, PropName, TmpValue);
        end;
      end;
    tkVariant:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
          SetVariantProp(PersObj, PropName, ReadString(Path, VarToStr(GetVariantProp(PersObj, PropName))));
      end;
    tkSet:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
        begin
          TmpValue := GetOrdProp(PersObj, PropName);
          ReadSet(Path, GetPropInfo(PersObj, PropName).PropType^, TmpValue, TmpValue);
          SetOrdProp(PersObj, PropName, TmpValue);
        end;
      end;
    tkChar, tkWChar, tkInteger:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
        begin
          TmpValue := GetOrdProp(PersObj, PropName);
          ReadEnumeration(Path, GetPropInfo(PersObj, PropName).PropType^, TmpValue, TmpValue);
          SetOrdProp(PersObj, PropName, TmpValue);
        end;
      end;
    tkInt64:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
          SetInt64Prop(PersObj, PropName, StrToInt64(ReadString(Path,
              IntToStr(GetInt64Prop(PersObj, PropName)))));
      end;
    tkFloat:
      begin
        P := GetPropInfo(PersObj, PropName, tkAny);
        if Assigned(P.SetProc) then
        begin
          P := GetPropInfo(PersObj, PropName, tkAny);
          if (P <> nil) and (P.PropType <> nil) and (P.PropType^ = TypeInfo(TDateTime)) then
            SetFloatProp(PersObj, PropName, ReadDateTime(Path, GetFloatProp(PersObj, PropName)))
          else
            SetFloatProp(PersObj, PropName, ReadFloat(Path, GetFloatProp(PersObj, PropName)));
        end;
      end;
    tkClass:
      begin
        SubObj := GetObjectProp(PersObj, PropName);
        if (RegisteredAppStoragePropertyEngineList <> nil) and
          Recursive and
          RegisteredAppStoragePropertyEngineList.ReadProperty(Self, Path, PersObj, SubObj, Recursive, ClearFirst, IgnoreProperties) then
          // Do nothing else, the handling is done in the ReadProperty procedure
        else
          if SubObj is TStrings then
            ReadStringList(Path, TStrings(SubObj), ClearFirst)
          else
            if (SubObj is TPersistent) and Recursive then
              if SubObj is TJvCustomPropertyStore then
              begin
                TJvCustomPropertyStore(SubObj).AppStoragePath := Path;
                TJvCustomPropertyStore(SubObj).AppStorage := Self;
                TJvCustomPropertyStore(SubObj).LoadProperties;
              end
              else
                if SubObj is TCollection then
                  ReadCollection(Path, TCollection(SubObj), ClearFirst)
                else
                  ReadPersistent(Path, TPersistent(SubObj), True, ClearFirst, IgnoreProperties);
      end;
  end;
end;
TagsNo tags attached.

Activities

obones

2020-05-18 22:34

administrator   ~0021875

Please provide th zipped sources of a sample application showing this

nosek1969

2020-05-18 23:32

reporter   ~0021879

I not want destroy my main system. No exe.
You must using TXDBGrid (not TDBGrid)
free trial - www.x-files.pl

JediFormStorage.7z (56,693 bytes)

jfudickar

2020-05-24 18:50

developer   ~0021937

This should be fixed now.
Can you please test it out and give a feedback.
It's posted to github.

nosek1969

2020-06-02 12:02

reporter   ~0021941

Tested, on 10.4 - work fine.

Issue History

Date Modified Username Field Change
2020-04-08 00:20 nosek1969 New Issue
2020-05-18 22:34 obones Status new => feedback
2020-05-18 22:34 obones Note Added: 0021875
2020-05-18 23:32 nosek1969 File Added: JediFormStorage.7z
2020-05-18 23:32 nosek1969 Note Added: 0021879
2020-05-18 23:32 nosek1969 Status feedback => new
2020-05-18 23:48 jfudickar Assigned To => jfudickar
2020-05-24 18:50 jfudickar Status new => feedback
2020-05-24 18:50 jfudickar Note Added: 0021937
2020-06-02 12:02 nosek1969 Note Added: 0021941
2020-06-02 12:02 nosek1969 Status feedback => assigned
2020-06-02 17:19 jfudickar Status assigned => resolved
2020-06-02 17:19 jfudickar Resolution open => fixed