VPF::Обращение к элементу массива класса

Fedia

Дата 26.12.2006, 07:15 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 465
Регистрация: 2.8.2006
Где: первым встречаю р ассвет

Репутация: 8
Всего: 13

Приветствую всех !
Пытаюсь реализовать классовую имитацию записи содержащей, содержащего простые элементы и массивы записей (уж не знаю как еще назвать то, что я делаю smile

). Т.е. запись:

Код


  TCCD = record
    c,                   //Код судна(C1/1)
    cs: Word;            //Код предприятия(C1)
    //...
    f: array of record
     x: Byte;            //Режим промысла
     N: String;          //Разрешение на промысел
     z,                  //Код района промысла(C3/1)
     c,                  //Код объекта лова(C3/2)
     o: Word;            //Код судовладельца, чьи квоты осваивает судно
     w,                  //Улов за текущие сутки(C3/3)
     ws: Double;         //Суммарный улов за период с начала года(C3/4)
    end;
  end;

пытаюсь реализовать в виде класса:

Код


  //вылов объетов промысла
  TRCatch = record
    x: Byte;            //Режим промысла
    N: String;          //Разрешение на промысел
    z,                  //Код района промысла(C3/1)
    c,                  //Код объекта лова(C3/2)
    o: Word;            //Код судовладельца, чьи квоты осваивает судно
    w,                  //Улов за текущие сутки(C3/3)
    ws: Double;         //Суммарный улов за период с начала года(C3/4)
  end;

  PRCatch = ^TRCatch;

  TCatch = class
  private
    FArList: TList;
    FPRCatch: PRCatch;
    function GetElement(Index: integer): TRCatch;
    procedure SetElement(Index: integer; Value: TRCatch);
  public
    constructor Create;
    destructor Destroy; override;
    property Element[Index: integer]: TRCatch read GetElement write SetElement;
      default;
  end;

  TTypeCCD = class
  public
    c,                   //Код судна(C1/1)
    cs: Word;            //Код предприятия(C1)
    //...

    //вылов
    f: TCatch;

    constructor Create;
    destructor Destroy; override;
  end;

implementation

{ TCatch }

constructor TCatch.Create;
begin
  FArList:=TList.Create;
end;

destructor TCatch.Destroy;
begin
  FreeAndNil(FArList);
  inherited;
end;

function TCatch.GetElement(Index: integer): TRCatch;
begin
  Assert((Index>=0) and (Index<FArList.Count), 'Выход за пределы массива !');
  Result:=TRCatch(FArList[Index]^);
end;

procedure TCatch.SetElement(Index: integer; Value: TRCatch);
begin
  Assert((Index>=0) and (Index<=FArList.Count), 'Выход за пределы массива !');
  New(FPRCatch);
  FPRCatch^:=Value;
  if (Index>=0) and (Index<FArList.Count) then
  FArList[Index]:=FPRCatch else
  FArList.Add(FPRCatch);
end;

{ TTypeCCD }

constructor TTypeCCD.Create;
begin
  f:=TCatch.Create;
end;

destructor TTypeCCD.Destroy;
begin
  FreeAndNil(f);
  inherited;
end;

Проблема в том, что мне хотелось бы получить более полноценную имитацию записи, с возможностью присвоения полям вложенного в запись массива значений. Другими словами нужно реализовать следующее:

Код


var
  test :TCCD;
begin
  SetLength(test.f, 1);
  test.f[0].x:=1; //<--функционал данной строки нужно повторить
end;

, но пока не выходит:

Код


var
  test: TTypeCCD;
begin
  test:=TTypeCCD.Create;
  test.f[1].x:=1; //<--получаем ошибку (Left side cannot be assigned to)
end;

Возможно ли такое реализовать ?
PS: вариант с присвоением записи целиком не предлагать:

Код


var
  test :TTypeCCD;
  c: TRCatch;
begin
  c.x:=1;
  test:=TTypeCCD.Create;
  test.f[1]:=c;
end;

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

Накануне решающей битвы
Я иду, и надеждою зыбкой
Озаряется эта дорога,
Я мечтаю увидеть улыбку
На лице победившего Бога…

skyboy

