设计模式循序渐进（9）解释器模式 Interpreter

通过解释器模式实现阿拉伯数字与罗马数字的相互转换。
具体的模式分析解说日后补发。
Delphi代码：

unit uInt2RomeInterpreter;
{
单元说明：将整数转换为罗马数字
          Interpreter 解释器模式练习。
作者：张树坤
时间：2008-06-11
}
interface

type
  TInt2RomeContext = class;
  TRomeCharList = array[1..9] of string ;

  TInt2RomeExpression = class(TObject)
  private

    function GetRomeChar(index: Integer): string;
    procedure InitRomeCharList; virtual; abstract;
  protected
    FRomeCharList: TRomeCharList;
  public
    constructor Create; virtual;
    function Multiplier: Integer; virtual; abstract;
    procedure Interpret(context: TInt2RomeContext); virtual;
    property RomeItems[index: Integer]: string read GetRomeChar;
  end;

  TInt2RomeOneExp = class(TInt2RomeExpression)
  private
    procedure InitRomeCharList; override;
  public
    function Multiplier: Integer; override;
  end;

  TInt2RomeTenExp = class(TInt2RomeExpression)
  private
    procedure InitRomeCharList; override;
  public
    function Multiplier: Integer; override;
  end;

  TInt2RomeHundredExp = class(TInt2RomeExpression)
  private
    procedure InitRomeCharList; override;
  public
    function Multiplier: Integer; override;
  end;

  TInt2RomeThousandExp = class(TInt2RomeExpression)
  private
    procedure InitRomeCharList; override;
  public
    function Multiplier: Integer; override;
  end;


  TInt2RomeContext = class(TObject)
  private
    FOutput: string;
    FInput: Integer;
    procedure SetInput(const Value: Integer);
    procedure SetOutput(const Value: string);
  public
    constructor Create(input: Integer);
    function BeginWith(AMultiplier: Integer): Integer; //个、十、百、千位的数字
    property Input: Integer read FInput write SetInput;
    property Output: string read FOutput write SetOutput;
  end;


implementation

{ TInt2RomeExpression }

constructor TInt2RomeExpression.Create;
begin
  inherited Create;
  InitRomeCharList;
end;

function TInt2RomeExpression.GetRomeChar(index: Integer): string;
begin
  if index in [1..9] then
    Result := FRomeCharList[index];
end;

procedure TInt2RomeExpression.Interpret(context: TInt2RomeContext);
var
  i: Integer;
begin
  i := context.BeginWith(Multiplier);
  if i in [1..9] then
    context.Output := context.Output + RomeItems[i]
end;


{ TContext }

function TInt2RomeContext.BeginWith(AMultiplier: Integer): Integer;
begin
  Result := FInput div AMultiplier;
  FInput := FInput mod AMultiplier;
end;

constructor TInt2RomeContext.Create(input: Integer);
begin
  FInput := Input;
end;

procedure TInt2RomeContext.SetInput(const Value: Integer);
begin
  FInput := Value;
end;

procedure TInt2RomeContext.SetOutput(const Value: string);
begin
  FOutput := Value;
end;

{ TInt2RomeOneExp }

procedure TInt2RomeOneExp.InitRomeCharList;
const
  tmp : TRomeCharList = ('I', 'II', 'III', 'IV', 'V', 'VI', 'VII', 'VIII', 'IX');
var
  i: Integer;
begin
//  for i := 1 to 9 do
  for i := Low(FRomeCharList) to High(FRomeCharList) do
  begin
    FRomeCharList[i] := tmp[i];
  end;
end;

function TInt2RomeOneExp.Multiplier: Integer;
begin
  Result := 1;
end;

{ TInt2RomeTenExp }

procedure TInt2RomeTenExp.InitRomeCharList;
const
  tmp : TRomeCharList = ('X', 'XX', 'XXX', 'XL', 'L', 'LX', 'LXX', 'LXXX', 'XC');
var
  i: Integer;
begin
  for i := Low(FRomeCharList) to High(FRomeCharList) do
  begin
    FRomeCharList[i] := tmp[i];
  end;
end;

function TInt2RomeTenExp.Multiplier: Integer;
begin
  Result := 10;
end;

{ TInt2RomeHundredExp }

procedure TInt2RomeHundredExp.InitRomeCharList;
const
  tmp : TRomeCharList = ('C', 'CC', 'CCC', 'CD', 'D', 'DC', 'DCC', 'DCCC', 'CM');
var
  i: Integer;
