program StructureDemo;

{$APPTYPE CONSOLE}

uses
  SysUtils, Classes;

type
  TConditions = class;
  TTestProc = procedure(Condition:TConditions);
  TConditions = class(TStringList)
  private
    FCond : Array ['A'..'G'] of Boolean;
  protected
    function GetCond(Index:Char):Boolean;
    procedure SetCode(Index:Char; aValue:Boolean);
  public
    procedure AddTest(Name:String; Test:TTestProc);
    procedure Code(Num:Integer);
    procedure MoreCode(loc:string);
    procedure Test;
    procedure SetState(CondStr:String; State:Boolean = False);
    property Condition[Index:Char]:Boolean read GetCond write SetCode; Default;
  end;


{ TConditions }

procedure TConditions.AddTest(Name: String; Test: TTestProc);
begin
  AddObject(Name, @Test);
end;

procedure TConditions.Code(Num:Integer);
begin
  Write(Num:3);
end;

procedure TConditions.MoreCode(loc:string);
begin
  Write(loc:3);
end;

function TConditions.GetCond(Index: Char): Boolean;
begin
  Assert(Index in [Low(FCond) .. High(FCond)], Index + ' not in ' + Low(FCond)+'..' + High(FCond));
  Result := FCond[Index];
end;

procedure TConditions.SetCode(Index: Char; aValue: Boolean);
begin
  Assert(Index in [Low(FCond) .. High(FCond)], Index + ' not in ' + Low(FCond)+'..' + High(FCond));
  FCond[Index] := aValue;
end;

procedure TConditions.SetState(CondStr: String; State:Boolean = False);
var
  ix : Integer;
  cx : char;
begin
  if Length(CondStr) = 0  // SetState('') sets all false
   then for cx := Low(FCond) to High(FCond)
    do Condition[cx] := State
   else for ix := 1 to Length(CondStr)
    do begin   // SetState('AbC') sets A and C true, but B false;
      cx := Uppercase(CondStr[ix])[1]; // convert char to index
      Condition[cx] := (CondStr[ix] = cx) // char is uppercase
    end;
end;

procedure TConditions.Test;
var
  ix : Integer;
  cx : Char;
  TestRoutine : TTestProc;
