![]() |
| ||
|
|
Новости |
Поиск |
FAQ |
Статьи |
Книги |
Новости VCL
| | Форумы ЧАТ |
Орешник |
|
| |||
| |||
« предыдущая ветвь | форум | следующая ветвь »
От теории к практике
ProgRAMmer Dimonych © (2007-12-04 00:46:00)В очередной раз сталкиваюсь с такой проблемой: в теории вроде всё понятно, апредсказать поведение программы на практике боюсь :)
Короче говоря, о том, что объект в Delphi есть не что иное как указатель в размере 4 байт (для 32-битных ОС) на кусок памяти, соответствующий этому самому объекту, я знаю и с этим вполне смирился :), хотя и смиряться-то было не с чем. А теперь собственно преамбула...
Пишу некий объектTVarList=class(TVicObject). TVarList должен быть небольшой поделкой-заменой для TList'а, Items'ы которого - не просто TObject, а TVar (тоже=class(TVicObject)), ибо умаялся приведение типов делать. Работа объекта основана на динамическом массиве указателей на TVar'ы.
Пишу метод для вставки нового TVar'а на заданную позицию Index.
procedure TVarList.Insert(Index:Integer);
var
i,L:Integer;
begin
if (Index<0) or (Index>=Length(FList)) then Exit;
L:=Length(FList); SetLength(FList,L+1);
for i:=L downto Index+1 do FList[i]:=FList[i-1];
FList[Index]:=TVar.Create(Self);
end;
При этомFList:array of TVar.
Можно ли делать именно так (особенно волнует присвоение после цикла)?
TUser (2007-12-05 11:23:00) [1]Вот, чем пользуюсь я
type
{
Предковый класс, содержащий массив итемов такого же типа
Функция SmartGetLength возвращает ожидаемыую длину массива, например
для ALA - наверное, 5 и т.д. Это позволяет избежать фрагментации
памяти. После заполнения массива лишние части удаляются процедурой
CutArrays.
}
TContainer = class (* TPersistent *)
private
FCount: integer;
FItems: array of TContainer;
procedure Grow;
function rItem (Index: integer): TContainer;
procedure SaveToFileInternal (List: TStrings);
protected
// procedure CheckType (Value: TContainer); virtual; abstract;
function SmartGetLength: integer; virtual; abstract;
procedure StartSaveToFile (List: TStrings); virtual;
procedure EndSaveToFile (List: TStrings); virtual;
public
constructor Create; virtual;
destructor Destroy; override;
procedure AddItem (Value: TContainer);
procedure CutArrays;
function GetCount: integer;
procedure SaveToFile (FileName: string); virtual;
// property Count: integer read FCount;
property Items[Index: integer]: TContainer read rItem;
end;
implementation
uses SysUtils, uPDBErrors, uPDBFast;
{ TContainer }
procedure TContainer.Grow;
var L: integer;
begin
inc (FCount);
if FCount <= length (FItems) then
Exit;
L:=SmartGetLength;
{
while L <= length (FItems) do
L := L * 2;
}
SetLength (FItems, L);
end;
function TContainer.rItem (Index: integer): TContainer;
begin
if (Index < 0) or (Index >= FCount) then
raise EPdbException.Create ('Index ' + inttostr(Index) +
' is out of bounds in ' + ClassName);
result:=FItems[Index];
end;
procedure TContainer.SaveToFileInternal (List: TStrings);
var i: integer;
begin
StartSaveToFile (List);
for i:=0 to FCount-1 do
FItems[i].SaveToFileInternal (List);
EndSaveToFile (List);
end;
procedure TContainer.StartSaveToFile (List: TStrings);
begin
// do nothing
end;
procedure TContainer.EndSaveToFile (List: TStrings);
begin
// do nothing
end;
constructor TContainer.Create;
begin
SetLength (FItems, 0);
FCount:=0;
end;
destructor TContainer.Destroy;
var i: integer;
begin
for i:=0 to length (FItems) - 1 do
try
FItems[i].Free;
except
end;
SetLength (FItems, 0);
end;
procedure TContainer.AddItem (Value: TContainer);
var a: integer;
begin
a:=FCount;
Grow;
FItems[a]:=Value;
end;
procedure TContainer.CutArrays;
var i: integer;
begin
SetLength (FItems, FCount);
for i := 0 to FCount - 1 do
FItems[i].CutArrays;
end;
function TContainer.GetCount: integer;
begin
result:=FCount;
end;
procedure TContainer.SaveToFile (FileName: string);
var List: TStrings;
begin
List:=TStringList.Create;
try
SaveToFileInternal (List);
List.SaveToFile(FileName);
finally
List.Free;
end;
end;
// =======================
{
Описывает рост динамических массивов, см. методы SmartGetLength
}
function IncInteger (const I: integer; const Ts: array of integer;
const LastIncrement: integer): integer;
var j: integer;
begin
for j:=0 to high (Ts) do
if I < Ts[j] then begin
result:=Ts[j];
Exit;
end;
result := I + LastIncrement;
end;
// =======================
// И дальше ваяю наследников типа
TProtein = class (TContainer)
private
function rModels (Index: integer): TModel;
protected
function SmartGetLength: integer; override;
public
property ModCount: integer read GetCount;
property Models[Index: integer]: TModel read rModels;
end;
function TProtein.SmartGetLength: integer;
begin
result:=IncInteger (GetCount, [1, 5, 10, 20, 60], 60);
end;
function TProtein.rModels (Index: integer): TModel;
begin
result:=TModel(Items[Index]);
end;
ProgRAMmer Dimonych (2007-12-04 15:54:00) [2]P.S. Т.е., я так понимаю, мой вариант имеет право на существование, особенно после внесения поправок ( :):):) ) в выделение памяти?
ProgRAMmer Dimonych (2007-12-04 15:53:00) [3]Всем спасибо за ответы.
В двух словах отвечу на основные возникшие вопросы...
> boa_kaa © (04.12.07 01:20) [2]
TList не пользую, ибо Classes, а мне на данный момент только Windows да Messages полагается. :) Не предупредил об этом, т.к. посчитал, что это не столь важно.
> Юрий Зотов © (04.12.07 01:20) [3]
> Нормально, только вместо Exit стоит сделать raise.
Думаю, своей предыдущей фразой я ответил на вопрос о том, почему не сделан raise. Хотя, возможно... ну, ладно...
> Выход за границы - это логическая ошибка в вызывающем коде,
> а ошибки нужно не маскировать, а наоборот, выпячивать.
> Иначе замучаешься их ловить, замаскированные-то.
Знаю, сталкивался, даже копчик по этому поводу болел :)
> И еще: неэффективно это - по одному кусочку память выделять.
> Посмотрите код TList - там хитрее сделано.
1. Можно на "ты".
2. Смотрел. Нет, вру... Заглядывал... Посмотрел ещё раз. Понял две вещи.
2.1. Выделение памяти производится не по одному элементу за заход, а по несколько, причём в зависимости от его (массива и, соответственно, списка) текущих размеров.
2.2. В классе объявлен указатель на массив указателей. Насколько я могу судить, это позволяет более гибко управлять размером потребляемой приложением памяти (в т.ч. и за счёт 2.1)? Отсюда же, полагаю, и ограничение на количество элементов в TStringList'е, например?
Я прав?
> Leonid Troyanovsky © (04.12.07 01:22) [4]
Идею, кажется, понял. Т.е. пишем class(TObjectList), который, в свою очередь, является class(TList). В своём классе прописываем свойство MyObjects, которое будет "возвращать" (хотя "возвращать", наверное, не совсем по сути... Зато более русче :)) объект нужного типа. Спасибо, буду иметь в виду. Но ввиду вышеназванного обстоятельства этот способ для этой конкретной программы мне не подходит.
С
> palva © (04.12.07 09:52) [5]
по
> Skyle © (04.12.07 11:23) [11]
А я-то в своё время намучился. :) Ну, в Pascal'е и Delphi проблема с нумерацией возникает только у динамических массивов (причём об этом сказано в соответствующем разделе справки по Delphi, поэтому, когда начинал, проблем не возникло), а статику можно и с 1 объявить :) А потом в PHP со строками поратботть решил. Чуть было не умаялся, вовремя умные люди напомнили, что там нумерация символов с нуля :)
Skyle (2007-12-04 11:23:00) [4]
> palva © (04.12.07 11:18) [10]
> Привык к бейсиковскому ReDim, где надо указывать новый верхний
> индекс.
Я почему-то именно так и подумал :)
palva (2007-12-04 11:18:00) [5]Думкин © (04.12.07 10:48) [8]
Skyle © (04.12.07 10:51) [9]
Ага, теперь понял свою ошибку.
Привык к бейсиковскому ReDim, где надо указывать новый верхний индекс.
Skyle (2007-12-04 10:51:00) [6]
> palva © (04.12.07 10:44) [7]
> Наверно, я чего-то не понимаю. L - это старая длина списка.
> Добавился новый элемент с индексом L+1
Добавился новый элемент с индексом L, который по счёту L+1'й.
> L:=Length(FList);
> SetLength(FList,L+1);
Думкин (2007-12-04 10:48:00) [7]
> palva © (04.12.07 10:44) [7]
Длина L+1, индекс же последнего L. Мы с нуля начинаем или где?
palva (2007-12-04 10:44:00) [8]Наверно, я чего-то не понимаю. L - это старая длина списка. Добавился новый элемент с индексом L+1, и он должен быть заполнен при сдвиге элементов. Поэтому цикл надо начинать с i=L+1 ?
Думкин (2007-12-04 10:00:00) [9]
> palva © (04.12.07 09:52) [5]
> do FList[ i]:=FList[i-1];
palva (2007-12-04 09:52:00) [10]ProgRAMmer Dimonych © (04.12.07 00:46) [0]
> for i:=L downto
По-моему, здесь ошибка. Надо:
for i:=L+1 downto
Leonid Troyanovsky (2007-12-04 01:22:00) [11]
> ProgRAMmer Dimonych © (04.12.07 00:46)
> Пишу некий объект TVarList=class(TVicObject). TVarList должен
> быть небольшой поделкой-заменой для TList'а, Items'ы которого
> - не просто TObject, а TVar (тоже =class(TVicObject)), ибо
> умаялся приведение типов делать.
TMyObjectList = class(TObjectList)
public
function GetMyObject(Index: Integer): TMyObject;
procedure SetMyObject(Index: Integer; AObject: TMyObject);
property MyObjects[Index: Integer]: TMyObject read GetMyObject write SetMyObject;
end;
procedure TMyObjectList.SetMyObject(Index: Integer; AObject: TMyObject);
begin
// Assert((Index >= 0) and (Index < Count));
Items[Index] := AObject;
end;
function TMyObjectList.GetMyObject(Index: Longint): TMyObject;
begin
// Assert((Index >= 0) and (Index < Count));
Result := TMyObject(Items[Index]);
end;
--
Regards, LVT.
boa_kaa (2007-12-04 01:20:00) [12]
> Можно ли делать именно так
Можно. Но лучше воспользоваться готовым TList. Что-нить вроде
TMyList = class
private
FList:TList;
public
procedure Insert(index: Integer; item: TMyItemClass);
end;
.....
procedure TMyList.Insert(index: Integer; item: TMyItemClass);
begin
FList.Insert(index, item);
end;
Ну или примерно так.
Да, кстати, в TList содержатся лишь Pointer.
Юрий Зотов (2007-12-04 01:20:00) [13]Нормально, только вместо Exit стоит сделать raise. Выход за границы - это логическая ошибка в вызывающем коде, а ошибки нужно не маскировать, а наоборот, выпячивать. Иначе замучаешься их ловить, замаскированные-то.
И еще: неэффективно это - по одному кусочку память выделять. Посмотрите код TList - там хитрее сделано.
Германн (2007-12-04 01:16:00) [14]
> Можно ли делать именно так (особенно волнует присвоение
> после цикла)?
>
Вроде можно. Внешне препятствий не нашел, а проверять лень.
Тем более, что это и не моя задача. :)