persist.inc 3.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 1999-2000 by the Free Pascal development team
  4. See the file COPYING.FPC, included in this distribution,
  5. for details about the copyright.
  6. This program is distributed in the hope that it will be useful,
  7. but WITHOUT ANY WARRANTY; without even the implied warranty of
  8. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  9. **********************************************************************}
  10. {****************************************************************************}
  11. {* TPersistent *}
  12. {****************************************************************************}
  13. procedure TPersistent.AssignError(Source: TPersistent);
  14. Var SourceName : String;
  15. begin
  16. If Source<>Nil then
  17. SourceName:=Source.ClassName
  18. else
  19. SourceName:='Nil';
  20. raise EConvertError.CreateFmt (SAssignError,[SourceName,ClassName]);
  21. end;
  22. procedure TPersistent.AssignTo(Dest: TPersistent);
  23. begin
  24. Dest.AssignError(Self);
  25. end;
  26. procedure TPersistent.DefineProperties(Filer: TFiler);
  27. begin
  28. end;
  29. function TPersistent.GetOwner: TPersistent;
  30. begin
  31. Result:=Nil;
  32. end;
  33. destructor TPersistent.Destroy;
  34. begin
  35. Inherited Destroy;
  36. end;
  37. procedure TPersistent.Assign(Source: TPersistent);
  38. begin
  39. If Source<>Nil then
  40. Source.AssignTo(Self)
  41. else
  42. AssignError(Nil);
  43. end;
  44. function TPersistent.GetNamePath: string;
  45. Var OwnerName :String;
  46. begin
  47. Result:=ClassNAme;
  48. If GetOwner<>Nil then
  49. begin
  50. OwnerName:=GetOwner.GetNamePath;
  51. If OwnerName<>'' then Result:=OwnerName+'.'+Result;
  52. end;
  53. end;
  54. {****************************************************************************}
  55. {* TInterfacedPersistent *}
  56. {****************************************************************************}
  57. procedure TInterfacedPersistent.AfterConstruction;
  58. begin
  59. inherited;
  60. // if GetOwner<>nil then
  61. // GetOwner.GetInterface(IUnknown,FOwnerInterface);
  62. end;
  63. function TInterfacedPersistent._AddRef: Integer;stdcall;
  64. begin
  65. if FOwnerInterface<>nil then
  66. Result:=FOwnerInterface._AddRef
  67. else
  68. Result:=-1;
  69. end;
  70. function TInterfacedPersistent._Release: Integer;stdcall;
  71. begin
  72. if FOwnerInterface <> nil then
  73. Result:=FOwnerInterface._Release
  74. else
  75. Result:=-1;
  76. end;
  77. function TInterfacedPersistent.QueryInterface(const IID: TGUID; out Obj): HResult;stdcall;
  78. begin
  79. if GetInterface(IID, Obj) then
  80. Result:=0
  81. else
  82. Result:=HResult($80004002);
  83. end;
  84. {****************************************************************************}
  85. {* TRecall *}
  86. {****************************************************************************}
  87. constructor TRecall.Create(AStorage,AReference: TPersistent);
  88. begin
  89. inherited Create;
  90. FStorage:=AStorage;
  91. FReference:=AReference;
  92. Store;
  93. end;
  94. destructor TRecall.Destroy;
  95. begin
  96. if Assigned(FReference) then
  97. FReference.Assign(FStorage);
  98. Forget;
  99. inherited;
  100. end;
  101. procedure TRecall.Forget;
  102. begin
  103. FReference:=nil;
  104. FreeAndNil(FStorage);
  105. end;
  106. procedure TRecall.Store;
  107. begin
  108. if Assigned(FReference) then
  109. FStorage.Assign(FReference);
  110. end;