Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue49/Factory/FactoryReport.pas

Pascal/Delphi Source File | 1999-06-16 | 5.8 KB | 194 lines

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
  TechInsite Pty. Ltd.
  PO Box 429, Abbotsford, Melbourne. 3067 Australia
  Phone: [phone]
  Fax:   [phone]
  Web:   www.techinsite.com.au
  EMail: [e-mail]

  Created: 01/06/1999

  Notes: An introduction to the factory pattern

* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}

unit FactoryReport;

interface
uses
   Classes             // For TObject
  ,FReportAbstract     // For TReportAbstract
  ;

type

  //----------------------------------------------------------------------------
  TReportClass = class of TFormReportAbstract ;

  //----------------------------------------------------------------------------
  TReportMapping = class( TObject )
  private
    FStrReportName : string ;
    FReportClass   : TReportClass ;
  public
    Constructor CreateExt( const pStrReportName : string ;
                           pClassRef : TReportClass ) ;
    property    ReportName  : string read FStrReportName
                                     write FStrReportName ;
    property    ReportClass : TReportClass read FReportClass
                                           write FReportClass ;
  end ;

  //----------------------------------------------------------------------------
  TFactoryReport = class( TObject )
  private
    FReportMappings : TStringList ;
  public
    Constructor Create ;
    Destructor Destroy ; override ;
    Procedure RegisterReport( const pStrReportName : string;
                              pClassRef : TReportClass ) ;
    Function GetReport( const pStrReportName : string ) :
                TFormReportAbstract ;
  end ;

// The poor man's singleton, a function to return
// a reference to a variable with unit wide visibility.
function gFactoryReport : TFactoryReport ;

implementation
uses
  SysUtils   // UpperCase
  ,Dialogs   // MessageDlg
  ;

var
  // A variable to hold our single
  // instance of TFactoryReport. This variable has
  // unit wide scope, hence the u prefix.
  uFactoryReport : TFactoryReport
  ;

// Our poor man's singleton.
// This function has global (or application) wide scope,
// hence the prefix g.
function gFactoryReport : TFactoryReport ;
begin
  // If uFactoryReport has not been created, then
  // create one.
  if uFactoryReport = nil then
    uFactoryReport := TFactoryReport.Create ;
  // Return a reference to uFactoryReport
  result := uFactoryReport ;
end ;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// *  TReportMapping
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
constructor TReportMapping.CreateExt(
                               const pStrReportName: string;
                               pClassRef: TReportClass);
begin
  Create ;
  ReportName  := pStrReportName ;
  ReportClass := pClassRef ;
end;

// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
// *
// *  TFactoryReport
// *
// * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
constructor TFactoryReport.Create;
begin
  inherited ;
  // Create a TSTringList to hold the ReportMappings
  FReportMappings := TStringList.Create ;
end;

//------------------------------------------------------------------------------
destructor TFactoryReport.Destroy;
var i : integer ;
begin
  // Scan through FReportMappings,
  // and free any associated objects
  for i := 0 to FReportMappings.Count - 1 do
    TObject( FReportMappings.Objects[i] ).Free ;
  // Free FReportMappings
  FReportMappings.Free ;
  // Call inherited
  inherited ;
end;

//------------------------------------------------------------------------------
procedure TFactoryReport.RegisterReport(
                               const pStrReportName: string;
                               pClassRef: TReportClass);
var i : integer ;
    lReportMapping : TReportMapping ;
    lStrReportName : string ;
begin
  lStrReportName := upperCase(pStrReportName) ;

  // Does the reportName already exist?
  i := FReportMappings.IndexOf( lStrReportName );
  // If yes, report an error.
  if i <> -1 then begin
    messageDlg( 'Registering a duplicate ' +
                'report name <' +
                pStrReportName + '>',
                mtInformation,
                [mbOK],
                0 ) ;
    Exit ; //==>
  end ;

  // Create a reportMapping object
  lReportMapping := TReportMapping.CreateExt(
                      lStrReportName,
                      pClassRef ) ;

  // Add the reportName, and reportMapping object to the list
  FReportMappings.AddObject( upperCase( pStrReportName ),
                             lReportMapping ) ;

end;

//------------------------------------------------------------------------------
function TFactoryReport.GetReport(
                              const pStrReportName: string):
                              TFormReportAbstract;
var i : integer ;
begin

  // Does the report exist in the list?
  i := FReportMappings.IndexOf( upperCase(pStrReportName));

  // If not, then raise an exception
  if i = -1 then
    Raise Exception.Create( 'Request for invalid report ' +
                            'name <' +
                            pStrReportName + '>' ) ;

  // Create an instance of the report, and return.
  // Note that the module that called GetReport is
  // responsible for freeing the report.
  result :=
    TReportMapping( FReportMappings.Objects[i]
                               ).ReportClass.Create( nil ) ;
end ;

initialization
  // Call the function gFactoryReport, to create an instance
  // of TFactoryReport.
  gFactoryReport ;

finalization
  // Free uFactoryReport
  uFactoryReport.Free ;

end.