Отправляет email-рассылки с помощью сервиса Sendsay

Мастера DELPHI. Новости мира компонент, FAQ, статьи...

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Delphi - проблемы и решения" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Октябрь 2004   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
Сергей

Статистика

13.577 подписчиков
-18 за неделю
←   Все выпуски   →

Мастера DELPHI. Новости мира компонент, FAQ, статьи...


Информационный Канал Subscribe.Ru
Ежедневная рассылка сайта Мастера DELPHI

DELPHIMASTER.ru

Выпуск от 12.10.04 09:18

Лучшее из нашего FAQ   |x|
Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается.
Зравствуете Акжан.
У вас в разделе есть следующий ворос и несколько ответов на него:
 
Вот всю жизнь в TVision в итераторах нужно было (параметром) передавать указатель на локальную процедуру, а тут задумал сделать свой итератор для обхода некоей древовидной структуры и на тебе - компилятор ругается. Да еще и в хелпе носом тыкают, что так мол в принципе нельзя делать... Гм. И как быть?
 
- могу предложить собственное решение данной проблемы. Тем более, что мой способ работает с рекурсивными вызовами любого уровня сложности:

type
  Long = LongInt;
  Bool = Boolean; // - так уж у меня в библиотеке сложилось
  Tl3IteratorAction = function(Data: Pointer; Index: Long): Bool;
                      {$IfDef Win32}
                      register;
                      {$EndIf Win32}
var
 l3StubHead : THandle = 0;
 
function
l3AllocStub: THandle;
  {-}
(*  register;
asm
      
     mov   ecx, l3StubHead
          jecxz @Alloc
          mov   eax, ecx
          mov   ecx, [ecx]
          mov   l3StubHead, ecx
          ret
@Alloc:
          xor   eax, eax
          push  16               { SizeOf(TCode) -> stack  }
          push  eax              { GMem_Fixed -> stack     }
          call  GlobalAlloc
@ret:
end;{asm}*)
begin
 if (l3StubHead = 0) then
  Result := Windows{l3System}.GlobalAlloc(GMem_Fixed, 16)
 else begin
  Result := l3StubHead;
  l3StubHead := PHandle(Result)^;
 end;
end;
 
procedure l3FreeLocalStub(Stub: Pointer);
  {-}
begin
 PHandle(Stub)^ := l3StubHead;
 l3StubHead := THandle(Stub);
end;
 
(*procedure l3FreeLocalStub(Stub: Pointer);
                          {eax}
 
register;
  {-}
asm
          push eax                              
  { Handle -> stack         }
          call GlobalFreeend<
/b>;{asm}*)
 
procedure l3FreeStubs;
var
 Prev : THandle;
 Next : THandle;
begin
 Prev := l3StubHead;
 while (Prev <> 0) do begin
  Next := PHandle(Prev)^;
  Windows{l3System}.GlobalFree(Prev);
  Prev := Next;
 end;{Prev <> 0}
 l3StubHead := 0;
end;
 
(*type
  TCode = array [0..11] of Byte;
const
  Code : TCode = (
    $66, $58,               { pop eax         }
    $68, $FF, $FF,          { push $FFFF      } { OldBP  }
    $66, $50,               { push eax        }
    $EA, $EE, $EE, $FF, $FF { jmp $FFFF:$EEEE } { Action }
  );*)
 
function l3LocalStub(Action: Pointer): Pointer;
                     {eax}
  register;
  {-}
asm
          push edi                               { Save edi                }
         
