home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / delphi / kolekce / d56 / XMLCOMP.ZIP / DnXmlListMapper.pas < prev    next >
Pascal/Delphi Source File  |  2002-06-14  |  7KB  |  235 lines
  1. unit DnXmlListMapper;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, SysUtils, Dialogs;
  7.  
  8. type
  9.   TDnXmlListMapperClass = class of TDnXmlListMapper;
  10.  
  11.   TDnXmlListMapper = class
  12.   private
  13.     FObject: TObject;
  14.     FOwnerObject: TObject;
  15.   protected
  16.     property TheObject: TObject read FObject;
  17.     property OwnerObject: TObject read FOwnerObject;
  18.     function GetCount: Integer; virtual; abstract;
  19.     function GetIsRef(aIndex: Integer): Boolean; virtual; abstract;
  20.     function GetStoresObjects: Boolean; virtual; abstract;
  21.     function GetObjectItem(aIndex: Integer): TObject; virtual; abstract;
  22.     procedure SetObjectItem(aIndex: Integer; Value: TObject); virtual; abstract;
  23.     function GetStringItem(aIndex: Integer): string; virtual; abstract;
  24.   public
  25.     {:Always use this constructor instead of the standard one! It takes the
  26.       object of which the list items are needed.}
  27.     constructor CreateWithObject(aObject: TObject; aOwner: TObject = nil); virtual;
  28.     procedure Clear; virtual; abstract;
  29.     procedure Add(aItem: TObject); overload; virtual; abstract;
  30.     procedure Add(aItem: string); overload; virtual; abstract;
  31.     property Count: Integer read GetCount;
  32.     property IsRef[aIndex: Integer]: Boolean read GetIsRef;
  33.     property StoresObjects: Boolean read GetStoresObjects;
  34.     property ObjectItem[aIndex: Integer]: TObject read GetObjectItem write SetObjectItem;
  35.     property StringItem[aIndex: Integer]: string read GetStringItem;
  36.   end;
  37.  
  38.   TDnXmlTListMapper = class(TDnXmlListMapper)
  39.   private
  40.     FList: TList;
  41.   protected
  42.     function GetCount: Integer; override;
  43.     function GetIsRef(aIndex: Integer): Boolean; override;
  44.     function GetStoresObjects: Boolean; override;
  45.     function GetObjectItem(aIndex: Integer): TObject; override;
  46.     procedure SetObjectItem(aIndex: Integer; Value: TObject); override;
  47.   public
  48.     constructor CreateWithObject(aObject: TObject; aOwner: TObject = nil); override;
  49.     procedure Clear; override;
  50.     procedure Add(aItem: TObject); override;
  51.     procedure Add(aItem: string); override;
  52.   end;
  53.  
  54.   {:Makes child objects persistent.}
  55.   TDnXmlTComponentMapper = class(TDnXmlListMapper)
  56.   protected
  57.     FComponent: TComponent;
  58.     function GetCount: Integer; override;
  59.     function GetIsRef(aIndex: Integer): Boolean; override;
  60.     function GetStoresObjects: Boolean; override;
  61.     function GetObjectItem(aIndex: Integer): TObject; override;
  62.     procedure SetObjectItem(aIndex: Integer; Value: TObject); override;
  63.   public
  64.     constructor CreateWithObject(aObject: TObject; aOwner: TObject = nil); override;
  65.     procedure Clear; override;
  66.     procedure Add(aItem: TObject); override;
  67.     procedure Add(aItem: string); override;
  68.   end;
  69.  
  70. function GetListMapper(aClass: TClass): TDnXmlListMapperClass;
  71. procedure RegisterListMapper(aClass: TClass; aMapper: TDnXmlListMapperClass);
  72. procedure UnregisterListMapper(aClass: TClass);
  73.  
  74. implementation
  75.  
  76. var
  77.   uClasses: TList; { of TClass }
  78.   uMappers: TList; { of TDnXmlListMappersClass }
  79.  
  80. function GetListMapper(aClass: TClass): TDnXmlListMapperClass;
  81. var idx: Integer;
  82. begin
  83.   result := nil;
  84.   for idx := 0 to uClasses.Count - 1 do
  85.   begin
  86.     if aClass.InheritsFrom(uClasses[idx]) then
  87.     begin
  88.       result := uMappers[idx];
  89.       Break;
  90.     end;
  91.   end;
  92. end;
  93.  
  94. procedure RegisterListMapper(aClass: TClass; aMapper: TDnXmlListMapperClass);
  95. var idx: Integer;
  96. begin
  97.   idx := uClasses.IndexOf(aClass);
  98.   if idx <> -1 then
  99.     raise Exception.CreateFmt('There already is a list mapper %s associated with class %s',
  100.       [TClass(uMappers[idx]).ClassName, aClass.ClassName]);
  101.   uClasses.Add(aClass);
  102.   uMappers.Add(aMapper);
  103. end;
  104.  
  105. procedure UnregisterListMapper(aClass: TClass);
  106. begin
  107.   uClasses.Remove(aClass);
  108. end;
  109.  
  110. { TDnXmlListMapper }
  111.  
  112. constructor TDnXmlListMapper.CreateWithObject(aObject: TObject; aOwner: TObject = nil);
  113. begin
  114.   inherited;
  115.   Assert(aObject <> nil);
  116.   FObject := aObject;
  117.   FOwnerObject := aOwner;
  118. end;
  119.  
  120. { TDnXmlTListMapper }
  121.  
  122. procedure TDnXmlTListMapper.Clear;
  123. begin
  124.   FList.Clear;
  125. end;
  126.  
  127. constructor TDnXmlTListMapper.CreateWithObject(aObject, aOwner: TObject);
  128. begin
  129.   inherited;
  130.   FList := aObject as TList;
  131. end;
  132.  
  133. function TDnXmlTListMapper.GetCount: Integer;
  134. begin
  135.   result := (TheObject as TList).Count;
  136. end;
  137.  
  138. function TDnXmlTListMapper.GetStoresObjects: Boolean;
  139. begin
  140.   result := True;
  141. end;
  142.  
  143. function TDnXmlTListMapper.GetIsRef(aIndex: Integer): Boolean;
  144. var item: TObject;
  145. begin
  146.   item := (TheObject as TList)[aIndex];
  147.   if item <> nil then
  148.     result := (item is TComponent) and (OwnerObject <> nil) and (TComponent(item).Owner <> OwnerObject)
  149.   else
  150.     result := False;
  151. end;
  152.  
  153. function TDnXmlTListMapper.GetObjectItem(aIndex: Integer): TObject;
  154. begin
  155.   result := (TheObject as TList)[aIndex];
  156. end;
  157.  
  158. procedure TDnXmlTListMapper.Add(aItem: TObject);
  159. begin
  160.   FList.Add(aItem);
  161. end;
  162.  
  163. procedure TDnXmlTListMapper.Add(aItem: string);
  164. begin
  165.   Assert(False, 'Use this list mapper for object lists only');
  166. end;
  167.  
  168. procedure TDnXmlTListMapper.SetObjectItem(aIndex: Integer; Value: TObject);
  169. begin
  170.   FList[aIndex] := Value;
  171. end;
  172.  
  173. { TDnXmlTComponentMapper }
  174.  
  175. procedure TDnXmlTComponentMapper.Add(aItem: string);
  176. begin
  177.   Assert(False);
  178. end;
  179.  
  180. procedure TDnXmlTComponentMapper.Add(aItem: TObject);
  181. begin
  182.   Assert(aItem is TComponent);
  183.   (TheObject as TComponent).InsertComponent(TComponent(aItem));
  184. end;
  185.  
  186. procedure TDnXmlTComponentMapper.Clear;
  187. begin
  188.   while FComponent.ComponentCount > 0 do
  189.     FComponent.Components[0].Free;
  190. end;
  191.  
  192. constructor TDnXmlTComponentMapper.CreateWithObject(aObject,
  193.   aOwner: TObject);
  194. begin
  195.   inherited;
  196.   FComponent := aObject as TComponent;
  197. end;
  198.  
  199. function TDnXmlTComponentMapper.GetCount: Integer;
  200. begin
  201.   result := FComponent.ComponentCount;
  202. end;
  203.  
  204. function TDnXmlTComponentMapper.GetIsRef(aIndex: Integer): Boolean;
  205. begin
  206.   result := False;
  207. end;
  208.  
  209. function TDnXmlTComponentMapper.GetObjectItem(aIndex: Integer): TObject;
  210. begin
  211.   result := FComponent.Components[aIndex];
  212. end;
  213.  
  214. function TDnXmlTComponentMapper.GetStoresObjects: Boolean;
  215. begin
  216.   result := True;
  217. end;
  218.  
  219. procedure TDnXmlTComponentMapper.SetObjectItem(aIndex: Integer;
  220.   Value: TObject);
  221. begin
  222.   Assert(False, 'Child objects cannot be references at the same time');
  223. end;
  224.  
  225. initialization
  226.   uClasses := TList.Create;
  227.   uMappers := TList.Create;
  228.   RegisterListMapper(TList, TDnXmlTListMapper);
  229.  
  230. finalization
  231.   uClasses.Free;
  232.   uMappers.Free;  
  233.  
  234. end.
  235.