Sergey Antonov - 2010 - Blog post : Just Any type Delphi Case statement

Multi_Case.dpr

{$APPTYPE CONSOLE}
program Multi_Case;

// Also see -  http://delphi.fosdal.com/2010/12/generic-case-for-strings.html
//          -  http://delphi.fosdal.com/2010/12/generic-cache.html

uses system.SysUtils, system.Generics.Defaults;

// Just Any type Delphi Case statement  (2010)
// Sergey Antonov Blog
// https://santonov.blogspot.com/2010/04/just-any-type-delphi-case-statement.html

type
    TPAIRTYPE<T> = record
      Value:T;
      Proc :TProc;
    end;

    CaseAnyTypeClassSupport<T> = class
      private
        class function  GetCaseOption(Value:T;Action:TProc):TPAIRTYPE<T>;                    static;
      public
        class procedure MyCase(const Value : T;
                               const Pairs : array of TPAIRTYPE<T>;
                                  ElseProc : TProc=nil);                                     static;

        class property  CaseOption[Value:T;Action:TProc] : TPAIRTYPE<T> read GetCaseOption; default;
    end;



    class procedure CaseAnyTypeClassSupport<T>.MyCase(const Value:T;const Pairs:array of TPAIRTYPE<T>;ElseProc:TProc=nil);
    var
           Pair:TPAIRTYPE<T>;
       Comparer:IComparer<T>;
    begin
        Comparer:=TComparer<T>.Default;
        for Pair in Pairs do
            if Comparer.Compare(Value,Pair.Value)=0 then begin
               Pair.Proc();
               exit;
            end;
        if Assigned(ElseProc) then ElseProc();
    end;


    class function CaseAnyTypeClassSupport<T>.GetCaseOption(Value:T;Action:TProc) : TPAIRTYPE<T>;
    begin
        Result.Value := Value;
        Result.Proc  := action;
    end;



//and usage

procedure Try_Case;
var
    Stuff : CaseAnyTypeClassSupport<string>;
begin
    Stuff.MyCase( '2',
                  [  
                     Stuff['4',procedure begin writeln('Option 1'); end],
                     Stuff['2',procedure begin writeln('Option 2'); end]
                  ],
                  procedure begin writeln('Else option'); end
                );
end;


begin
//Because of restriction of Delphi compiler you could not write usage like this
var stuff : CaseAnyTypeClassSupport<string>;

with stuff do
     MyCase( '2',
             [
               Stuff['4', procedure begin writeln('Option 1'); end],   // blog post tried to omit "Stuff" on these lines
               Stuff['2', procedure begin writeln('Option 2'); end]
             ],
             procedure begin writeln('Else option'); end
           );

//You can enhance MyCase for supports variance types(type with subtypes) the same way.
end.