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

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

src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image002_0002.jpg" 
width=394> </P>
<P>Lets quickly walk through the code and see how it works. First 
pVisitor.Execute( self ) is called to ensure that the current object is passed 
to the Visitor. Next, we create an empty string list and populate it with the 
names of any class type published properties on the object we are currently 
visiting (or self). We now scan this list of class type property names and call 
GetObjectProp( self, &lt;PropName&gt; ) to get a pointer to the published class 
property. We check if this object is a TList and if it is, scan it for instances 
of TVisited. When we find an instance of TVisited in the list, we call 
TVisited.Iterate( pVisitor ) an pass the Visitor we are currently working with. 
We repeat this process for each class type published property, and when done 
clean up by freeing the resources we used along the way.</P>
<P>Since writing this generic iteration routine the number of iteration related 
errors in my programming has dropped to almost zero (before developing this 
approach, I kept making mistakes because I would add another owned list to an 
object, and forget to override its owner’s iterate method. This has had a 
significant payback in saved developer time.</P>
<P>Now that we have developed an approach for iterating over a class that owns 
0..n TLists, we shall extend the logic to iterate over a class that owns 0..n 
TPerObjAbs(s).</P>
<P>Iterating when objects own objects (rather than lists owning objects)</P>
<P>Why would we want to iterate over a class that owns 0..n TPerObjAbs? Take a 
look at how we modelled a person as a TPerson:</P><PRE>TPerson = class( TPerObjAbs )
published
  property Name : string read FName write FName ;
  property EAdrsList : TList read GetEAdrsList ;
  property AdrsList : TList read GetAdrsList ;
end ;</PRE>
<P>and lets say we want to extend our class hierarchy with a company class 
represented like this:</P><PRE>TCompany = class( TPerObjAbs )
published
  property CompanyName : string read FName write FName ;
  property EAdrsList : TList read GetEAdrsList ;
  property AdrsList : TList read GetAdrsList ;
end ;</PRE>
<P>And we want to add some code to search for, say, a person’s or companies 
E-mail address from EAdrsList. One way would be to add a FindEMailAddress : 
TEAdrs method to both the TPeople and TCompany classes, but this would mean 
duplication of code. Another approach would be to descend both TPerson and 
TCompany from the same parent, but this may not be possible for a variety of 
reasons. Another solution to this problem is to use object containment. We can 
create custom TList descendent (or in our case, TPerObjList descendent) and add 
the special FindEMailAddress code there. That way, wherever we use an instance 
of TEAdrs, we have access to the FindEMailAdrs method. This is easy to do and 
I’m sure you have used this technique before, the only complication is how to 
automatically iterate over this modified object hierarchy. Lets say we refactor 
the class hierarchy as shown in the code snip below:</P><PRE>TEAdrsList = class( TPerObjList ) ;
TEAdrs = class( TPerObjAbs )
published
  property AdrsType : string read FAdrsType write FAdrsType ;
  property Text : string read FText write FText ;
end ;

TAdrsList = class( TPerObjList ) ;
TAdrs = class( TPerObjAbs )
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 ;

TPerson = class( TPerObjAbs )
published
  property Name : string read FName write FName ;
  property EAdrsList : TEAdrsList read FEAdrsList ;
  property AdrsList : TAdrsList read FAdrsList ;
end ;</PRE>
<P>We have introduced a list object for both TAdrs and TEAdrs. This will give us 
fine grain control over the list management which we did not have by using a 
TObjectList as the container. The TPerson class now has an instance of TAdrsList 
and TEAdrsList, instead of two instances of TObjectList. As expected, when we 
call tiShowPerObjAbs passing an instance of TPeople, we get the following 
result:</P>
<P><IMG height=142 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image002_0003.jpg" 
width=160> </P>
<P>Which is what we expect, but not what we want because Iterate is not 
detecting the instances of TAdrsList and TEAdrsList, owned by TPerson. We must 
extend TVisited.Iterate to detect published properties of types other than 
TList. The new implementation of Iterate is shown below:</P><PRE>procedure TVisited.Iterate(pVisitor: TVisitor);
  // Take a TList and a TVisitor, and call TVisited( Items[i] ).Iterate
  // on each element of the TList.
  procedure _VisitListElements( lVisited : TObject ; pVisitor : TVisitor ) ;
  var
    i : integer ;
    lList : TList ;
  begin
    lList := TList( lVisited ) ;
    for i := 0 to lList.Count - 1 do
      if ( TObject( lList.Items[i] ) is TVisited ) then
        TVisited( lList.Items[i] ).Iterate( pVisitor ) ;
  end ;
var
  lClassPropNames : TStringList ;
  i : 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
        _VisitListElements( lVisited, pVisitor ) 
      // If the property is a TVisited, then call iterate( pVisitor )
      else if ( lVisited is TVisited ) then
        TVisited( lVisited ).Iterate( pVisitor ) ;
    end ;
  finally
    lClassPropNames.Free ;
  end ;
end;</PRE>
<P>We have made two significant changes to the implementation of Iterate we 
wrote to automatically detect owned lists: We have moved the list iteration code 
into a procedure that is private to Iterate, and we have added code to detect 
owned instances of TVisited. The changes to the object property scanning code 
look like this:</P><PRE>if (lVisited is TList ) then
  _VisitListElements( lVisited, pVisitor ) 
  // If the property is a TVisited, then call iterate( pVisitor )
else if ( lVisited is TVisited ) then
  TVisited( lVisited ).Iterate( pVisitor ) ;</PRE>
<P>If a class type property is a TList, then _VisListElements is called passing 
the TList and the TVisitor as parameters. This procedure simply iterates over 
each element of the list and was added to make the code more readable. If the 
class type property is a TVisited, then its iterate method is called. This flow 
of events is shown in the activity diagram below:</P>
<P><IMG height=465 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image001_0011.gif" 
width=388> \ </P>
<P>The refactored Iterate method is now producing the expected and desired 
result:</P>
<P><IMG height=238 
src="tiOFP Documentation - Building an abstract BOM with the composite pattern_files/4_BuildingAnAbstractBOMWithTheComposite_clip_image002_0004.jpg" 
width=393> </P>
<P>Notice the slight variation from the version of our application where the 
TPerson class directly owned two TList(s) rather than two TPerObjList(s): The 
class name of the list class is being written out which is because the list is 
having Execute( Self ) called within its iterate method. </P>
<P>This technique uses a recursive call to the Iterate method and will drill 
down into a class hierarchy to any depth limited only by the system resources 
and compiler settings.</P>
<P>Now that we have seen how to use RTTI and recursion to iterate over a 
composite of objects, we shall extend the abstract base classes with some 
additional methods like Clone and Assign. These will be used for making 
duplicate copies of objects so we can edit an object in a buffer. This is 
necessary if we want to provide an undo option in edit dialogs.</P>
<H2>The need for the clone and assign methods</H2>
<P>Sometimes we want to copy all the data from one object to another, or make an 
exact copy of an object so we can implement buffered editing. An example of this 
is if we want to write a generic pop up dialog box with both &lt;Cancel&gt; and 
&lt;Save&gt;. There are several ways to achieve this and the one we use in the 
tiOPF is to clone the object to be edited to a temporary buffer, then edit the 
buffered object. If the user clicks Save, the data from the buffered object is 
copied to the real one. If the user clicks Cancel, then the buffered object is 
simply thrown away. We shall see an example of this in chapter #5, ‘A worked 
example of using the tiOPF’. But before we can look at the worked example, we 
must see how to create a duplicate copy of an object with the Clone method, and 
to copy the data from one object to another with the Assign method. We will 
start by implementing a hard coded assign method, then look at making this 
method generic so we do not have to implement Assign in every class we write. 
Next we shall look at writing a Clone method which will return a duplicate copy 
of an object, then finally look at the issues surrounding calling Assign on an 
object that owns other objects.</P>
<H2>Implementing a hard coded assign method</H2>
<P>A hard coded assign method is quite easy to implement, but first, we will 
build a test stub so we can evaluate our progress. We shall start by assigning 
the data from one instance of a TAdrs to another, and testing it using the code 
below:</P><PRE>procedure TFormMain_VisitorManager.btnTestAssign(Sender: TObject);
var
  lAdrsFrom : TAdrs ;
  lAdrsTo : TAdrs ;
  lsAdrsFrom : string ;
  lsAdrsTo : string ;
begin
  // Create an instance of TAdra to copy from
  lAdrsFrom := TAdrs.Create ;
  lAdrsFrom.AdrsType := 'Work-Postal' ;
  lAdrsFrom.Lines := 'PO Box 429' ;
  lAdrsFrom.Suburb := 'Abbotsford' ;
  lAdrsFrom.Country := 'Australia' ;
  // Create another instance of TAdrs for copying to
  lAdrsTo := TAdrs.Create ;
  // Perform the Assign
  lAdrsTo.Assign( lAdrsFrom ) ;
  // Output the From and To TAdrs(s) to a string
  lsAdrsFrom := tiPerObjAbsAsString( lAdrsFrom ) ;
  lsAdrsTo := tiPerObjAbsAsString( lAdrsTo ) ;
  // Compare lsAdrsTo with lsAdrsFrom and report on the findings
  if lsAdrsTo = lsAdrsFrom then
    ShowMessage( 'Assign worked' )
  else
    ShowMessage( 'Assign failed' + #13 +
    '|' + lsAdrsFrom + '|' + #13 + #13 +
    '|' + lsAdrsTo + '|' ) ;
end;</PRE>
<P>In this test stub, we create an instance of a TAdrs, then populate it with 
some dummy values. We create another instance of TAdrs then call lAdrsTo.Assign( 
lAdrsFrom ). We convert the results of both lAdrsFrom and lAdrsTo into a string 
then compare the results and report on any differences. The code we have 
implemented in TAdrs.Assign looks like this:</P><PRE>procedure TAdrs.Assign(Source: TPersistent);
begin
  AdrsType := TAdrs( Source ).AdrsType;
  Lines := TAdrs( Source ).Lines;
  Suburb := TAdrs( Source ).Suburb;
  Country := TAdrs( Source ).Country;
end;</PRE>
<P>There are several things I don't like about this code. Firstly, we have to 
remember to copy each property of TAdrs which means our code is that little 
harder to maintain and slightly more error prone that if the process was 
automatic. We have seen how to use RTTI to scan through all the published 
properties, so this would be a good way of implementing a generic assign. The 
second problem with the code is that the Assign method is introduced in the 
class TPersistent and assumes we want to assign from a TPersistent to another 
TPersistent. We really want to assign from a TPerObjAbs to another TPerObjAbs. 
We must override Assign and change its signature (or parameters) as part of the 
changes we will be making. This leads us to writing a generic Assign method for 
the TPerObjAbs class.</P>
<H2>Implementing a generic Assign method</H2>
<P>We have seen how to use tiGetPropertyNames to populate a string list with a 
classes’ published property names. We can then scan through this list and use 
the GetPropValue and SetPropValue methods that are found in Delphi 5's 
TypInfo.pas unit. The code to implement the automated Assign method is shown 
below:</P><PRE>procedure TPerObjAbs.Assign(Source: TPersistent);
var
  lsl : TStringList ;
  i : integer ;
begin