begin
  Writeln;
  Write('Conditions: ');
  for cx := Low(FCond) to High(FCond)
  do if Condition[cx]
   then write(UpperCase(cx))
   else write(LowerCase(cx));
  Writeln;
  for ix := 0 to Count - 1
  do begin
    Write(Strings[ix]:10,' : ');
    TestRoutine := TTestProc(Objects[ix]);
    TestRoutine(Self);
    Writeln;
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure Paul(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A'] then
      Code(1)
    else if Condition['B'] then
      if Condition['C'] then begin
        if Condition['D'] then
          code(2);
        code(3);
      end
    else if Condition['E'] then begin
      code(4);
      morecode('X');
      if Condition['F'] then
        code(5)
      else if Condition['G'] then
        code(6);
    end else begin
      code(7);
      morecode('Y');
    end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure Lars(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A']
     then Code(1)
     else if Condition['B']
      then if Condition['C']
       then begin
         if Condition['D']
          then code(2);
         code(3);
       end
       else if Condition['E']
        then begin
          code(4);
          morecode('X');
          if Condition['F']
           then code(5)
           else if Condition['G']
            then code(6);
        end
        else begin
          code(7);
          morecode('Y');
        end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure LarsExplicit(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A']
     then Code(1)
    else begin
      if Condition['B']
      then begin
        if Condition['C']
        then begin
          if Condition['D']
           then code(2);
          code(3);
        end
        else begin
          if Condition['E']
          then begin
            code(4);
            morecode('X');
            if Condition['F']
             then code(5)
             else if Condition['G']
              then code(6);
          end
          else begin
            code(7);
            morecode('Y');
          end;
        end;
      end;
    end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure TS(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A'] then
      Code(1)
    else if Condition['B'] then
      if Condition['C'] then
      begin
        if Condition['D'] then
          code(2);
        code(3);
      end // without the semi-colon
      else if Condition['E'] then
      begin
        code(4);
        morecode('X');
        if Condition['F'] then
          code(5)
        else if Condition['G'] then
          code(6);
      end
      else
      begin
        code(7);
        morecode('Y');
      end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure MJ(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A'] then
      Code(1)
    else if Condition['B'] then
    begin
      if Condition['C'] then
      begin
        if Condition['D'] then
          code(2);
        code(3);
      end
      else if Condition['E'] then
      begin
        code(4);
        morecode('X');
        if Condition['F'] then
          code(5)
        else if Condition['G'] then
          code(6);
      end
      else
      begin
        code(7);
        morecode('Y');
      end;
    end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure SS(Condition:TConditions);
begin
  with Condition do
  try
    if Condition['A'] then
      Code(1)
    else if Condition['B'] then
      if Condition['C'] then
      begin
        if Condition['D'] then
          code(2);
        code(3);
      end //; I assume this semi-colon has to go
    else if Condition['E'] then
    begin
      code(4);
      morecode('X');
      if Condition['F'] then
        code(5)
      else if Condition['G'] then
        code(6);
      end
    else
    begin
      code(7);
      morecode('Y');
    end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure Jolyon(Condition:TConditions);

  procedure WhenC;
  begin
    with Condition
    do begin
      if Condition['D'] then
        code(2);
      code(3);
    end;
  end;

  procedure WhenE;
  begin
    with Condition
    do begin
      code(4);
      morecode('X');
      if Condition['F'] then
        code(5)
      else if Condition['G'] then
        code(6);
    end;
  end;

begin
  with Condition do
  try
    if Condition['A'] then
      Code(1)
    else if NOT Condition['B'] then
      EXIT;

    if Condition['C'] then
      WhenC
    else if Condition['E'] then
      WhenE
    else
    begin
      code(7);
      morecode('Y');
    end;
  finally
    code(8);
  end;
end;

////////////////////////////////////////////////////////////////////////////////

procedure AO(Condition:TConditions);
begin
  with Condition do
  try
    { This comment explains why Condition['A'] is handled first. }
    if Condition['A'] then begin
      Code(1);
      Exit;
    end;

    { This comment explains why the aggregate of Condition['B'] and Condition['C'] is handled next. }
    if Condition['B'] and Condition['C'] then begin
      { This comment explains why Condition['D'] is relevant only in this block. }
      if Condition['D'] then
        code(2);

      code(3);
      Exit;
    end;

    { This comment explains why Condition['E'] is handled next. }
    if Condition['E'] then begin
      code(4);
      morecode('X');

      { This comment explains why Condition['F'] and Condition['G'] are relevant only in this block. }
      if Condition['F'] then
        code(5)
      else if Condition['G'] then
        code(6);

      Exit;
    end;

    { This comment explains the default handling. }
    code(7);
    morecode('Y');
  finally
    { This comment explains why the following code must execute no matter what. }
    code(8);
  end;
end;

var
  Conditions : TConditions;
begin
  Conditions := TConditions.Create;
  try

    Conditions.AddTest('Paul', Paul);
    Conditions.AddTest('TS', TS);
    Conditions.AddTest('SS', SS);
    Conditions.AddTest('Jolyon', Jolyon);
    Conditions.AddTest('AO', AO);
    Conditions.AddTest('Lars', Lars);
    Conditions.AddTest('MJ', MJ);
    Conditions.AddTest('Lars II', LarsExplicit);


    try
      Conditions.SetState('ABCDEFG');
      Conditions.Test;

      Conditions.SetState('aBCDEFG');
      Conditions.Test;

      Conditions.SetState('abCDEFG');
      Conditions.Test;

      Conditions.SetState('abcDEFG');
      Conditions.Test;

      Conditions.SetState('aBcDEFG');
      Conditions.Test;

      Conditions.SetState('aBcdeFG');
      Conditions.Test;

      Conditions.SetState('aBcdEfG');
      Conditions.Test;

      Conditions.SetState('aBcdefg');
      Conditions.Test;
    except
      on E:Exception
      do Writeln('Exception ', E.Message);
    end;
  finally
    Writeln;
    Write('Press Enter: ');
    Readln;
    FreeAndNil(Conditions);
  end;
end.