Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 4 817

Раздел: Delphi » Общие вопросы по программированию
/ вопрос открыт /

Здравствуйте!
ок. хочу получить возможность работать со вложенными открытыми массивами, вроде такого:
[ 'a', ['b','c'], ['d',['e','f'],'g'], 'h' ]
при этом желательно, чтобы это был массив array of const


собственно вопросы возникли по статье:
http://www.delphisources.ru/pages/fa..._of_const.html

Приложение:
  1.  
  2. type
  3. ArrayOfConst = array of TVarRec;
  4. TArrayOfConst = array [ 0 .. High (WORD) div SizeOf (TVarRec) - 1 ] of TVarRec;
  5. PArrayOfConst = ^TArrayOfConst;
  6.  
  7. function PArrayOfConstMerge (anArgs1, anArgs2: array of const) : PArrayOfConst;
  8. var
  9. I : WORD;
  10. Index : WORD;
  11. Length : WORD;
  12. begin
  13. Result := NIL;
  14. try
  15. Length := 0;
  16. if ( High (anArgs1) >= 0 ) then
  17. Length := Length + High (anArgs1) - Low (anArgs1) +1;
  18. if ( High (anArgs2) >= 0 ) then
  19. Length := Length + High (anArgs2) - Low (anArgs2) +1;
  20. if ( Length > 0 ) then
  21. begin
  22. Result := AllocMem ( Length * SizeOf (TVarRec) );
  23. Index := 0;
  24. for I := Low (anArgs1) to High (anArgs1) do
  25. begin
  26. Result^ [Index] := anArgs1 [i];
  27. Inc (Index);
  28. end;
  29. for I := Low (anArgs2) to High (anArgs2) do
  30. begin
  31. Result^ [Index] := anArgs2 [i];
  32. Inc (Index);
  33. end;
  34. end;
  35. except
  36. Result := NIL;
  37. end;
  38. end;
  39.  
  40. function ArrayOfConstMerge (anArgs1, anArgs2: array of const) : ArrayOfConst;
  41. var
  42. I : WORD;
  43. Index : WORD;
  44. Length : WORD;
  45. begin
  46. Result := NIL;
  47. try
  48. Length := 0;
  49. if ( High (anArgs1) >= 0 ) then
  50. Length := Length + High (anArgs1) - Low (anArgs1) +1;
  51. if ( High (anArgs2) >= 0 ) then
  52. Length := Length + High (anArgs2) - Low (anArgs2) +1;
  53. if ( Length > 0 ) then
  54. begin
  55. SetLength (Result,Length);
  56. Index := 0;
  57. for I := Low (anArgs1) to High (anArgs1) do
  58. begin
  59. Result [Index] := anArgs1 [i];
  60. Inc (Index);
  61. end;
  62. for I := Low (anArgs2) to High (anArgs2) do
  63. begin
  64. Result [Index] := anArgs2 [i];
  65. Inc (Index);
  66. end;
  67. end;
  68. except
  69. Result := NIL;
  70. end;
  71. end;
  72.  
  73. function PointerToArrayOfConst (anArgs: array of const) : PArrayOfConst;
  74. var
  75. I : WORD;
  76. Index : WORD;
  77. Length : WORD;
  78. begin
  79. Result := NIL;
  80. try
  81. Length := 0;
  82. if ( High (anArgs) >= 0 ) then
  83. Length := Length + High (anArgs) - Low (anArgs) +1;
  84. if ( Length > 0 ) then
  85. begin
  86. Result := AllocMem ( Length * SizeOf (TVarRec) );
  87. Index := 0;
  88. for I := Low (anArgs) to High (anArgs) do
  89. begin
  90. Result^ [Index] := anArgs [i];
  91. Inc (Index);
  92. end;
  93. end;
  94. except
  95. Result := NIL;
  96. end;
  97. end;
  98.  
  99.  
  100.  
  101. function f1 (anArgs: array of const) : String;
  102. var
  103. I : Integer;
  104. begin
  105. Result := '';
  106. for I := Low (anArgs) to High (anArgs) do
  107. Result := Format ('%s:%s',[ Result, ParamToStr (anArgs [i]) ]);
  108. end;
  109.  
  110. function f2 (anArgs: array of const) : String;
  111. begin
  112. Result := f1 ( ArrayOfConstMerge (anArgs,['test','testtest','yo-ho','hi-hi','laaa']) );
  113. end;
  114.  
  115. function arrays (anArgs: array of const) : String;
  116. var
  117. I : Integer;
  118. P : PArrayOfConst;
  119. begin
  120. Result := '';
  121. for I := Low (anArgs) to High (anArgs) do
  122. begin
  123. P := ParamToPointer (anArgs [i]);
  124. if Assigned (P) then
  125. Result := Format ('%s;%s',[ Result, f1 ( PointerToArrayOfConst (P) ) ])
  126. else
  127. Result := Format ('%s;%s',[ Result, ParamToStr (anArgs [i]) ]);
  128. end;
  129. end;
  130.  
  131. s := arrays ( [ 'a', _const (['hello','world','test1']), 1, _const (['test2','test3']), _const ([]) ] );
  132.  
  133.  
  134. ;a;:hello:world:test1;1;:test2:test3;0
  135.  
  136.  
  137.  
  138. function _const (anArgs: PArrayOfConst) : ArrayOfConst;
  139. var
  140. ArrayOfConstCallAlias : procedure (var Result: ArrayOfConst; var anArgs: TVarRec; High: WORD);
  141. I : WORD;
  142. A : ArrayOfConst;
  143.  
  144. procedure ArrayOfConstCall (var Result: ArrayOfConst; anArgs: array of const);
  145. var
  146. I : WORD;
  147. Index : WORD;
  148. Length : WORD;
  149. begin
  150. Result := NIL;
  151. try
  152. Length := 0;
  153. if ( High (anArgs) >= 0 ) then
  154. Length := Length + High (anArgs) - Low (anArgs) +1;
  155. if ( Length > 0 ) then
  156. begin
  157. SetLength (Result,Length);
  158. Index := 0;
  159. for I := Low (anArgs) to High (anArgs) do
  160. begin
  161. Result [Index] := anArgs [i];
  162. Inc (Index);
  163. end;
  164. end;
  165. except
  166. Result := NIL;
  167. end;
  168. end;
  169.  
  170. begin
  171. Result := NIL;
  172. try
  173. @ArrayOfConstCallAlias := @ArrayOfConstCall;
  174. I := 0;
  175. while ( I < H ) do
  176. begin
  177. ArrayOfConstCallAlias ( A, anArgs^ [i], SizeOf (anArgs) div SizeOf (TVarRec) );
  178. if ( I = 0 ) then
  179. Result := A
  180. else
  181. Result := ArrayOfConstMerge (Result,A);
  182. Inc (I);
  183. end;
  184. except
  185. Result := NIL;
  186. end;
  187. end;