push eax                               { Save Action             }
         
  call l3AllocStub
          {! --- !}
          {xor  eax, eax                          { 0 -> eax                }
          {push 16                                { SizeOf(TCode) -> stack  }
          {push eax                               { GMem_Fixed -> stack     }
          {call GlobalAlloc}
          {! --- !}
 
          { Создаем новый код: }
          mov  edi, eax                          { Handle -> edi           }
          mov  edx, eax                          { Handle -> edx           }
          cld                                    { Move forward            }
 
          mov  eax, $68
          stosb
          mov  eax, ebp                          { предыдущий ebp -> eax   }
          stosd                                  { "push OldBP" -> [edi]   }
 
          mov  eax, $B9
          stosb
          pop 
eax                               { Action -> eax           }
          stosd         
                          { "mov ecx, Action" -> [edi] }
 !
 
    
      mov  eax, $D1FF
          stosw                                  { "call ecx" -> [edi]     }
 
          mov  eax, $59
          stosb                                  { "pop ecx" -> es:[di]    }
 
          mov  eax, $C3
          stosb                                  { "ret" -> [edi]          }
 
          mov  eax, edx                          { Handle -> eax           }
          pop  edi                               { Restore edi             }
end;{asm}
 
function  l3L2IA(Action: Pointer): Tl3IteratorAction;
                {eax}
  register;
  {-}
asm
          jmp  l3LocalStub
end;{asm}
 
procedure l3FreeIA(Stub: Tl3IteratorAction);
                  {eax}
  register;
  {-}
asm
          jmp  l3FreeLocalStub
end;{asm}
 
теперь
простейшая реализация итератора:
 
procedure Tl3VList.Iterate(aLo, aH
 i: Tl3Index; Action: Tl3IteratorAction);
  {virtual;{!v19}         {edx, ecx}
  register;
  {-}
(*asm
         push ebx
         mov  ebx, eax
         mov  eax, [eax].Tl3VList.f_Count
         or   eax, eax
         jle  @@ret // список пуст
 
         dec  eax
         cmp  ecx, eax
         jle  @@aHiLECount
         mov  ecx, eax
@@aHiLECount:
 
         mov  eax, [ebx].Tl3VList.f_List
         or   eax, eax
         jz   @@ret // список пуст
 
         or   edx, edx
         jge  @@aLoGE0
         xor  edx, edx
@@aLoGE0:
         sub  ecx, edx
         jl   @@ret // верхний индекс меньше нижнего
 
         mov  ebx, edx
         shl  ebx, 2
         add  eax, ebx
 
         pop  ebx
         inc  ecx
 
@@loop:
         push eax
         push edx
        
push ecx
 
         call Action
 
         pop  ecx
         p
 op  edx
 
         or   al, al
         jz   @@loop!
 end
 

         pop  eax
         add  eax, 4
         inc  edx
 
         loop @@loop
 
         jmp  @@ex
@@loopend:
         pop  eax
         jmp  @@ex
@@ret:
         pop  ebx
@@ex:
end;//asm*)
var
 i, j, k : Long;
 l_TmpItem : Pointer;
begin
 if (f_List <> nil) then begin
  j := Max(0, aLo);
  k := Min(Pred(Count), aHi);
  if IsMultiThread then
   for i := j to k do begin
    l_TmpItem := Items[i];
    if not Action(@l_TmpItem, i) then break;
   end
  else
   for i := j to k do
    if not Action(PChar(f_List) + i * SizeOf(Pointer), i) then break;
 end;{f_List <> nil}
end;
 
procedure Tl3VStorage.IterateF(I1, I2: Tl3Index; Action:
Tl3IteratorAction);
  {-}
begin
 try
  Iterate(I1, I2, Action);
 finally
  l3FreeIA(Action);
 end;{try..finally}
end;
 
и его вызов:
 
function Tl3VList.IndexOf(Item: Pointer): LongInt;
 
 function FindItem(P: PPointer; Index: Long): Bool; far;
 begin
  if (P^ = Item) then begin
   IndexOf := Index;
   Result := false;
  end else
   Result := true;
 end;
 
begin
 Result := -1;
 IterateAllF(l3L2IA(@FindItem));
end;

 
- забавно, что метод Iterate можно вызывать как для глобального, так и для локального метода (естественно с предшествующим вызовом l3L2IA).
в секции finalization модуля где живет l3L2IA надо не забыть вызвать метод: l3FreeStubs.
- это схематично идеи, просто выдирать все целиком из своей библиотеки - тяжело да и некогда.

-- Прислал: Alex W. Lulin lulin@garant.ru http://lulinalex.chat.ru --

»»» Прислать свои комментарии

Обсуждается в конференциях   |x|
  • avi,mpg + + +
    Добрый вечер господа Знатоки... Подскажите мне пожалуйста, где можно найти информацию по такому вопросу.: Как работать ...
  • размножение сессий на сервере БД
    Конекчусь к серверу создаю временную таблицу с пом query (create table....) Потом , при подготовке даныых для insert ...
  • memo.add
    никак не пойму как сделать чтение из текстового файла в мемо. нет ни memo.add.line, ни memo.loadfromfile
  • масшабирование webbrowser
    помогите пожалуйста увеличить изображение передаваемое в webbrowser на полный экран.
  • Как рисовать на экране?
    метод Canvas рисует только на текущей форме и ни дальше...
  • VirtualProtect
    Добрый день, мастера! Начну с главного, мне необходимо перехватить winapi'шную функцию CreateFile из одной другой проги,...
  • Интеграция Delphi и Excel. Мастера откликнитесь.
    unit Unit1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Excel97, ...
У нас большой выбор статей   |x|
Сохранение и загрузка данных в объекты на примере коллекций.
Если в Вашей программе используются классы для описания объектов некоторой предметной области, то данные, их инициализирующие, можно хранить и в базе данных. Но можно выбрать гораздо более продуктивный подход, который доступен в Delphi.
Новинки книжного рынка   |x|
Теория и практика построения баз данных. 8-е изд.
В книге, написанной в форме учебного пособия для студентов, специализирующихся в области информационных технологий, освещается широкий круг теоретических и практических вопросов, связанных с разработкой и использованием баз данных. К особенностям восьмого издания книги относится, в частности, появление материала, посвященного новым технологиям публикации баз данных (XML) и обработки баз данных масштаба предприятия (ODBC, ASP, JDBC, JSP). Книгу отличает продуманность структуры, живой и доступный язык изложения, а также большое количество примеров, моделирующих типичные ситуации из практики делового мира.
Автор: Крёнке Д.
Опрос населения :)
Стоит ли устраивать встречи программистов в реале? (пирушки :)
»»» Обязательно!
»»» Иногда можно
»»» Я туда не пойду
»»» Категорически нет
Для души

Хокку дня
И осенью хочется жить
Этой бабочке: пьет торопливо
С хризантемы росу.

Афоризмы
Неприличное - это очень личное.

Фраза дня
"Любишь кататься - катись к чертовой матери!" //Андрей Кнышев

Дурацкие законы (информация предоставлена сайтом kurilka.com)
В Северной Каролине (США) останавливающиеся в отелях пары должны жить в номерах с двумя кроватями, поставленными на растоянии не меньше полуметра друг от друга. Заниматься сексом на полу между кроватями строжайше запрещено.
В Дании вы можете ездить на машине только в том случае, если перед ней двигается кто нибудь с флажком, чтобы предупредить конные повозки о приближении автомобиля.

И на закуску коротенький анекдот
Дама пожаловалась врачу, что у нее нет детей.
- Может быть, это наследственное, - сказал врач.
- Скажите, а у вашей матери были дети?

Фотоприколы.
Начните день с хорошего настроения!
http://www.delphimaster.ru/cgi-bin/prikol.pl?id=102

На этом позвольте откланяться и пожелать вам удачного дня.
Искренне ваш, Алексей (merlin@delphimaster.ru)

Добро пожаловать на сайт -= Мастера DELPHI =- 
http://subscribe.ru/
http://subscribe.ru/feedback/		 Подписан адрес:
Код этой рассылки: comp.soft.prog.mdelphi		 Отписаться
В избранное