Взялся он вот откуда. СТАНДАРТНАЯ библиотека:
unit Vcl.Menus;
....
{$IFNDEF WIN32}
// Win64 and CLR both use Iterator objects instead of local procedure for operations which
// require iterating over the menu items. Calling a local procedure in a class method
// requires special a ASM thunk
{$DEFINE ITERATOR_OBJECTS}
{$ENDIF}
type
TIterator = function (MenuItem: TMenuItem): Boolean{$IFDEF ITERATOR_OBJECTS} of object{$ENDIF};
procedure IterateMenus(Func: TIterator; Menu1, Menu2: TMenuItem);
var
IIndex: Integer;
function Iterate(var I: Integer; MenuItem: TMenuItem; AFunc: TIterator): Boolean;
var
Item: TMenuItem;
begin
Result := False;
if MenuItem = nil then Exit;
while not Result and (I < MenuItem.Count) do
begin
Item := MenuItem[I];
if Item.GroupIndex > IIndex then Break;
{$IFDEF ITERATOR_OBJECTS}
Result := AFunc(Item);
{$ELSE !ITERATOR_OBJECTS}
{$IFDEF CPUX86}
// Thunk to to call a local procedure on a class. Kinda hokey if you ask ME.
asm
MOV EAX,Item
MOV EDX,[EBP+8]
PUSH DWORD PTR [EDX]
CALL DWORD PTR AFunc
ADD ESP,4
MOV Result,AL
end;
{$ENDIF CPUX86}
{$ENDIF !ITERATOR_OBJECTS}
Inc(I);
end;
end;
var
I, J: Integer;
JIndex: Byte;
Menu1Size, Menu2Size: Integer;
Done: Boolean;
begin
I := 0;
J := 0;
Menu1Size := 0;
Menu2Size := 0;
if Menu1 <> nil then Menu1Size := Menu1.Count;
if Menu2 <> nil then Menu2Size := Menu2.Count;
Done := False;
while not Done and ((I < Menu1Size) or (J < Menu2Size)) do
begin
IIndex := High(Byte);
JIndex := High(Byte);
if (I < Menu1Size) then IIndex := Menu1[I].GroupIndex;
if (J < Menu2Size) then JIndex := Menu2[J].GroupIndex;
if IIndex <= JIndex then Done := Iterate(I, Menu1, Func)
else
begin
IIndex := JIndex;
Done := Iterate(J, Menu2, Func);
end;
while (I < Menu1Size) and (Menu1[I].GroupIndex <= IIndex) do Inc(I);
while (J < Menu2Size) and (Menu2[J].GroupIndex <= IIndex) do Inc(J);
end;
end;
unit Vcl.Menus;
....
{$IFNDEF WIN32}
// Win64 and CLR both use Iterator objects instead of local procedure for operations which
// require iterating over the menu items. Calling a local procedure in a class method
// requires special a ASM thunk
{$DEFINE ITERATOR_OBJECTS}
{$ENDIF}
type
TIterator = function (MenuItem: TMenuItem): Boolean{$IFDEF ITERATOR_OBJECTS} of object{$ENDIF};
procedure IterateMenus(Func: TIterator; Menu1, Menu2: TMenuItem);
var
IIndex: Integer;
function Iterate(var I: Integer; MenuItem: TMenuItem; AFunc: TIterator): Boolean;
var
Item: TMenuItem;
begin
Result := False;
if MenuItem = nil then Exit;
while not Result and (I < MenuItem.Count) do
begin
Item := MenuItem[I];
if Item.GroupIndex > IIndex then Break;
{$IFDEF ITERATOR_OBJECTS}
Result := AFunc(Item);
{$ELSE !ITERATOR_OBJECTS}
{$IFDEF CPUX86}
// Thunk to to call a local procedure on a class. Kinda hokey if you ask ME.
asm
MOV EAX,Item
MOV EDX,[EBP+8]
PUSH DWORD PTR [EDX]
CALL DWORD PTR AFunc
ADD ESP,4
MOV Result,AL
end;
{$ENDIF CPUX86}
{$ENDIF !ITERATOR_OBJECTS}
Inc(I);
end;
end;
var
I, J: Integer;
JIndex: Byte;
Menu1Size, Menu2Size: Integer;
Done: Boolean;
begin
I := 0;
J := 0;
Menu1Size := 0;
Menu2Size := 0;
if Menu1 <> nil then Menu1Size := Menu1.Count;
if Menu2 <> nil then Menu2Size := Menu2.Count;
Done := False;
while not Done and ((I < Menu1Size) or (J < Menu2Size)) do
begin
IIndex := High(Byte);
JIndex := High(Byte);
if (I < Menu1Size) then IIndex := Menu1[I].GroupIndex;
if (J < Menu2Size) then JIndex := Menu2[J].GroupIndex;
if IIndex <= JIndex then Done := Iterate(I, Menu1, Func)
else
begin
IIndex := JIndex;
Done := Iterate(J, Menu2, Func);
end;
while (I < Menu1Size) and (Menu1[I].GroupIndex <= IIndex) do Inc(I);
while (J < Menu2Size) and (Menu2[J].GroupIndex <= IIndex) do Inc(J);
end;
end;
// Thunk to to call a local procedure on a class. Kinda hokey if you ask ME.
!!! ОЧЕНЬ УЖ мне этот комментарий, тех, кто разбирался с наследством Borland'а - ПОНРАВИЛСЯ !!!
Комментариев нет:
Отправить комментарий