Массив разнотипных объектов, ООП Опции

[sheka]

Реализовать многоразовый вывод разных картинок на экран.
Я думаю это сделать с помощью ООП: сделать массив разнотипных объектов и потом просто вызывать отрисовку.

Заголовок (Показать/Скрыть)

type
  TFirst = object
  protected
    a: integer;
    procedure Draw; virtual;
  public
    procedure Show;
    constructor Create(ia: integer);
  end;
  TSecond1 = object(TFirst)
  protected
    b: integer;
    procedure Draw; virtual;
  public
    constructor Create(ia,ib: integer);
  end;
  TSecond2 = object(TFirst)
  protected
    s: string;
    procedure Draw; virtual;
  public
    constructor Create(ia: integer;ist:string);
  end;

constructor TFirst.Create(ia: integer);
begin
  a := ia;
end;

procedure TFirst.Show;
begin
  Draw;
  writeln;
end;

procedure TFirst.Draw;
begin
  writeln('a = ',a);
end;

constructor TSecond1.Create(ia,ib: integer);
begin
  inherited Create(ia);
  b := ib;
end;

procedure TSecond1.Draw;
begin
  writeln('a = ',a);
  writeln('b = ',b);
end;

constructor TSecond2.Create(ia: integer;ist: string);
begin
  inherited Create(ia);
  s := ist;
end;

procedure TSecond2.Draw;
begin
  writeln('a = ',a);
  writeln('s = ',s);
end;


var
  a: array [1..2] of ^TFirst;
  p1: ^TSecond1;
  p2: ^TSecond2;
  i: integer;

begin
  New(p1);
  p1^.Create(5,7);
  a[1] := p1;
  New(p2);  p2^.Create(9,'mama');
  p2^.Create(9,'mama');
  a[2] := p2;
  writeln('SizeOf(p1^)  = ',SizeOf(p1^));
  writeln('SizeOf(a[1]^) = ',SizeOf(a[1]^));
  writeln('SizeOf(p2^)  = ',SizeOf(p2^));
  writeln('SizeOf(a[2]^) = ',SizeOf(a[2]^));
  for i := 1 to 2 do
    a[i]^.Show;

  for i := 1 to 2 do
    dispose(a[i]);
  readln;
end.

Тут проблемы:
1. При присваивании родителю наследника некоторые поля откидываются, т. е. это не будут полноценные объекты.
2. Сreate все таки вне цикла
3. Если делать не динамическими переменными почему-то writeln('s = ',s); строку s не выводит
4. Одним местом чувствую, что с памятью что-то не то, т. к. учитывая, что идет подгонка под родителя, то почему-то памяти выделяется как под наследника.

[volvo]

Давай по порядку:
1) зачем ты отдельно инициализируешь p1, и только потом копируешь это значение в a[1]? Сразу, на месте, сделать нельзя?

type
   PTSecond1 = ^TSecond1;
   TSecond1 = ... ;

// ...

  a[1] := New(pTSecond1, Create(5, 7));

?
2) если у тебя есть виртуальные методы - всегда делай виртуальный деструктор.
3)

При присваивании родителю наследника некоторые поля откидываются

Именно поэтому и делается на указателях + полиморфная процедура:

Как-то вот так (Показать/Скрыть)

type
  ptbase = ^tbase;
  tbase = object
    constructor create;
    procedure draw; virtual;
  end;

  ptfirst = ^tfirst;
  tfirst = object(tbase)
    value : integer;
    constructor create(i : integer);
    procedure draw; virtual;
  end;

  ptsecond = ^tsecond;
  tsecond = object(tbase)
    value : string;
    constructor create(s : string);
    procedure draw; virtual;
  end;

constructor tbase.create;
begin end;
procedure tbase.draw;
begin end;

constructor tfirst.create(i : integer);
begin
  inherited create;
  value := i;
end;
procedure tfirst.draw;
begin writeln(value); end;

constructor tsecond.create(s : string);
begin
  inherited create;
  value := s;
end;
procedure tsecond.draw;
begin writeln(value); end;

procedure draw_me(var obj : tbase);
begin
  obj.draw;
end;

var
  arr : array[1 .. 2] of ptbase;
  i : integer;
begin
  arr[1] := new(ptfirst, create(10));
  arr[2] := new(ptsecond, create('test'));
  for i := 1 to 2 do
  begin
    draw_me(arr[ i ]^)
  end;
  // удалять не забывай, чтоб потом когда функционал добавишь - утечек не было
