воскресенье, 25 апреля 2010 г.
вторник, 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.
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
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.
Подписаться на:
Сообщения (Atom)