begin
  for i := Low(FRomeCharList) to High(FRomeCharList) do
  begin
    FRomeCharList[i] := tmp[i];
  end;
end;

function TInt2RomeHundredExp.Multiplier: Integer;
begin
  Result := 100;
end;

{ TInt2RomeThousandExp }

procedure TInt2RomeThousandExp.InitRomeCharList;
const
  tmp : TRomeCharList = ('M', 'MM', 'MMM', '', '', '', '', '', '');
var
  i: Integer;
begin
  for i := Low(FRomeCharList) to High(FRomeCharList) do
  begin
    FRomeCharList[i] := tmp[i];
  end;
end;

function TInt2RomeThousandExp.Multiplier: Integer;
begin
  Result := 1000;
end;

end.

unit uRomeInterpreter;
{
单元说明：将罗马数字转换为整数
          Interpreter 解释器模式练习。
作者：张树坤
时间：2008-06-11
}
interface

type
  TContext = class;

  TAbstractExpression = class(TObject)
  public
    function Five: string; virtual; abstract;
    function Four: string; virtual; abstract;
    function Nine: string; virtual; abstract;
    function One: string; virtual; abstract;
    function Multiplier: Integer; virtual; abstract;
    procedure Interpret(context: TContext); virtual;
  end;

  TOneExp = class(TAbstractExpression)
  public
    function Five: string; override;
    function Four: string; override;
    function Nine: string; override;
    function One: string; override;
    function Multiplier: Integer; override;
  end;

  TTenExp = class(TAbstractExpression)
  public
    function Five: string; override;
    function Four: string; override;
    function Nine: string; override;
    function One: string; override;
    function Multiplier: Integer; override;
  end;

  THundredExp = class(TAbstractExpression)
  public
    function Five: string; override;
    function Four: string; override;
    function Nine: string; override;
    function One: string; override;
    function Multiplier: Integer; override;
  end;

  TThousandExp = class(TAbstractExpression)
  public
    function Five: string; override;
    function Four: string; override;
    function Nine: string; override;
    function One: string; override;
    function Multiplier: Integer; override;
  end;

  TContext = class(TObject)
  private
    FInput: string;
    FOutput: Integer;
    procedure SetInput(const Value: string);
    procedure SetOutput(const Value: Integer);
  public
    constructor Create(input: string);
    function BeginWith(value: string): Boolean;
    property Input: string read FInput write SetInput;
    property Output: Integer read FOutput write SetOutput;
  end;

implementation

{ TAbstractExpression }

procedure TAbstractExpression.Interpret(context: TContext);
begin
  //将罗马数字转换为阿拉伯数字
  if Length(context.Input) = 0 then
    Exit;

  if context.BeginWith(Nine) then
  begin
    context.Output := context.Output + 9 * Multiplier;
    context.Input := Copy(context.Input, 3, (Length(context.Input) - 2) );
  end
  else if context.BeginWith(Five) then
  begin
    context.Output := context.Output + 5 * Multiplier;
    context.Input := Copy(context.Input, 2, (Length(context.Input) - 1));
  end
  else if context.BeginWith(Four) then
  begin
    context.Output := context.Output + 4 * Multiplier;
    context.Input := Copy(context.Input, 3, (Length(context.Input) - 2));
  end;
  while context.BeginWith(One) do
  begin
    context.Output := context.Output + 1 * Multiplier;
    context.Input := Copy(context.Input, 2, (Length(context.Input) - 1));
  end;  
end;

{ TContext }

function TContext.BeginWith(value: string): Boolean;
var
  i: Integer;
begin
  i := Length(value);
  //(i > 0表示非空字符串);进行字符匹配计算
  if (i > 0) and (Copy(FInput, 0, i) = value) then
    Result := True
  else
    Result := False;
end;

constructor TContext.Create(input: string);
begin
  FInput := input;
end;

procedure TContext.SetInput(const Value: string);
begin
  FInput := Value;
end;

procedure TContext.SetOutput(const Value: Integer);
begin
  FOutput := Value;
end;

{ TOneExp }

function TOneExp.Five: string;
begin
  Result := 'V';
end;

function TOneExp.Four: string;
begin
  Result := 'IV';
end;

function TOneExp.Multiplier: Integer;
begin
  Result := 1;
end;

function TOneExp.Nine: string;
begin
  Result := 'IX';
end;

function TOneExp.One: string;
begin
  Result := 'I';
end;

{ TTenExp }
//X，XL，L，XC
function TTenExp.Five: string;
begin
  Result := 'L';
end;

function TTenExp.Four: string;
begin
  Result := 'XL';