end.

Сreate все таки вне цикла

Вне какого цикла? Оно и должно быть до цикла, цикл - по уже созданным с его помощью объектам...

[sheka]

Именно поэтому и делается на указателях + полиморфная процедура

при работе с указателями памяти выделяется столько сколько нужно под целый объект, в отличии от присваивания статических объектов?

если у тебя есть виртуальные методы - всегда делай виртуальный деструктор.
// удалять не забывай, чтоб потом когда функционал добавишь - утечек не было

хотя бы пустой написать, чтобы таблицу связей удалил?

Сообщение отредактировано: sheka - 23.02.2011 18:09

[volvo]

при работе с указателями памяти выделяется столько сколько нужно под целый объект, в отличии от присваивания статических объектов?

При присваивании статических объектов Предок <- Потомок у тебя копируются только поля, существующие в предке. Все остальные - теряются, ибо места под них не было выделено (не телепат твой TFirst, чтобы знать, что у него в будущем появится потомок TSecond, а тем более, чтобы знать, какие поля он будет содержать). Зато конструктор TSecond прекрасно знает, что этот тип - потомок TFirst, и какие поля есть у потомка, и какие поля есть у него самого, сколько памяти выделить под конкретный экземпляр. Поэтому создаем объект динамически (вызовом нужного конструктора, тогда будет выделено именно столько памяти, сколько нужно для этого конкретного объекта), и передаем разыменованный указатель в полиморфную подпрограмму. А там уже забота компилятора разобраться, какой метод ты дергаешь, статический он или виртуальный, и чей именно метод будет вызван. В моем примере Draw у базового типа виртуальный - значит, вызовется Draw из того типа, который ты создавал в arr[ i ], а потом разыменовывал. Если я уберу Virtual из описания TFirst - то реально нужный мне метод уже не вызовется, отработает только пустой Draw базового класса (кстати, совершенно легальная ситуация, когда у тебя какие-то методы статические, а на каком-то этапе ты делаешь их виртуальными, и виртуальными они уже будут у всех наследников ниже по дереву. Обратное невозможно, т.е., изначально виртуальный метод не может в одном из потомков стать статическим).

хотя бы пустой написать, чтобы таблицу связей удалил?

Хотя бы пустой напиши (для каждого типа в иерархии). Чтобы объект нормально освободил занимаемую память.

[sheka]

Пока получается как-то так:

Главная программа (Показать/Скрыть)

uses
  UBase, ULine, UCircle, Graph;

const
  n = 3;

var
  arr: array[1..n] of PTBase;
  i : integer;
  gd, gm: integer;
begin
  gd := Detect;
  InitGraph(gd,gm,'');
  arr[1] := new(PTLine, Create('Line1.txt',0,0,0,0,0,0,0));
  arr[2] := new(PTLine, Create('',9,3,3,100,500,800,100));
  arr[3] := new(PTCircle, Create('Circle1.txt',0,0,0,0,0,0));
  for i := 1 to n do
    arr[i]^.Show;


  readln;
  for i := 1 to n do
    arr[i]^.Destroy;
  CloseGraph;
end.

unit UBase; (Показать/Скрыть)

unit UBase;

interface

type
  PTBase = ^TBase;
  TBase = object
  protected
    Color: byte;
    procedure Draw(action: byte); virtual;
    procedure LoadFromFile(var f: text); virtual;
  public
    procedure Show;
    procedure Hide;
    constructor Create(FileName: string; iColor:byte);
    destructor Destroy;
  end;

implementation

uses
  Graph;

constructor TBase.Create(FileName: string; iColor:byte);
var
  f: text;
begin
  if FileName = '' then
    Color := iColor
  else
  begin
    assign(f,FileName);
    reset(f);
    LoadFromFile(f);
    close(f);
  end;
end;

procedure TBase.LoadFromFile(var f: text);
begin
  readln(f,Color);
end;

procedure TBase.Draw(action: byte);
begin
  if action = 1 then
    SetColor(Color)
  else
    SetColor(GetBKColor);
end;


procedure TBase.Show;
begin
  Draw(1);
end;

procedure TBase.Hide;
begin
  Draw(0);
end;

destructor TBase.Destroy;
begin
  Hide;
end;