Дата 26.12.2006, 08:56 (ссылка)

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

Загрузка ...

неОпытный

Профиль
Группа: Модератор
Сообщений: 9820
Регистрация: 18.5.2006
Где: Днепропетровск

Репутация: 4
Всего: 260

а попробу возвращать указатель на структуру и разыменовывать его(GetElement пущай возвращает PRcatch-значение):

Код


var
  test: TTypeCCD;
begin
  test:=TTypeCCD.Create;
  test.f[1]^.x:=1; 
end;

Fedia

Дата 26.12.2006, 11:10 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 465
Регистрация: 2.8.2006
Где: первым встречаю р ассвет

Репутация: 8
Всего: 13

skyboy, это вариант конечно, но мне не подходит вот почему: основными данными, с которыми работает программа, модифицируемая мной, являются массивы записей, часть структуры которой я привел выше. Основная моя идея заключается в попытке расширить функционал программы, без модификации основного программного кода. С этой целью я пытаюсь осуществить подмену данной записи моим классом, который и будет содержать основную часть кода, расширяющего функционал программы.
Поэтому если в программе встречается код типа:

Код


test.f[1].x:=1;

, мне как раз и не хочется его ни на что менять, а вариант:

Код


test.f[1]^.x:=1;

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

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

Snowy

Дата 26.12.2006, 11:24 (ссылка)

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

Загрузка ...

Эксперт

Профиль
Группа: Модератор
Сообщений: 11363
Регистрация: 13.10.2004
Где: Питер

Репутация: 192
Всего: 484

Цитата(Fedia @ 26.12.2006, 11:10

)

test.f[1]^.x:=1;

Неа. В обойх случаях можно писать

Цитата(Fedia @ 26.12.2006, 11:10

)

test.f[1].x:=1;

Fedia

Дата 26.12.2006, 11:48 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 465
Регистрация: 2.8.2006
Где: первым встречаю р ассвет

Репутация: 8
Всего: 13

Цитата(Snowy @ 26.12.2006, 11:24

)

Неа. В обойх случаях можно писать

У меня вариант

Код


  test.f[1].x:=1;

не компилится (Left side cannot be assigned to).

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

murod

Дата 26.12.2006, 12:34 (ссылка)

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

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 113
Регистрация: 17.9.2005
Где: Uzbekistan/Tashke nt

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

Цитата

У меня вариант
test.f[1].x:=1;
не компилится (Left side cannot be assigned to).

а вот у меня все компилится!

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

Люди всего мира берегите природу!

Beltar

Дата 26.12.2006, 19:16 (ссылка)

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

Загрузка ...

Опытный

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

Репутация: 3
Всего: 7

У меня в BDS 2006 тоже не компилиться.

Кстати, раз структура хранения использует TList то я не вижу смысла просто не перекрыть его методы он и сам может проверить выход за границы и сказать "List Index out of bounds". И получить специальный класс наследник от TList для хранения таких записей. Намного компактнее будет. Тем боле что этот TCatch имеющий непорочное зачатие, как TObject меня малясь смущает. smile

Или можно попробовать через коллекцию.

Код


TRCatch=class(TCollectionItem); //т. е. структуру заменяем классом
  private
    FX:Integer;
   //...
  public
     property X read FX write FX
end;

TCatch=class(TCollection)
   private
     function GetItem():TRCatch;
    procedure SetItem(Index: Integer; const Value: TRCatch);
    function Add:TRCatch;
    procedure Delete(Index:Integer);
    function Insert(Index:Integer):TRCatch;
     
   public
     property Items[Index: Integer]: TRCatch read GetItem write SetItem; default;
end

//

function TCatch.GetItem(Index: Integer): TRCatch;
begin
Result:=TRCatch(inherited GetItem(Index));
end;

function TCatch.Add: TRCatch;
begin
Result:=TRCatch(inherited Add);
end;

//Ну и остальные методы в том же духе.

Может еще подумаю накидаю наследника от TList, или завтра пример выложу. 2 варианта компонента, один с коллекцией, другой с наследником от TList.

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile

(с) я, хотя может и нет
Пищущий на C++ мужик. Даже если это мужик сидит в написанном на Delphi и жрущем паскалевскую библиотеку билдере.

