воскресенье, 25 апреля 2010 г.

Gathering and mixing

Enhancing systax for support: Structs, objects and parametrized types

вторник, 6 апреля 2010 г.

пятница, 2 апреля 2010 г.

Just Any type Delphi Case statement

Just Any type Delphi Case statement

Here is the implementation.

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;

uses generics.defaults;

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.GetCaseOption(Value:T;Action:TProc):TPAIRTYPE[T];
begin
Result.Value:=Value;
Result.Proc:=action;
end;

and a usage

procedure TForm2.FormCreate(Sender: TObject);
var Stuff:CaseAnyTypeClassSupport[string];
begin
Stuff.MyCase('2',
[
Stuff['4',procedure
begin
showmessage('Option 1');
end],
Stuff['2',procedure
begin
showmessage('Option 2');
end]
],procedure
begin
showmessage('Else option');
end);
end;

Because of restriction of Delphi compiler you could not write usage like this

with stuff do
MyCase('2',
[
['4',procedure
begin
showmessage('Option 1');
end],
['2',procedure
begin
showmessage('Option 2');
end]
],procedure
begin
showmessage('Else option');
end);
end;

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