end.

unit UCircle; (Показать/Скрыть)

unit UCircle;

interface

uses
  UBase;

type
  TPoint = record
    x, y: integer;
  end;

  PTCircle = ^TCircle;
  TCircle = object(TBase)
  protected
    pb: TPoint;
    Radius: integer;
    LineType, LineWidth: word;
    procedure Draw(action: byte); virtual;
    procedure LoadFromFile(var f: text); virtual;
  public
    constructor Create(FileName: string; iColor:byte;
      iLineType, iLineWidth: word; x1, y1, iRadius: integer);
    destructor Destroy;
  end;

implementation

uses
  Graph;

constructor TCircle.Create(FileName: string; iColor:byte;
      iLineType, iLineWidth: word; x1, y1, iRadius: integer);
begin
  inherited Create(FileName, iColor);
  if FileName = '' then
  begin
    LineType := iLineType;
    LineType := iLineType;
    pb.x := x1;
    pb.y := y1;
    Radius := iRadius;
  end;
end;


procedure TCircle.LoadFromFile(var f: text);
begin
  inherited;
  readln(f,LineType,LineWidth);
  readln(f,pb.x,pb.y);
  readln(f,Radius);
end;

procedure TCircle.Draw(action: byte);
begin
  inherited;
  SetLineStyle(LineType,0,LineWidth);
  Circle(pb.x,pb.y,Radius);
end;

destructor TCircle.Destroy;
begin
  inherited;
end;



end.

unit ULine; (Показать/Скрыть)

unit ULine;

interface

uses
  UBase;

type
  TPoint = record
    x, y: integer;
  end;

  PTLine = ^TLine;
  TLine = object(TBase)
  protected
    pb, pe: TPoint;
    LineType, LineWidth: word;
    procedure Draw(action: byte); virtual;
    procedure LoadFromFile(var f: text); virtual;
  public
    constructor Create(FileName: string; iColor:byte;
      iLineType, iLineWidth: word; x1, y1, x2, y2: integer);
    destructor Destroy;
  end;

implementation

uses
  Graph;

constructor TLine.Create(FileName: string; iColor:byte;
      iLineType, iLineWidth: word; x1, y1, x2, y2: integer);
begin
  inherited Create(FileName, iColor);
  if FileName = '' then
  begin
    LineType := iLineType;
    LineType := iLineType;
    pb.x := x1;
    pb.y := y1;
    pe.x := x2;
    pe.y := y2;
  end;
end;

procedure TLine.LoadFromFile(var f: text);
begin
  inherited;
  readln(f,LineType,LineWidth);
  readln(f,pb.x,pb.y);
  readln(f,pe.x,pe.y);
end;

procedure TLine.Draw(action: byte);
begin
  inherited;
  SetLineStyle(LineType,0,LineWidth);
  Line(pb.x,pb.y,pe.x,pe.y);
end;

destructor TLine.Destroy;
begin
  inherited;
end;



end.

Подскажите что не так, как может можно сделать красивее выбор ввода вручную или из файла?

[volvo]

Во-первых, есть перегрузка функций (я про конструктор), во-вторых - значения по умолчанию. Совмещаем и получаем:

ULine.pas

{$mode objfpc}
unit ULine;

interface

uses
  UBase;

type
  TPoint = record
    x, y: integer;
  end;

  PTLine = ^TLine;
  TLine = object(TBase)
    // ...
  public
    constructor Create(iColor:byte;
      iLineType, iLineWidth: word; x1, y1, x2, y2: integer);
    constructor Create(FileName: string; iColor: byte = 0);
    destructor Destroy;
  end;

implementation

uses
  Graph;

constructor TLine.Create(iColor:byte;
      iLineType, iLineWidth: word; x1, y1, x2, y2: integer);
begin
  inherited Create('', iColor);
    LineType := iLineType;
    pb.x := x1;
    pb.y := y1;
    pe.x := x2;
    pe.y := y2;
end;

constructor TLine.Create(FileName: string; iColor: byte);
begin
  inherited Create(FileName, iColor);
end;

// ...
end.

, то же самое делаешь для UCircle.pas, и потом вызываешь:

  InitGraph(gd,gm,'');
  arr[1] := new(PTLine, Create('Line1.txt'));
  arr[2] := new(PTLine, Create(9,3,3,100,500,800,100));
  arr[3] := new(PTCircle, Create('Circle1.txt'));
  for i := 1 to n do
    arr[i]^.Show;

