Top.Mail.Ru
Мастера DELPHI, Delphi programming community Титульная страница Поиск, карта сайта Написать письмо 
| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL |
| Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

Не нравится мне мой код


Страницы:   1 2

TUser ©   (2004-12-17 15:16:00) 

Есть предковые классы
 TDynElement = class
  end;

 TDynArray = class
  private
   FCount: integer;
   FAutoIncrement: boolean;
   FAutoCreate: boolean;
   FArray: array of TDynElement;
   procedure wrLength(Value:integer);
  public
   constructor Create;
   destructor Destroy; override;
   function rItems(Index:integer):TDynElement;
   procedure wrItems(Index:integer; Value:TDynElement);
   procedure CreateItem(Index:integer); virtual; abstract;

   property Length:integer read FCount write wrLength;
   property AutoIncrement:boolean read FAutoIncrement write FAutoIncrement default true;
   property AutoCreate:boolean read FAutoCreate write FAutoCreate default true;
  end;


и куча наследников (уже несколько десятков набралось)

 TDyn1 = class(TDynElement)
  public
   {any properties to storage}
  end;

 TDyn1Array = class(TDynArray)
  private
   function rItems(Index:integer):TFound;
   procedure wrItems(Index:integer; Value:TFound);
  public                        
   procedure CreateItem(Index:integer); override;
   property Items[Index:integer]:TFound read rItems write wrItems; default;
  end;


Реализауия такая

procedure TDynArray.wrLength(Value:integer);
var Power2: integer;
   f:boolean;
begin
  if Value < 0 then begin
     PutInConsol('procedure TDynArray.wrLength(Value:integer);');
     PutInConsol('Value = '+inttostr(Value));
     end
     else begin
     if Value > system.length(FArray) then begin
        f:=true; Power2:=512;
        while f and (Power2 >= 8) do
           if Value >= Power2 then
              f:=false
              else Power2 := Power2 div 2;
        if f then Power2:=1;
        if Value mod Power2 = 0 then
           Power2:=Value
           else
           Power2:=(Value div Power2) * Power2 + Power2;
        SetLength(FArray,Power2);
        end;
     FCount:=Value;
     end;
end;

function TDynArray.rItems(Index:integer):TDynElement;
begin
  if (Index < 0) or (Index >= FCount) then begin
     PutInConsol('function TDynArray.rItems(Index:integer):pointer;');
     PutInConsol('Index = '+inttostr(Index));
     PutInConsol('FCount = '+inttostr(FCount));
     end else begin
     if FArray[Index] = nil then
        if FAutoCreate then
           CreateItem(Index);
     result:=FArray[Index];
     end;
end;

procedure TDynArray.wrItems(Index:integer; Value:TDynElement);
begin
  if (Index < 0) or (Index >= FCount) then
     if FAutoIncrement and (Index > 0) then
        wrLength(Index+1)
        else begin
        PutInConsol('procedure TDynArray.wrItems(Index:integer; Value:pointer);');
        PutInConsol('Index = '+inttostr(Index));
        Exit; // :((
        end;

  FArray[Index]:=Value;
end;

constructor TDynArray.Create;
begin
  inherited;
  SetLength(FArray,0);
  FCount:=0;
end;

destructor TDynArray.Destroy;
var i: integer;
begin
  for i:=0 to system.length(FArray)-1 do
     FArray[i].Free;
  SetLength(FArray,0);
  inherited;
end;

function TDyn1Array.rItems(Index:integer):TDyn1;
begin
  result:=TDyn1(inherited rItems(Index));
end;

procedure TDyn1Array.wrItems(Index:integer; Value:TDyn1);
begin
  inherited wrItems(Index,Value);
end;

procedure TDyn1Array.CreateItem(Index:integer);
begin
  Items[Index]:=TDyn1.Create;
end;


Но когда уже есть TDyn1, ..., TDyn125, то складывается впечатление, что я изобретаю какую-то ерунду. Должен быть какой-нибудь способ, чтобы создать базывай класс, а в наследниках переписать тип для Items. Пробовал с class of , но не уверен, что это то, что мне надо. Какие есть соображения типа 'переписать все нафик'?


Anatoly Podgoretsky   (2004-12-17 15:24:00) [21]

И мне твой код не нравится :-)


Страницы:   1 2

Наверх

Титульная страница Поиск, карта сайта Написать письмо