mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-25 19:49:07 +02:00
+ Fix from Mattias gaertner for IDE support
This commit is contained in:
michael
parent
ddcab79323
commit
df1fa8669a
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user