/ Design Patterns / Structural patterns / Adapter

Adapter Design Pattern in Delphi

Applications in Delphi

A typical example of this is the wrapper Delphi generates when you import a VBX or OCX. Delphi generates a new class which translates the interface of the external control into a Pascal compatible interface. Another typical case is when you want to build a single interface to old and new systems.

Note Delphi does not allow class adaption through multiple inheritance in the way described in Design Patterns. Instead, the adapter needs to refer to a specific instance of the old class.

Implementation Example

The following example is a simple (read only) case of a new customer class, an adapter class and an old customer class. The adapter illustrates handling the year 2000 problem, translating an old customer record containing two digit years into a new date format. The client using this wrapper only knows about the new customer class.

Translation between classes is handled by the use of virtual access methods for the properties. The old customer class and adapter class are hidden in the implementation of the unit.

unit Adapter;

interface

uses SysUtils, Classes;

type

  //The new class

  TNewCustomer = class
  private
    FCustomerID: Longint;
    FFirstName: string;
    FLastName: string;
    FDOB: TDateTime;
  protected
    function GetCustomerID: Longint; virtual;
    function GetFirstName: string; virtual;
    function GetLastName: string; virtual;
    function GetDOB: TDateTime; virtual;
  public
    constructor Create(CustID: Longint); virtual;
    property CustomerID: Longint read GetCustomerID;
    property FirstName: string read GetFirstName;
    property LastName: string read GetLastName;
    property DOB: TDateTime read GetDOB;
  end;

  //An interface method

  //Lets us hide details of TOldCustomer from the client

function GetCustomer(CustomerID: Longint): TNewCustomer;

implementation

const
  Last_OldCustomer_At_Year_2000 = 15722;
  Last_OldCustomer_In_Database = 30000;

//The new class

constructor TNewCustomer.Create(CustID: Longint);
begin
  FCustomerID := CustID;
  FFirstName := 'A';
  FLastName := 'New_Customer';
  FDOB := Now;
end;

function TNewCustomer.GetCustomerID: Longint;
begin
  Result := FCustomerID;
end;
 
function TNewCustomer.GetFirstName: string;
begin
  Result := FFirstName;
end;

function TNewCustomer.GetLastName: string;
begin
  Result := FLastName;
end;

function TNewCustomer.GetDOB: TDateTime;
begin
  Result := FDOB;
end;

type

  //The old class
 
  TOldDOB = record
    Day: 0..31;
    Month: 1..12;
    Year: 0..99;
  end;


  TOldCustomer = class
    FCustomerID: Integer;
    FName: string;
    FDOB: TOldDOB;
  public
    constructor Create(CustID: Integer);
    property CustomerID: Integer read FCustomerID;
    property Name: string read FName;
    property DOB: TOldDOB read FDOB;
  end;
 
constructor TOldCustomer.Create(CustID: Integer);
begin
  FCustomerID := CustomerID;
  FName := 'An Old_Customer';
  with FDOB do begin
    Day := 1;
    Month := 1;
    Year := 1;
  end;
end;
 
type

  //The Adapter class

  TAdaptedCustomer = class(TNewCustomer)
  private
    FOldCustomer: TOldCustomer;
  protected
    function GetCustomerID: Longint; override;
    function GetFirstName: string; override;
    function GetLastName: string; override;
    function GetDOB: TDateTime; override;
  public
    constructor Create(CustID: Longint); override;
    destructor Destroy; override;
  end;


//The Adapter class

constructor TAdaptedCustomer.Create(CustID: Longint);
begin
  inherited Create(CustID);
  FOldCustomer := TOldCustomer.Create(CustID);
end;

destructor TAdaptedCustomer.Destroy;
begin
  FOldCustomer.Free;
  inherited Destroy;
end;

function TAdaptedCustomer.GetCustomerID: Longint;
begin
  Result := FOldCustomer.CustomerID;
end;

function TAdaptedCustomer.GetFirstName: string;
var
  SpacePos: integer;
begin
  SpacePos := Pos(' ', FOldCustomer.Name);
  if SpacePos = 0 then
    Result := ''
  else
    Result := Copy(FOldCustomer.Name,1,SpacePos-1);
end;

function TAdaptedCustomer.GetLastName: string;
var
  SpacePos: integer;
begin
  SpacePos := Pos(' ', FOldCustomer.Name);
  if SpacePos = 0 then
    Result := FOldCustomer.Name
  else
    Result := Copy(FOldCustomer.Name,SpacePos+1,255);
end;

function TAdaptedCustomer.GetDOB: TDateTime;
var
  FullYear: Word;
begin
  if CustomerID > Last_OldCustomer_At_Year_2000 then
    FullYear := 2000 + FOldCustomer.DOB.Year
  else
    FullYear := 1900 + FOldCustomer.DOB.Year;
  Result := EncodeDate(FullYear, FOldCustomer.DOB.Month, FOldCustomer.DOB.Day);
end;

function GetCustomer(CustomerID: Longint): TNewCustomer;
begin
  if CustomerID > Last_OldCustomer_In_Database then
    Result := TNewCustomer.Create(CustomerID)
  else
    Result := TAdaptedCustomer.Create(CustomerID) as TNewCustomer;
end;

end.

Code examples

Java Adapter in Java: Before and after Adapter in Java
C++ Adapter in C++ Adapter in C++: External Polymorphism
PHP Adapter in PHP
Delphi Adapter in Delphi
Python Adapter in Python