home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue49 / Factory / FactoryConcreteAnimal.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-06-16  |  2.1 KB  |  70 lines
  1. {* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  2.   TechInsite Pty. Ltd.
  3.   PO Box 429, Abbotsford, Melbourne. 3067 Australia
  4.   Phone: +61 3 9419 6456
  5.   Fax:   +61 3 9419 1682
  6.   Web:   www.techinsite.com.au
  7.   EMail: peter_hinrichsen@techinsite.com.au
  8.  
  9.   Created: 01/06/1999
  10.  
  11.   Notes: Concrete animal factory. The TFactoryAbstract is descended from with
  12.          the additional function CreateInstanceExt being added. This function
  13.          calls the concrete factory's CreateInstance and adds some type casting.
  14.  
  15. * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
  16.  
  17. unit FactoryConcreteAnimal;
  18.  
  19. interface
  20. uses
  21.   FactoryAbstract,
  22.   Animals
  23.   ;
  24.  
  25. type
  26.  
  27.   // The animal factory
  28.   //----------------------------------------------------------------------------
  29.   TFactoryConcreteAnimal = class( TFactoryAbstract )
  30.   private
  31.   public
  32.     Function CreateInstanceExt( const pStrClassID : string ) :
  33.                                        TAnimal ;
  34.  
  35.   end ;
  36.  
  37. // A function with application wide visibility to surfact the unit wide
  38. // variable uFactoryConcreteAnimal
  39. function gFactoryConcreteAnimal : TFactoryConcreteAnimal ;
  40.  
  41. implementation
  42. var
  43.   // Hold a single instance of our animla factory
  44.   uFactoryConcreteAnimal : TFactoryConcreteAnimal ;
  45.  
  46. // Make sure there is always an animal factory available
  47. //------------------------------------------------------------------------------
  48. function gFactoryConcreteAnimal : TFactoryConcreteAnimal ;
  49. begin
  50.   if uFactoryConcreteAnimal = nil then
  51.     uFactoryConcreteAnimal := TFactoryConcreteAnimal.Create ;
  52.   result := uFactoryConcreteAnimal ;
  53. end ;
  54.  
  55. // Create an instance of the required class, but add some type casting
  56. //------------------------------------------------------------------------------
  57. function TFactoryConcreteAnimal.CreateInstanceExt(
  58.             const pStrClassID: string): TAnimal ;
  59. begin
  60.   result := TAnimal( CreateInstance( pStrClassID )) ;
  61. end;
  62.  
  63. initialization
  64.   gFactoryConcreteAnimal ;
  65.  
  66. finalization
  67.   uFactoryConcreteAnimal.Free ;
  68.  
  69. end.
  70.