Do you remember the discussion about a case statement for strings?
I got this flash idea after reading Jolyon Smith’s “The case for case[]”, and remembering a comment from Francisco Ruiz on Nick Hodges’ article on THTMLWriter which suggested using a default array property in a creative fashion.
Honestly, it is not really a true case statement, and it might not be as fast as an if then else, but here is how it looks when used. A bit ugly. but good fun 🙂
program TestGenericsSwitch;
{$apptype Console}
uses
  GenericsSwitch;
begin
TStringSwitch.CaseOf('chARLie')
['Any', procedure begin
Writeln('Definitively any case');
end]
['B', procedure begin
Writeln('B all you can B');
end]
['Charlie', procedure begin
Writeln('Checkpoint C');
end]
.ElseCase(procedure begin
Writeln('Else what?');
end)
.EndCase;
end.
And here is how it is implemented.
unit GenericsSwitch;
/// Written by Lars Fosdal , December 1, 2010
interface
uses
SysUtils, Generics.Collections;
type
TSwitchProc = reference to procedure;
TGenericSwitch = class(TObjectDictionary)
private
FTheElseCase: TSwitchProc;
FTheTargetKey: KeyType;
function AddSwitchCase(const name: KeyType;
const value: TSwitchProc): TGenericSwitch;
procedure SetTheElseCase(const Value: TSwitchProc);
procedure SetTheTargetKey(const Value: KeyType);
protected
function ValidateKey(Key:KeyType):KeyType; virtual;
property TheTargetKey:KeyType read FTheTargetKey write SetTheTargetKey;
property TheElseCase:TSwitchProc read FTheElseCase write SetTheElseCase;
public
class function CaseOf(const Key: KeyType):TGenericSwitch;
function ElseCase(const Action: TSwitchProc): TGenericSwitch;
procedure EndCase;
property Cases[const name:KeyType; const value:TSwitchProc]: TGenericSwitch
read AddSwitchCase; default;
end;
TStringSwitch = class(TGenericSwitch)
function ValidateKey(key:String):String; override;
end;
implementation
{ TGenericSwitch }
function TGenericSwitch.AddSwitchCase(const name: KeyType; const value: TSwitchProc): TGenericSwitch;
begin
Result := Self;
Add(ValidateKey(Name), Value);
end;
class function TGenericSwitch.CaseOf(const Key: KeyType): TGenericSwitch;
begin
Result := Create;
Result.TheTargetKey := Key;
end;
function TGenericSwitch.ElseCase(const Action: TSwitchProc): TGenericSwitch;
begin
Result := Self;
TheElseCase := Action;
end;
procedure TGenericSwitch.EndCase;
var
DoIt : TSwitchProc;
begin
if TryGetValue(TheTargetKey, DoIt)
then DoIt
else
if Assigned(TheElseCase)
then TheElseCase;
Destroy;
end;
procedure TGenericSwitch.SetTheElseCase(const Value: TSwitchProc);
begin
FTheElseCase := Value;
end;
procedure TGenericSwitch.SetTheTargetKey(const Value: KeyType);
begin
FTheTargetKey := ValidateKey(Value);
end;
function TGenericSwitch.ValidateKey(Key: KeyType):KeyType;
begin
Result := Key;
end;
{ TStringSwitch }
function TStringSwitch.ValidateKey(key: String): String;
begin
Result := LowerCase(Key);
end;
end.
You must be logged in to post a comment.