diff --git a/ide/customformeditor.pp b/ide/customformeditor.pp index 56bd8e422d..3198805eb1 100644 --- a/ide/customformeditor.pp +++ b/ide/customformeditor.pp @@ -2263,10 +2263,19 @@ end; procedure TCustomFormEditor.JITListPropertyNotFound(Sender: TObject; Reader: TReader; Instance: TPersistent; var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); +var + Index: Integer; begin - DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName, - ' Instance=',Instance.ClassName,' PropName="',PropName, - '" IsPath=',IsPath]); + Index := RemovedProperties.IndexOf(TPersistentClass(Instance.ClassType), PropName); + if Index >= 0 then + begin + Skip := True; + Handled := True; + end + else + DebugLn(['TCustomFormEditor.JITListPropertyNotFound ',Sender.ClassName, + ' Instance=',Instance.ClassName,' PropName="',PropName, + '" IsPath=',IsPath]); end; procedure TCustomFormEditor.JITListFindAncestors(Sender: TObject; diff --git a/lcl/lresources.pp b/lcl/lresources.pp index 4fd1e1a567..9046058010 100644 --- a/lcl/lresources.pp +++ b/lcl/lresources.pp @@ -349,6 +349,31 @@ type property OnFindComponentClass; end; + TRemovedProperty = record + PersistentClass: TPersistentClass; + PropertyName: String; + Note: String; + HelpKeyword: String; + end; + PRemovedProperty = ^TRemovedProperty; + + { TRemovedPropertyList } + + TRemovedPropertyList = class(TList) + private + function GetItem(AIndex: Integer): PRemovedProperty; + procedure SetItem(AIndex: Integer; const AValue: PRemovedProperty); + protected + procedure Notify(Ptr: Pointer; Action: TListNotification); override; + procedure DoPropertyNotFound(Reader: TReader; Instance: TPersistent; + var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); + public + function IndexOf(AClass: TPersistentClass; APropertyName: String): Integer; + function Add(APersistentClass: TPersistentClass; APropertyName, ANote, + AHelpKeyWord: string): Integer; reintroduce; + property Items[AIndex: Integer]: PRemovedProperty read GetItem write SetItem; + end; + const ObjStreamMaskInherited = 1; ObjStreamMaskChildPos = 2; @@ -356,6 +381,7 @@ const var LazarusResources: TLResourceList; + RemovedProperties: TRemovedPropertyList = nil; LRSObjectReaderClass: TLRSObjectReaderClass=TLRSObjectReader; LRSObjectWriterClass: TLRSObjectWriterClass=TLRSObjectWriter; @@ -483,12 +509,13 @@ function FloatToLFMStr(const Value: extended; Precision, Digits: Integer function CompareLRPositionLinkWithLFMPosition(Item1, Item2: Pointer): integer; function CompareLRPositionLinkWithLRSPosition(Item1, Item2: Pointer): integer; +procedure RegisterRemovedProperty(PersistentClass: TPersistentClass; + PropertyName, Note, HelpKeyWord: string); procedure Register; implementation - const LineEnd: ShortString = LineEnding; @@ -518,6 +545,67 @@ type var Name: string); end; +{ TRemovedPropertyList } + +function TRemovedPropertyList.GetItem(AIndex: Integer): PRemovedProperty; +begin + Result := inherited Get(AIndex); +end; + +procedure TRemovedPropertyList.SetItem(AIndex: Integer; + const AValue: PRemovedProperty); +begin + inherited Put(AIndex, AValue); +end; + +procedure TRemovedPropertyList.Notify(Ptr: Pointer; Action: TListNotification); +begin + if Action = lnDeleted then + Dispose(PRemovedProperty(Ptr)) + else + inherited Notify(Ptr, Action); +end; + +procedure TRemovedPropertyList.DoPropertyNotFound(Reader: TReader; Instance: TPersistent; + var PropName: string; IsPath: boolean; var Handled, Skip: Boolean); +begin + Skip := IndexOf(TPersistentClass(Instance.ClassType), PropName) >= 0; + Handled := Skip; +end; + +function TRemovedPropertyList.IndexOf(AClass: TPersistentClass; + APropertyName: String): Integer; +var + i: integer; +begin + Result := -1; + APropertyName := LowerCase(APropertyName); + for i := 0 to Count - 1 do + if AClass.InheritsFrom(Items[i]^.PersistentClass) and + (APropertyName = Items[i]^.PropertyName) then + begin + Result := i; + Exit; + end; +end; + +function TRemovedPropertyList.Add(APersistentClass: TPersistentClass; + APropertyName, ANote, AHelpKeyWord: string): Integer; +var + Item: PRemovedProperty; +begin + Result := IndexOf(APersistentClass, APropertyName); + if Result = -1 then + begin + New(Item); + Item^.PersistentClass := APersistentClass; + Item^.PropertyName := LowerCase(APropertyName); + Item^.Note := ANote; + Item^.HelpKeyword := AHelpKeyWord; + Result := inherited Add(Item); + end; +end; + { TReaderUniqueNamer } procedure TReaderUniqueNamer.OnSetName(Reader: TReader; Component: TComponent; @@ -2902,6 +2990,8 @@ begin if Assigned(LRSTranslator) then Result.OnReadStringProperty:=@(LRSTranslator.TranslateStringProperty); + Result.OnPropertyNotFound := @(RemovedProperties.DoPropertyNotFound); + DestroyDriver:=false; if Result.Driver.ClassType=LRSObjectReaderClass then exit; // hack to set a write protected variable. @@ -3358,6 +3448,12 @@ begin Result:=0; end; +procedure RegisterRemovedProperty(PersistentClass: TPersistentClass; + PropertyName, Note, HelpKeyWord: string); +begin + RemovedProperties.Add(PersistentClass, PropertyName, Note, HelpKeyWord); +end; + procedure Register; begin RegisterComponents('System',[TLazComponentQueue]); @@ -5202,14 +5298,15 @@ procedure InternalInit; begin LazarusResources := TLResourceList.Create; RegisterInitComponentHandler(TComponent, @InitResourceComponent); + RemovedProperties := TRemovedPropertyList.Create; end; initialization InternalInit; finalization - LazarusResources.Free; - LazarusResources := nil; + FreeAndNil(LazarusResources); + FreeAndNil(RemovedProperties); end.