Beltar

Дата 26.12.2006, 20:16 (ссылка)

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

Загрузка ...

Опытный

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

Репутация: 3
Всего: 7

Что-то у меня заглючило с TList. И что-то у меня нехорошие предчуствия, с BDS я недавно, а вышеупомянутый компонент я делал в семерке...

А вот так компилится и даже запускается, только есно AV возникает, т. к. присваиваю до создания. smile

Код


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  TRCatch=class(TCollectionItem)
  public
    x: Byte;            //Режим промысла
    N: String;          //Разрешение на промысел
    z: Word;                  //Код района промысла(C3/1);
    c: Word;                 //Код объекта лова(C3/2)
    o: Word;            //Код судовладельца, чьи квоты осваивает судно
    w: Double;                 //Улов за текущие сутки(C3/3)
    ws: Double;
  end;

  TCatch=class(TCollection)
  private
  function GetItem(Index:Integer):TRCatch;
  procedure SetItem(Index:Integer;Value:TRCatch);
  public
  property Items[Index: Integer]:TRCatch read GetItem write SetItem;
  function Add:TRCatch;
  function Insert(Index:Integer):TRCatch;
  procedure Delete(Index:Integer);
  constructor Create;
  destructor Destroy;
  end;

  TTypeCCD = class(TObject)
  private
  FCt:TCatch;
  public
    c,                   //Код судна(C1/1)
    cs: Word;            //Код предприятия(C1)
    //...
    //вылов
    property Ct:TCatch read FCt write FCt;
    constructor Create;
    destructor Destroy; override;    
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TCatch }

function TCatch.Add: TRCatch;
begin
Result:=TRCatch(inherited Add);
end;

constructor TCatch.Create;
begin
inherited Create(TRCatch);
end;

procedure TCatch.Delete(Index: Integer);
begin
inherited Delete(Index);
end;

destructor TCatch.Destroy;
begin
inherited;
end;

function TCatch.GetItem(Index: Integer): TRCatch;
begin
Result:=TRCatch(inherited GetItem(Index));
end;

function TCatch.Insert(Index: Integer):TRCatch;
begin
Result:=TRCatch(inherited Insert(Index));
end;

procedure TCatch.SetItem(Index: Integer; Value: TRCatch);
begin
inherited SetItem(Index,Value);
end;

{ TTypeCCD }

constructor TTypeCCD.Create;
begin
FCt:=TCatch.Create;
end;

destructor TTypeCCD.Destroy;
begin
FCt.Free;
  inherited;
end;

procedure TForm1.Button1Click(Sender: TObject);
var A:TTypeCCD;
begin
A:=TTypeCCD.Create;
A.FCt.Items[0].x:=1;
A.Free;
end;

end.

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile

Fedia

Дата 27.12.2006, 00:27 (ссылка)

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

Загрузка ...

Опытный

Профиль
Группа: Участник
Сообщений: 465
Регистрация: 2.8.2006
Где: первым встречаю р ассвет

Репутация: 8
Всего: 13

Цитата(murod @ 26.12.2006, 12:34

)

а вот у меня все компилится!

D7 ?

Beltar, сейчас обдумаю твой вариант.

Кто-нить в курсе, у TCollection порционное выделение памяти под элементы коллекции ?

Цитата

Тем боле что этот TCatch имеющий непорочное зачатие, как TObject меня малясь смущает.

слова то какие smile

Beltar,
как минимум, нужный функционал ты обеспечил, спасибо +.

Это сообщение отредактировал(а) Fedia - 27.12.2006, 01:18

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

Beltar

Дата 27.12.2006, 20:09 (ссылка)

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

Загрузка ...

Опытный

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

Репутация: 3
Всего: 7

Проверил тот компонентик, в десятке он компилится нормально, но там на основе TList сделан класс для хранения ADOTable'ов.
Похоже что фигня из-за того, что не определены методы доступа к полям структуры.

Это сообщение отредактировал(а) Beltar - 27.12.2006, 20:23

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

Опытный программист на C++ легко решает любые не существующие в Паскале проблемы. smile

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