end;

function TTenExp.Multiplier: Integer;
begin
  Result := 10;
end;

function TTenExp.Nine: string;
begin
  Result := 'XC';
end;

function TTenExp.One: string;
begin
  Result := 'X';
end;

{ THundredExp }
//C，CD，D，M
function THundredExp.Five: string;
begin
  Result := 'D';
end;

function THundredExp.Four: string;
begin
  Result := 'CD';
end;

function THundredExp.Multiplier: Integer;
begin
  Result := 100;
end;

function THundredExp.Nine: string;
begin
  Result := 'CM';
end;

function THundredExp.One: string;
begin
  Result := 'C';
end;

{ TThousandExp }

function TThousandExp.Five: string;
begin
  Result := '';
end;

function TThousandExp.Four: string;
begin
  Result := '';
end;

function TThousandExp.Multiplier: Integer;
begin
  Result := 1000;
end;

function TThousandExp.Nine: string;
begin
  Result := ''
end;

function TThousandExp.One: string;
begin
  Result := 'M';
end;

end.

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, uRomeInterpreter, uInt2RomeInterpreter;

type
  TForm1 = class(TForm)
    edtRome: TEdit;
    btn1: TButton;
    lblRome2Int: TLabel;
    btnInt2Rome: TButton;
    lblInt2Rome: TLabel;
    edtInt: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure btn1Click(Sender: TObject);
    procedure btnInt2RomeClick(Sender: TObject);
  private
    { Private declarations }
    Parse: TList;
    Int2RomeParse: TList;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Parse := TList.Create;
  Parse.Add(TThousandExp.Create);
  Parse.Add(THundredExp.Create);
  Parse.Add(TTenExp.Create);
  Parse.Add(TOneExp.Create);

  Int2RomeParse := TList.Create;
  Int2RomeParse.Add(TInt2RomeThousandExp.Create);
  Int2RomeParse.Add(TInt2RomeHundredExp.Create);
  Int2RomeParse.Add(TInt2RomeTenExp.Create);
  Int2RomeParse.Add(TInt2RomeOneExp.Create);
end;

procedure TForm1.FormDestroy(Sender: TObject);
var
  i: Integer;
begin
  for i := 0 to Parse.Count - 1 do
  begin
    TAbstractExpression(Parse.Items[i]).Free;
  end;
  Parse.Clear;
  Parse.Free;
end;

procedure TForm1.btn1Click(Sender: TObject);
var
  context: TContext;
  i: Integer;
begin
  context := TContext.Create(edtRome.Text);
  for i := 0 to Parse.Count - 1 do
  begin
    TAbstractExpression(Parse.Items[i]).Interpret(context);
  end;
  lblRome2Int.Caption := IntToStr(context.output);
  context.Free;
end;

procedure TForm1.btnInt2RomeClick(Sender: TObject);
var
  context: TInt2RomeContext;
  i: Integer;
begin
  context:= TInt2RomeContext.Create(strtointdef(edtInt.text, 1));
  for i := 0 to Int2RomeParse.Count - 1 do
  begin
    TInt2RomeExpression(Int2RomeParse.Items[i]).Interpret(context);
  end;
  lblInt2Rome.Caption := context.Output;
  context.Free;
end;

end.

dfm

 

object Form1: TForm1
  Left = 192
  Top = 107
  Width = 696
  Height = 480
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  OnDestroy = FormDestroy
  PixelsPerInch = 96
  TextHeight = 13
  object lblRome2Int: TLabel
    Left = 360
    Top = 80
    Width = 56
    Height = 13
    Caption = 'lblRome2Int'
  end
  object lblInt2Rome: TLabel
    Left = 360
    Top = 136
    Width = 56
    Height = 13
    Caption = 'lblInt2Rome'
  end
  object edtRome: TEdit
    Left = 128
    Top = 72
    Width = 121
    Height = 21
    TabOrder = 0
    Text = 'MCMLXVIII'
  end
  object btn1: TButton
    Left = 264
    Top = 72
    Width = 75
    Height = 25
    Caption = 'btnRome2Int'
    TabOrder = 1
    OnClick = btn1Click
  end
  object btnInt2Rome: TButton
    Left = 264
    Top = 136
    Width = 75
    Height = 25
    Caption = 'btnInt2Rome'
    TabOrder = 2
    OnClick = btnInt2RomeClick
  end
  object edtInt: TEdit
    Left = 128
    Top = 136
    Width = 121
    Height = 21
    TabOrder = 3
    Text = '5'
  end
end