tiofp documentation - building an abstract bom with the composite pattern.htm

tiOPF 面向对象的数据库持久层持久层开发的框架

<P>This makes calls to tiGetPropertyNames like this possible:</P><PRE>  // Populate lslProps with a list of string type properties
  tiGetPropertyNames( FMyData, lslProps, ctkString ) ;
  // Populate lslProps with a list of numeric type properties
  tiGetPropertyNames( FMyData, lslProps, ctkNumeric ) ;
  // Populate lslProps with a list of properties that are not objects or methods 
  tiGetPropertyNames( FMyData, lslProps, ctkSimple + [tkVariant, tkEnumeration]) ;
  // Populate lslProps with a list of properties that are objects
  tiGetPropertyNames( FMyData, lslProps, [tkClass]) ;</PRE>
<P>It is the last call, tiGetPropertyNames( FMyData, lslProps, [tkClass]) that 
we will used to make our iteration method generic.</P>
<H2>A word about TPersistent and published properties</H2>
<P>Delphi's help tells us this about TPersistent:</P>
<P>TPersistent encapsulates the behavior common to all objects that can be 
assigned to other objects, and that can read and write their properties to and 
from a stream. For this purpose TPersisent introduces methods that can be 
overriden to:</P>
<P>Define the procedure for loading and storing unpublished data to a 
stream.<BR>Provide the means to assign values to properties.<BR>Provide the 
means to assign the contents of one object to another.</P>
<P>If we take a look inside Classes.pas, we see that the interface of 
TPersistent looks like this:</P><PRE>{$M+}
TPersistent = class(TObject)
private
  procedure AssignError(Source: TPersistent);
protected
  procedure AssignTo(Dest: TPersistent); virtual;
  procedure DefineProperties(Filer: TFiler); virtual;
  function GetOwner: TPersistent; dynamic;
public
  destructor Destroy; override;
  procedure Assign(Source: TPersistent); virtual;
  function GetNamePath: string; dynamic;
end;
{$M-}</PRE>
<P>The {$M+} compiler directive that surrounds the TPersistent interface looks 
interesting and we learn from the Delphi help text that it is $M that turns on 
RTTI. The help text tells us this about $M</P>
<P>The $M switch directive controls generation of runtime type information 
(RTTI). When a class is declared in the {$M+} state, or is derived from a class 
that was declared in the {$M+} state, the compiler generates runtime type 
information for fields, methods, and properties that are declared in a published 
section. If a class is declared in the {$M-} state, and is not derived from a 
class that was declared in the {$M+} state, published sections are not allowed 
in the class.</P>
<P>Note: The TPersistent class defined in the Classes unit of the VCL is 
declared in the {$M+} state, so any class derived from TPersistent will have 
RTTI generated for its published sections. The VCL uses the runtime type 
information generated for published sections to access the values of a 
component's properties when saving or loading form files. Furthermore, the 
Delphi IDE uses a component's runtime type information to determine the list of 
properties to show in the Object Inspector.</P>
<P>Now, we have two choices for the parent class of our business objects: 
TPersistent or TObject with the $M switch turned on in the classes interface. We 
have used TPersistent in the tiOPF because the framework code predates my 
knowledge of the $M switch. (ADUG member Mat Vincent only introduced me about 
the existence of the $M switch a short time long ago.)</P>
<P>If we look inside TPersistent.Assign, we see that the call is delegated to 
TPersistent.AssignTo, which in turn delegates the call to 
TPersistent.AssignError. The implementation of TPersistent.AssignError looks 
like this:</P><PRE>procedure TPersistent.AssignError(Source: TPersistent);
var
  SourceName: string;
begin
  if Source &lt;&gt; nil then
    SourceName := Source.ClassName 
  else
    SourceName := 'nil';
  raise EConvertError.CreateResFmt(@SAssignError, [SourceName, ClassName]);
end;</PRE>
<P>So, TPersistent.Assing dose little other than raise an exception if it is not 
overridden and implemented in a concrete class. We better remember that when it 
comes time to write a generic Assign method.</P>
<H2>Create some concrete objects to iterate over</H2>
<P>Before we can go much further with developing a generic iterate method, we 
better create a test stub to evaluate our progress. We will create some concrete 
instances of the TPeople – TPerson – TAdrs and TEAdrs objects discussed in the 
previous section. As a reminder, the UML of the business object model we will 
implement is shown below:</P>
<P><IMG height=139 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0008.gif" 
width=314> </P>
<P>This will be implemented by descending TPeople form TPerObjList, and TPerson 
from TPerObjAbs. TPerson will own two TObjectLists to contain the TEAdrs(s) and 
TAdrs(s). Both these lists will be published to allow RTTI to work. The 
interface section of the unit that contains this class hierarchy is shown 
below:</P><PRE>TPeople = class( TPerObjList ) ;
TPerson = class( TPerObjAbs )
private
  FName: string;
  FEAdrsList : TObjectList ;
  FAdrsList : TObjectList ;
  function GetAdrsList: TList;
  function GetEAdrsList: TList;
public
  constructor Create ; override ;
  destructor Destroy ; override ;
published
  property Name : string read FName write FName ;
  property EAdrsList : TList read GetEAdrsList ;
  property AdrsList : TList read GetAdrsList ;
end ;

TAdrs = class( TPerObjAbs )
private
  FSuburb: string;
  FAdrsType: string;
  FCountry: string;
  FLines: string;
published
  property AdrsType : string read FAdrsType write FAdrsType ;
  property Lines : string read FLines write FLines ;
  property Suburb : string read FSuburb write FSuburb ;
  property Country : string read FCountry write FCountry ;