[sheka]

Вернемся к тем же баранам:  Viselica.rar ( 5.42 килобайт ) Кол-во скачиваний: 433

В ULetterBox - массив объектов, наследников TShape. При заполнении этого массива TBar(TShape) не передаются размеры - поля, описанные в TBar. Следовательно, на экран вместо прямоугольников выводятся точки.

[volvo]

Не понял, что именно у тебя не происходит? Ты там что-то много наворотил, можешь конкретно названия файлов и номера строк указать, в которых делается не то, что ты задумывал (и, заодно, описать что именно ты задумывал, неплохо было бы).

А вообще - опиши задачу полностью. Есть стойкое ощущение, что ты изобретаешь какой-то грандиозный велосипед. Может, это делается гораздо проще?

[sheka]

Задание: сделать игру "Виселица". Учитывая, что тупо выбор кейсом нажатой клавиши + выбор кейсом отрисовки ошибки есть дело одного часа + это не интересно, решил выучить ООП.

Все аналогично решению в посте №2, только почему-то не работает:
В объекте ТLetterBox(модуль ULetterBox) есть поле-массив PLetter объектов типа TShape (27строка). При создании этого ТLetterBox создаются элементы этого массива (93) типа TLetterShape, который = TBar. Заполнение этого массива (42) происходит так: есть доп. переменная PSample тех же типов, что и элементы PLetter (18,154). Из файла инфо записывается сначала в нее, а потом уже копируется во все элементы массива.
Ошибка в том, что элементы массива типа TShape, а создаются с типом TBar(TShape) и таким образом не передаются размеры - поле BarDim, описанные в TBar (в UBar 19стр). Следовательно, на экран вместо прямоугольников выводятся точки. Если заменить тип элементов массива PLetter 12строка в модуле ULetterBox с TShape на TBar - то все замечательно работает.

[volvo]

Ошибка в том, что элементы массива типа TShape, а создаются с типом TBar(TShape) и таким образом не передаются размеры

Ты действительно считаешь, что поведение

    PLetter^[ i ]^ := PSample^;

, где PLetter[ i ] - типа PTShape, а PSample - создан как PSample := new(PTLetterShape, Create);, то есть, фактически, ты присваиваешь TShape <- TBar, разумеется, все отсутствующие в TShape поля перенесены гарантированно не будут, по правилам присваивания предку значения-потомка - это ошибка?

Это ошибка, только чья?

А между тем, если сделать два вот таких простых движения:
1) описание типов

type
  // PTLetterShape = PTBar;
  PTLetterShape = ^TLetterShape; // Угу, указатель - так указатель, незачем делать двойную работу
  TLetterShape = TBar;

  TPLetter = array[1..maxint div sizeof(PTShape)] of PTShape;
  PPLetter = ^TPLetter;

  PTLetterBox = ^TLetterBox;
  TLetterBox = object(TBar)
  private
    PSample: PTLetterShape; // <--- Вот это - движение №1
    procedure PLetterCreate;
    procedure PLetterDestroy;
  protected
    // Дальше все как было в объекте
  end;

2) метод TLetterBox.LettersLoadFromFile(const FileName: string);

  for i := 1 to ColCount*(RowCount-1) do
  begin
    PTLetterShape(PLetter^[i])^ := PSample^; // Это - движение №2, 14 строк ниже - повтори его. 
    PLetter^[i]^.SetXY(LeftShift+((i-1) mod ColCount)*(PLetter^[i]^.GetWidth+ColDistance),
                    TopShift+((i-1) div ColCount)*(PLetter^[i]^.GetHeight+RowDistance));
    readln(f,s);
    PLetter^[i]^.Title.SetCaption(s);
  end;

, то все заведется как положено, и будет рисоваться рамка. Просто изменение типа PSample ничего не даст. Объяснить причину сможешь?

P.S. На самом деле первое движение можно не делать, а второе сделать чуть более хитро:

    PTLetterShape(PLetter^[i])^ := PTLetterShape(PSample)^;

, это тоже должно сработать, лень проверять

[sheka]

Работает. Не даст, потому что

фактически, ты присваиваешь TShape <- TBar, разумеется, все отсутствующие в TShape поля перенесены гарантированно не будут, по правилам присваивания предку значения-потомка