mirt.steelwater Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: mirt.steelwater (статус: Посетитель)
Вопрос отправлен: 14 декабря 2010, 09:55
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Всего сообщений: 8; последнее сообщение — 16 декабря 2010, 13:20; участников в обсуждении: 2.
Вадим К

Вадим К (статус: Академик), 14 декабря 2010, 10:36 [#1]:

хочется массивы произвольной вложенности?
p.s. ссылка на в вопросе битая.
Галочка "подтверждения прочтения" - вселенское зло.
mirt.steelwater

mirt.steelwater (статус: Посетитель), 14 декабря 2010, 12:18 [#2]:

да, произвольной вложенности
ссылка побилась видимо(
я частично реализовал эту задачу вот так:
function _const (anArgs: array of const) : ArrayOfConst;
var
    I      : WORD;
    Index  : WORD;
    Length : WORD;
begin
    Length := 0;
    if ( High (anArgs) >= 0 ) then
        Length := Length + High (anArgs) - Low (anArgs) +1;
    if ( Length > 0 ) then
    begin
        SetLength (Result,Length);
        Index := 0;
        for I := Low (anArgs) to High (anArgs) do
        begin
            Result [Index] := anArgs [I];
            Inc (Index);
        end;
    end;
end;
 
function ParamToArrayOfConst (const aValue: TVarRec) : ArrayOfConst;
begin
    Result := _const([]);
    with aValue do
    try
        case VType of
            vtPointer: Result := VPointer;
        end;
    except
        Result := _const([]);
    end;
end;

и теперь могу обходить массив вот так:
function arrays (anArgs: array of const) : String;
var
    I : WORD;
    A : ArrayOfConst;
begin
    Result := '';
    for I := Low (anArgs) to High (anArgs) do
    begin
        A := ParamToArrayOfConst (anArgs [I]);
        if Assigned (A) then
        begin
            if ( I <= Low (anArgs) ) then
                Result := arrays (A)
            else
                Result := Format ('%s, %s',[ Result, arrays (A) ]);
        end
        else if ( I <= Low (anArgs) ) then
            Result := ParamToStr (anArgs [I])
        else
            Result := Format ('%s, %s',[ Result, ParamToStr (anArgs [I]) ]);
    end;
    Result := Format ('[%s]',[Result]);
end;
 
caption := arrays ([ 'a', _const(['test1']), 'b', _const(['test2','test3']), 'c', Pointer(TForm), NIL, self,
_const(['test4','test5','test6',  _const(['A','B','C']), 'test7' ]), 'hello', 3.14159265 ]);
все работает, но возникает исключение, которое нельзя корректно обработать, если я передам Pointer (Form1) , например - процедуры пытается получить в этом случае из указателя массив и все плохо заканчивается
Ⓐ свобода сопротивление солидарность
mirt.steelwater

mirt.steelwater (статус: Посетитель), 14 декабря 2010, 12:35 [#3]:

забыл описание функции
function ParamToStr (const aValue: TVarRec) : String;
begin
    Result := '';
    with aValue do
    try
        case VType of
            vtInteger:    Result := IntToStr (VInteger);
            vtBoolean:    Result := BooleanToStr (VBoolean);
            vtChar:       Result := VChar;
            vtExtended:   Result := FloatToStr (VExtended^);
            vtString:     Result := VString^;
            vtPointer:    Result := IntToStr ( Longint (VPointer) );
            vtPChar:      Result := StrPas (VPChar);
            vtObject:     Result := VObject.ClassName;
            vtClass:      Result := VClass.ClassName;
            vtAnsiString: Result := String (VAnsiString);
            vtWideChar:   Result := Char (VWideChar);
            vtPWideChar:  Result := WideCharToString (VPWideChar);
            vtWideString: Result := WideCharToString (VWideString);
            vtCurrency:   Result := FloatToStr (VCurrency^);
            vtInt64:      Result := IntToStr (VInt64^);
            vtVariant:    Result := VVariant^;
        end;
    except
        Result := '';
    end;
end;
Ⓐ свобода сопротивление солидарность
Вадим К

Вадим К (статус: Академик), 14 декабря 2010, 12:47 [#4]:

Я правильно понимаю, хочется сделать фактически питоновские типы?

Цитата:

если я передам Pointer (Form1) , например - процедуры пытается получить в этом случае из указателя массив и все плохо заканчивается

логично. указатель не хранит информацию о типе. Варианты решения:
- специфицировать, что произвольные указатели нельзя передавать. А в коде сделать try except, который просто будет возвращаться с процедуры или вообще закрывать программу, выдав отладочные сообщения.
- построить костыли и попытаться научиться угадывать тип указателя (и получить самые феерические ошибки)
- помещать в массив данные специального типа - variant
- помещать в массив данные своего типа. если делфи старше 2005-2007, то можно даже написать специальные методы, что бы сделать работу прозрачной.
- устроится на работу в Embracadero и поправить багу в компиляторе:)
- перейти на другой язык программирования:)
Галочка "подтверждения прочтения" - вселенское зло.
mirt.steelwater

mirt.steelwater (статус: Посетитель), 14 декабря 2010, 15:56 [#5]:

спасибо:)
я отел вначале использовать типизированные указатели, но array of const четко содержит ссылку именно на такой вариант TVarRec - с нетипизированным указателем.
вариант с обработкой ошибки меня бы устроил, я собственно, и думал так сделать:
    try
        ...
    except
        Result := _const([]);
    end;
в ряде случаев там возникают ошибки, которые покидают блок except - вероятно все из-за того же Acces Violation - можно ли как-нибудь хранить в указателе его тип и читать его на низком уровне? как-то это ведь работает с типизированными указателями дельфи?
однако
Ⓐ свобода сопротивление солидарность
Вадим К

Вадим К (статус: Академик), 14 декабря 2010, 17:19 [#6]:

указатель на то и указатель, что там только 4 байта данных - только адрес. Поэтому наверно придется заводить ассоциативный массив для указателей и помнить их тип. Но кому это нужно. Делфи в целом не различает указателей. Основная работа проводиться ещё на уровне компиляции.
Галочка "подтверждения прочтения" - вселенское зло.
mirt.steelwater

mirt.steelwater (статус: Посетитель), 16 декабря 2010, 13:03 [#7]:

>>Я правильно понимаю, хочется сделать фактически питоновские типы?

да:)
Ⓐ свобода сопротивление солидарность
Вадим К

Вадим К (статус: Академик), 16 декабря 2010, 13:20 [#8]:

Это очень плохая практика - писать в одном языке методами другого. Нужно просто искать правильный путь реализации идеи. А для этого иногда нужно менять алгоритмы и мировоззрение.

Говоря по простому - "со своим чайником в Тулу не едут:)"
Галочка "подтверждения прочтения" - вселенское зло.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 31 октября 2025, 10:45
Выполнено за 0.03 сек.