Модератор: Модераторы
zub писал(а):Нифига не заставляет. Много раз ловил глюки потому что забывал в некоторых функциях скопипастить новые сигнатуры, а компилятор это пропускал. (емнип в режиме делфи параметры вообще не контролируются) Такчто это наоборот гарантия актуальности определения функциипроцедуры.
zub писал(а):Имеем примерно такой код
....
Т.е. куча функций, та которую надо вызвать вычисляется в рантайме, и вызывается через переменную процедурного типа.
Зачем при объявлении 100500 функций надо писать полную декларацию?
...
Потом приспичивает добавить например arg2 и приходится 100500 раз копипастить.
какнибудь так было бы гораздо логичней:
...
т.е. при декларации использовать уже определенный процедурный тип. все изменения можно производить централизовано.
Есть мнения за или против?
type
TCommand = class
arg1 : integer;
procedure Execute; virtual;
end;
TCommand1 = class(TCommand)
...
TCommand100500 = class(TCommand)
type
TCommand = class
arg1 : integer;
procedure CommandStart(...); virtual;
procedure CommandEnd(...); virtual;
procedure CommandCancel(...); virtual;
procedure Execute(...); virtual;
procedure MouseMove(...); virtual;
....
end;
TCommand1 = class(TCommand)
...
TCommand100500 = class(TCommand)
zub писал(а):Но в большинстве случаев вполне хватает простой процедуры, зачем усложнять на ровном месте?
program project1;
{$mode delphi}{$H+}
uses
SysUtils, Classes
{ you can add units after this };
type
TMyCommandResult = (mcrOk, mcrFail);
TMyArg = integer;
TMyArg2 = string;
TMyCommandOld=function(arg1:TMyArg):TMyCommandResult;
TMyCommand=function(arg1: TMyArg; const arg2: TMyArg2): TMyCommandResult;
function command1(arg1:TMyArg):TMyCommandResult;
begin
writeln('command1 ',arg1);
Result:=mcrOk;
end;
function command2(arg1:TMyArg):TMyCommandResult;
begin
writeln('command2 ',arg1);
Result:=mcrOk;
end;
function command100500(arg1:TMyArg):TMyCommandResult;
begin
writeln('command1005000 ',arg1);
Result:=mcrOk;
end;
{$PUSH}
{$OPTIMIZATION OFF}
function commandArg1Dummy(arg1: TMyArg): TMyCommandResult;
begin
Result:=mcrOk;
end;
function commandArg2ToArg1(arg1: TMyArg; const arg2: TMyArg2): TMyCommandResult;
begin
Result:=commandArg1Dummy(arg1);
end;
function getArg2ToArg1CodeSize: PtrInt;
begin
Result:=abs(PtrUInt(@getArg2ToArg1CodeSize)-PtrUint(@commandArg2ToArg1));
end;
{$POP}
function commandOver9999(arg1:TMyArg; const arg2: TMyArg2):TMyCommandResult;
begin
writeln('Over9999 ');
writeln('arg1= ', arg1);
writeln('arg2= ', arg2);
Result:=mcrOk;
end;
function MakeCommandArg2(oldcommand: TMyCommandOld): TMyCommand;
var
sz : integer;
i : integer;
pb : PByte;
dst : PtrUint;
src : PtrUint;
fn : Pointer;
begin
Result:=nil;
dst:=PtrUInt(@oldcommand);
sz:=getArg2ToArg1CodeSize;
Getmem( fn, sz);
Move( Pointer(@commandArg2ToArg1)^, fn^, sz);
pb:=fn;
// a hack as is itself! works for i386 only
for i:=0 to sz-1 do begin
// this is presumably x86 "call" ... but an ability to shoot yourself in a foot!
if pb^=$e8 then begin
PtrUInt(pb):=PtrUInt(pb)+1;
src:=PtrUint(pb)+4;
PPtrInt(pb)^:=dst-src;
break;
end;
PtrUInt(pb):=PtrUInt(pb)+1
end;
Result:=TMyCommand(fn);
end;
var
//todo: replace with registry list
command1ptr : TMyCommand = nil;
command2ptr : TMyCommand = nil;
command100500ptr : TMyCommand = nil;
function GetNeededCommand(const cmdname: string): TMyCommand;
begin
if cmdname='command1' then begin
if not Assigned(command1ptr) then command1ptr:= MakeCommandArg2(command1);
Result:=command1ptr;
end else if cmdname='command2' then begin
if not Assigned(command2ptr) then command2ptr:= MakeCommandArg2(command2);
Result:=command2ptr;
end else if cmdname='command100500' then begin
if not Assigned(command100500ptr) then command100500ptr:= MakeCommandArg2(command100500);
Result:=command100500ptr;
end else if cmdname='commandOver9000' then begin
Result:=@commandOver9999;
end else
Result:=commandArg2ToArg1;
end;
var
com: TMyCommand;
res: TMyCommandResult;
nm : string;
begin
if ParamCount=0 then begin
writeln('no command specicifed, using default "command1"')
end else begin
nm:=ParamStr(1);
writeln('executing command: ', nm);
end;
com:=GetNeededCommand(nm);
res:=com(1,'test');
writeln(res);
end.
function commandArg2ToArg1(arg1: TMyArg; const arg2: TMyArg2): TMyCommandResult;
var
p : TMyCommandOld;
begin
p := nil; //да, господа!
Result:=p(arg);
end;
00401660 <P$PROJECT1_$$_COMMANDARG2TOARG1$LONGINT$ANSISTRING$$TMYCOMMANDRESULT>:
401660: 55 push %ebp
401661: 89 e5 mov %esp,%ebp
401663: 8d 64 24 f0 lea -0x10(%esp),%esp
401667: 89 45 fc mov %eax,-0x4(%ebp)
40166a: 89 55 f8 mov %edx,-0x8(%ebp)
40166d: c7 45 f0 00 00 00 00 movl $0x0,-0x10(%ebp)
401674: 8b 45 fc mov -0x4(%ebp),%eax
401677: ff 55 f0 call *-0x10(%ebp)
40167a: 88 45 f4 mov %al,-0xc(%ebp)
40167d: 8a 45 f4 mov -0xc(%ebp),%al
401680: c9 leave
401681: c3 ret
zub писал(а):В списке рассылки предложение завернули, впрочем как и ожидалось
zub писал(а):В списке рассылки предложение завернули, впрочем как и ожидалось
zub писал(а):http://lists.freepascal.org/pipermail/fpc-pascal/2017-April/050895.html
cmd:=GetCommand;
if isOldCommand then
TMyOldCommand(cmd)(arg1)
else
TMyCommand(cmd)(arg1,arg2)
скалогрыз писал(а):TMyCommand(cmd)(arg1,arg2)
procedure MouseMove(...); virtual;
get3dpoint
zub писал(а):
- Код: Выделить всё
type
TCommand = class
arg1 : integer;
procedure CommandStart(...); virtual;
procedure CommandEnd(...); virtual;
procedure CommandCancel(...); virtual;
procedure Execute(...); virtual;
procedure MouseMove(...); virtual;
....
end;
zub писал(а):я наоборот после 5й команды понял что с классов надо слазить в пользу простых процедурфункций, классы это слишком многословно - надо объявить, создать, зарегестрировать... Но меня долго сдерживала событийная ориентированность, одно дело класс с методом
Вернуться в Free Pascal Compiler
Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 5