end ;

TEAdrs = class( TPerObjAbs )
private
  FAdrsType: string;
  FText: string;
published
  property AdrsType : string read FAdrsType write FAdrsType ;
  property Text : string read FText write FText ;
end ;</PRE>
<P>We shall hard code some test data like this:</P><PRE>procedure PopulatePeopleWithHardCodedData( pPeople : TPeople ) ;
var
  lPerson : TPerson ;
  lAdrs : TAdrs ;
  lEAdrs : TEAdrs ;
begin
  pPeople.List.Clear ;
  lPerson := TPerson.Create ;
  lPerson.Name := 'Peter Hinrichsen' ;
  pPeople.Add( lPerson ) ;
  lAdrs := TAdrs.Create ;
  lAdrs.AdrsType := 'Work-Postal' ;
  lAdrs.Lines := 'PO Box 429' ;
  lAdrs.Suburb := 'Abbotsford' ;
  lAdrs.Country := 'Australia' ;
  lPerson.AdrsList.Add( lAdrs ) ;
  lAdrs := TAdrs.Create ;
  lAdrs.AdrsType := 'Work-Street' ;
  lAdrs.Lines := '23 Victoria Pde' ;
  lAdrs.Suburb := 'Collingwood' ;
  lAdrs.Country := 'Australia' ;
  lPerson.AdrsList.Add( lAdrs ) ;
  lEAdrs := TEAdrs.Create ;
  lEAdrs.AdrsType := 'EMail' ;
  lEAdrs.Text := '[e-mail]' ;
  lPerson.EAdrsList.Add( lEAdrs ) ;
  lEAdrs := TEAdrs.Create ;
  lEAdrs.AdrsType := 'Web' ;
  lEAdrs.Text := 'www.techinsite.com.au' ;
  lPerson.EAdrsList.Add( lEAdrs ) ;
  lEAdrs := TEAdrs.Create ;
  lEAdrs.AdrsType := 'Phone' ;
  lEAdrs.Text := '[phone]' ;
  lPerson.EAdrsList.Add( lEAdrs ) ;
end;</PRE>
<P>We can now test the tiShowPerObjAbs procedure and as expected will see the 
TPeople and TPerson, but the iterate method will stop at this level because it 
does not know about the existence of either AdrsList or EAdrsList. The result of 
the call to tiShowPerObjAbs is shown below:</P>
<P><IMG height=142 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0009.gif" 
width=154> </P>
<H2>Override Iterate</H2>
<P>One way of solving this problem is to override the TPerson.Iterate method 
like this:</P><PRE>procedure TPerson.Iterate(pVisitor: TVisitor);
var
  i : integer ;
begin
  inherited Iterate( pVisitor ) ;
  for i := 0 to FAdrsList.Count - 1 do
    ( FAdrsList.Items[i] as TVisited ).Iterate( pVisitor ) ;
  for i := 0 to FEAdrsList.Count - 1 do
    ( FEAdrsList.Items[i] as TVisited ).Iterate( pVisitor ) ;
end;</PRE>
<P>This has the desired effect as you can see is the dialog below. All the 
objects in the hierarchy have been touched by the visitor and have had their 
‘flat’ properties written out for display. In the early versions of the 
framework this is how I iterated over complex hierarchies, but it was very error 
prone as it was easy to add another contained class to a parent object and to 
forget to make the necessary changes to the iterate method.</P>
<P><IMG height=272 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0010.gif" 
width=492> </P>
<P>We shall now use RTTI to detect all the owned (and published) instances of 
list properties and iterate over those in the abstract visitor class. This makes 
the abstract visitor’s Iterate rather more complex, but means we don’t have to 
remember to override a concreate classes’ iterate method each time we add an 
owned list.</P>
<H2>Generically detecting and iterating over an owned TList</H2>
<P>If we take another look at the method tiGetPropertyNames we see that the 
third parameter is an array (or set) of property types. You will recall that in 
TypInfo.pas, one of the possible values a property type kind can take is 
tkClass. So, we will use tiGetPropertyNames and pass tkClass as a parameter so a 
list of class type property names are returned. We shall then iterate through 
the list of property names and if the class property is a TList descendent, then 
scan the list elements and call Iterate on each one. This way we are one step 
closer to automating the iteration process. The implementation of 
TVisited.Iterate is shown below:</P><PRE>procedure TVisited.Iterate(pVisitor: TVisitor);
var
  lClassPropNames : TStringList ;
  i : integer ;
  j : integer ;
  lVisited : TObject ;
  lList : TList ;
begin
  pVisitor.Execute( self ) ;
  // Create a string list to hold the property names
  lClassPropNames := TStringList.Create ;
  try
    // Get all property names of type tkClass
    tiGetPropertyNames( self, lClassPropNames, [tkClass] ) ;
    // Scan through these properties
    for i := 0 to lClassPropNames.Count - 1 do 
    begin
      // Get a pointer to the property
      lVisited := GetObjectProp( self, lClassPropNames.Strings[i] ) ;
      // If the property is a TList, then visit it's items
      if (lVisited is TList ) then
      begin
        lList := TList( lVisited ) ;
        for j := 0 to lList.Count - 1 do
          if ( TObject( lList.Items[j] ) is TVisited ) then
            TVisited( lList.Items[j] ).Iterate( pVisitor ) ;
      end ;
    end ;
  finally
    lClassPropNames.Free ;
  end ;
end;</PRE>
<P>This code give’s the desired results of iterating over all the elements 
contained in published TList(s) in the object hierarchy. We can verify this buy 
running tiShowPerObjAbs and checking that the output matches the screen shot 
below:</P>
<P><IMG height=218