VPF::TPointerArray - Форум программистов

ZeroDivide

Дата 26.10.2005, 08:59 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 14.8.2005

Репутация: нет
Всего: 1

Я написал небольшой класс, реализующий некоторое подобие TList.
Но у меня две проблемы: 1) сортировка 2) стабильность работы
Убедительная просьба помочь мне улучшить работы этого модуля.

PointerArray.pas

Код


unit PointerArray;

{$I config.inc}

interface

type
  TArrayOfPointer = array of Pointer;
  TPointerArray = class
    private
      FArray: TArrayOfPointer;
      function GetItem(AIndex: integer): Pointer;
      procedure SetItem(AIndex: integer; AValue: Pointer);
    protected
      property Values[AIndex: integer]: Pointer read GetItem write SetItem; default;
    public
      {$IFDEF DELPHI}
      constructor Create;
      destructor Destroy; override;
      {$ENDIF}
      constructor Init;
      function Add(AItem: Pointer): integer;
      function IndexOf(AItem: Pointer): integer;
      function Count: integer;
      procedure Delete(AIndex: integer);
      procedure RemoveNil;
      procedure Clear;
      procedure Sort;
      destructor Done;
  end;

implementation

{$IFDEF DELPHI}
constructor TPointerArray.Create;
begin
  Init;
end;

destructor TPointerArray.Destroy;
begin
  Done;
  inherited Destroy;
end;
{$ENDIF}

constructor TPointerArray.Init;
begin

end;

function TPointerArray.Add(AItem: Pointer): integer;
begin
  Result := Length(FArray);
  SetLength(FArray, Result + 1);
  FArray[Result] := AItem;
end;

function TPointerArray.GetItem(AIndex: integer): Pointer;
begin
  Result := nil;
  if AIndex > Count - 1 then
    Exit;
  Result := FArray[AIndex];
end;

procedure TPointerArray.SetItem(AIndex: integer; AValue: Pointer);
begin
  if AIndex > Count - 1 then
    Exit;
  FArray[AIndex] := AValue;
end;

function TPointerArray.IndexOf(AItem: Pointer): integer;
var
  Index: integer;
begin
  Result := - 1;
  for Index := 0 to Length(FArray) - 1 do
    if FArray[Index] = AItem then
    begin
      Result := Index;
      Break;
    end;
end;

function TPointerArray.Count: integer;
begin
  Result := Length(FArray);
end;

procedure TPointerArray.Delete(AIndex: integer);
var
  Index: integer;
begin
  if AIndex > Length(FArray) - 1 then
    Exit;
  FArray[AIndex] := nil;
  for Index := Length(FArray) - 2 downto AIndex do
    FArray[Index] := FArray[Index + 1];
  SetLength(FArray, Length(FArray) - 1);
end;

procedure TPointerArray.RemoveNil;
var
  Index: integer;
begin
  for Index := Count - 1 downto 0 do
    if not Assigned(FArray[Index]) then
      Delete(Index);
end;

procedure TPointerArray.Clear;
begin
  SetLength(FArray, 0);
end;

function InsertionSort(AArray: TArrayOfPointer): TArrayOfPointer;
var
  n, i, j: integer;
begin
  n := Length(AArray);
  Result := AArray;
  for i := 0 to n - 1 do
  begin
    j := i;
    while (j > 1) and (SizeOf(Result[j - 1]) < SizeOf(AArray[i])) do
    begin
      Result[j] := Result[j - 1];
      j := j - 1;
    end;
    Result[j] := AArray[i];
  end;
end;

procedure TPointerArray.Sort;
begin
  FArray := InsertionSort(FArray);
end;

destructor TPointerArray.Done;
begin
  Clear;
end;

end.

config.inc

Код


{$DEFINE UNKNOWN}

{$IFDEF VER80}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER90}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER100}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER120}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER130}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER140}
  {$DEFINE DELPHI}
{$ENDIF}
{$IFDEF VER150}
  {$DEFINE DELPHI}
{$ENDIF}

{$IFDEF DELPHI}
  {$UNDEF UNKNOWN}
  {$APPTYPE CONSOLE}
{$ENDIF}

{$IFDEF FPC}
  {$UNDEF UNKNOWN}
  {$MODE DELPHI}
  {$APPTYPE CONSOLE}
  {$SMARTLINK ON}
  {$TYPEINFO ON}
{$ENDIF}

P.S: код написан на FPC, но компилируется и на дельфи. Очень прошу помочь улучшить работы.
Заранее спасибо.

Это сообщение отредактировал(а) ZeroDivide - 26.10.2005, 09:01

<Spawn>

Дата 27.10.2005, 15:49 (ссылка)

(нет голосов)

Загрузка ...

Око кары:)

Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64

А смысл изобретать велосипед, да и еще с квадратными калесами?

--------------------

"Для некоторых людей программирование является такой же внутренней потребностью, подобно тому, как коровы дают молоко, или писатели стремятся писать" - Николай Безруков.

ZeroDivide

Дата 27.10.2005, 16:03 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 4
Регистрация: 14.8.2005

Репутация: нет
Всего: 1

1) Мне было влом искать другие реализации, а из за использования Classes размер файла увеличивался на 300к.
2) Вот в колёсах всё дело - нужно улучшить модуль, а как - не знаю. За этим сюда и обращаюсь.

<Spawn>

Дата 27.10.2005, 16:10 (ссылка)

(нет голосов)

Загрузка ...

Око кары:)

Профиль
Группа: Экс. модератор
Сообщений: 2776
Регистрация: 29.1.2003
Где: Екатеринбург

Репутация: 44
Всего: 64

Хм

А может лучше выдрать реализацию TList из Classes?

Помог бы исправить, но сечас нет времени(у меня уже его давно почти нет smile

), так на 5 минут заскочил...

--------------------

1 Пользователей читают эту тему (1 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »