+ Fix from Mattias gaertner for IDE support

fcl/inc/classesh.inc

@@ -815,13 +815,19 @@ type
 
   TFindMethodEvent = procedure(Reader: TReader; const MethodName: string;
     var Address: Pointer; var Error: Boolean) of object;
+  TSetMethodPropertyEvent = procedure(Reader: TReader; Instance: TPersistent;
+    PropInfo: PPropInfo; const TheMethodName: string;
+    var Handled: boolean) of object;
   TSetNameEvent = procedure(Reader: TReader; Component: TComponent;
     var Name: string) of object;
   TReferenceNameEvent = procedure(Reader: TReader; var Name: string) of object;
   TAncestorNotFoundEvent = procedure(Reader: TReader; const ComponentName: string;
     ComponentClass: TPersistentClass; var Component: TComponent) of object;
   TReadComponentsProc = procedure(Component: TComponent) of object;
-  TReaderError = procedure(Reader: TReader; const Message: string; var Handled: Boolean) of object;
+  TReaderError = procedure(Reader: TReader; const Message: string;
+    var Handled: Boolean) of object;
+  TPropertyNotFoundEvent = procedure(Reader: TReader; Instance: TPersistent;
+    var PropName: string; IsPath: boolean; var Handled, Skip: Boolean) of object;
   TFindComponentClassEvent = procedure(Reader: TReader; const ClassName: string;
     var ComponentClass: TComponentClass) of object;
   TCreateComponentEvent = procedure(Reader: TReader;
@@ -835,10 +841,12 @@ type
     FFixups: TList;
     FLoaded: TList;
     FOnFindMethod: TFindMethodEvent;
+    FOnSetMethodProperty: TSetMethodPropertyEvent;
     FOnSetName: TSetNameEvent;
     FOnReferenceName: TReferenceNameEvent;
     FOnAncestorNotFound: TAncestorNotFoundEvent;
     FOnError: TReaderError;
+    FOnPropertyNotFound: TPropertyNotFoundEvent;
     FOnFindComponentClass: TFindComponentClassEvent;
     FOnCreateComponent: TCreateComponentEvent;
     FPropName: string;
@@ -894,7 +902,9 @@ type
     property Owner: TComponent read FOwner write FOwner;
     property Parent: TComponent read FParent write FParent;
     property OnError: TReaderError read FOnError write FOnError;
+    property OnPropertyNotFound: TPropertyNotFoundEvent read FOnPropertyNotFound write FOnPropertyNotFound;
     property OnFindMethod: TFindMethodEvent read FOnFindMethod write FOnFindMethod;
+    property OnSetMethodProperty: TSetMethodPropertyEvent read FOnSetMethodProperty write FOnSetMethodProperty;
     property OnSetName: TSetNameEvent read FOnSetName write FOnSetName;
     property OnReferenceName: TReferenceNameEvent read FOnReferenceName write FOnReferenceName;
     property OnAncestorNotFound: TAncestorNotFoundEvent read FOnAncestorNotFound write FOnAncestorNotFound;
@@ -976,6 +986,9 @@ type
 
   TFindAncestorEvent = procedure (Writer: TWriter; Component: TComponent;
     const Name: string; var Ancestor, RootAncestor: TComponent) of object;
+  TWriteMethodPropertyEvent = procedure (Writer: TWriter; Instance: TPersistent;
+    PropInfo: PPropInfo; const MethodValue: TMethod;
+    const DefMethodCodeValue: Pointer; var Handled: boolean) of object;
 
   TWriter = class(TFiler)
   private
@@ -987,6 +1000,7 @@ type
     FAncestorPos: Integer;
     FChildPos: Integer;
     FOnFindAncestor: TFindAncestorEvent;
+    FOnWriteMethodProperty: TWriteMethodPropertyEvent;
     procedure AddToAncestorList(Component: TComponent);
     procedure WriteComponentData(Instance: TComponent);
   protected
@@ -1023,6 +1037,7 @@ type
     {!!!: procedure WriteWideString(const Value: WideString);}
     property RootAncestor: TComponent read FRootAncestor write FRootAncestor;
     property OnFindAncestor: TFindAncestorEvent read FOnFindAncestor write FOnFindAncestor;
+    property OnWriteMethodProperty: TWriteMethodPropertyEvent read FOnWriteMethodProperty write FOnWriteMethodProperty;
 
     property Driver: TAbstractObjectWriter read FDriver;
   end;
@@ -1504,7 +1519,10 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.24  2003-06-04 15:27:24  michael
+  Revision 1.25  2003-08-16 15:50:47  michael
+  + Fix from Mattias gaertner for IDE support
+
+  Revision 1.24  2003/06/04 15:27:24  michael
   + TDataModule en InitInheritedComponent erbij voor Delphi 6 compatibility
 
   Revision 1.23  2002/10/14 19:46:50  peter

fcl/inc/reader.inc

@@ -911,6 +911,30 @@ var
   PropInfo: PPropInfo;
   Obj: TObject;
   Name: String;
+  Skip: Boolean;
+  Handled: Boolean;
+  OldPropName: String;
+  
+  function HandleMissingProperty(IsPath: Boolean): boolean;
+  begin
+    Result:=true;
+    if Assigned(OnPropertyNotFound) then begin
+      // user defined property error handling
+      OldPropName:=FPropName;
+      Handled:=false;
+      Skip:=false;
+      OnPropertyNotFound(Self,Instance,FPropName,IsPath,Handled,Skip);
+      if Handled and (not Skip) and (OldPropName<>FPropName) then
+        // try alias property
+        PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+      if Skip then begin
+        FDriver.SkipValue;
+        Result:=false;
+        exit;
+      end;
+    end;
+  end;
+  
 begin
   try
     Path := FDriver.BeginProperty;
@@ -931,8 +955,11 @@ begin
         DotPos := NextPos + 1;
 
         PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
-        if not Assigned(PropInfo) then
-          PropertyError;
+        if not Assigned(PropInfo) then begin
+          if not HandleMissingProperty(true) then exit;
+          if not Assigned(PropInfo) then
+            PropertyError;
+        end;
 
         if PropInfo^.PropType^.Kind = tkClass then
           Obj := TObject(GetOrdProp(Instance, PropInfo))
@@ -949,6 +976,8 @@ begin
       end;
 
       PropInfo := GetPropInfo(Instance.ClassInfo, FPropName);
+      if not Assigned(PropInfo) then
+        if not HandleMissingProperty(false) then exit;
       if Assigned(PropInfo) then
         ReadPropValue(Instance, PropInfo)
       else
@@ -987,6 +1016,7 @@ var
   IdentToIntFn: TIdentToInt;
   Ident: String;
   Method: TMethod;
+  Handled: Boolean;
 begin
   if not Assigned(PPropInfo(PropInfo)^.SetProc) then
     raise EReadError.Create(SReadOnlyProperty);
@@ -1030,10 +1060,17 @@ begin
         SetMethodProp(Instance, PropInfo, NullMethod);
       end else
       begin
-        Method.Code := FindMethod(Root, ReadIdent);
-        Method.Data := Root;
-        if Assigned(Method.Code) then
-          SetMethodProp(Instance, PropInfo, Method);
+        Handled:=false;
+        Ident:=ReadIdent;
+        if Assigned(OnSetMethodProperty) then
+          OnSetMethodProperty(Self,Instance,PPropInfo(PropInfo),Ident,
+                              Handled);
+        if not Handled then begin
+          Method.Code := FindMethod(Root, Ident);
+          Method.Data := Root;
+          if Assigned(Method.Code) then
+            SetMethodProp(Instance, PropInfo, Method);
+        end;
       end;
     tkSString, tkLString, tkAString, tkWString:
       SetStrProp(Instance, PropInfo, ReadString);
@@ -1268,7 +1305,10 @@ end;
 
 {
   $Log$
-  Revision 1.7  2002-12-02 12:04:07  sg
+  Revision 1.8  2003-08-16 15:50:47  michael
+  + Fix from Mattias gaertner for IDE support
+
+  Revision 1.7  2002/12/02 12:04:07  sg
   * Fixed handling of zero-length strings (classes.inc: When converting
     empty strings from text forms to binary forms; reader.inc: When reading
     an empty string from a binary serialization)

fcl/inc/writer.inc

@@ -599,6 +599,7 @@ var
   SavedPropPath, Name: String;
   Int64Value, DefInt64Value: Int64;
   BoolValue, DefBoolValue: boolean;
+  Handled: Boolean;
 
 begin
 
@@ -667,7 +668,12 @@ begin
         else
           DefMethodCodeValue := nil;
 
-        if (MethodValue.Code <> DefMethodCodeValue) and
+        Handled:=false;
+        if Assigned(OnWriteMethodProperty) then
+          OnWriteMethodProperty(Self,Instance,PPropInfo(PropInfo),MethodValue,
+            DefMethodCodeValue,Handled);
+        if (not Handled) and
+          (MethodValue.Code <> DefMethodCodeValue) and
           ((not Assigned(MethodValue.Code)) or
           ((Length(FLookupRoot.MethodName(MethodValue.Code)) >= 0))) then
         begin
@@ -826,7 +832,10 @@ end;}
 
 {
   $Log$
-  Revision 1.7  2002-09-20 09:28:11  michael
+  Revision 1.8  2003-08-16 15:50:47  michael
+  + Fix from Mattias gaertner for IDE support
+
+  Revision 1.7  2002/09/20 09:28:11  michael
   Fix from mattias gaertner
 
   Revision 1.6  2002/09/07 15:15:26  peter