4
votes

I'm building a custom OpenGL control which consists of a list of items where each item may be a different class, but inherited from a certain common class type. I don't know how to do this in a way where I can do a loop through these items and perform certain actions which are expected to be overridden in the inherited classes.

To be more specific, this is a list of visual objects which are meant to be drawn to a canvas. I have a common class TGLItem which is used to create a number of inheritance classes. For example, TGLCar is inherited from TGLItem and is added to the list TGLItems. This custom list class is part of the control.

When the control draws, it does a loop through this item list and calls the Draw procedure of each item. Draw is intended to be overridden by the inheritance classes where the actual drawing of the item occurs. So the real work is done from the Draw procedure which is implemented in the TGLCar class but it is only called from the main control.

The main control (TGLImage) shall have no knowledge of what the actual inherited item is, but be able to call its Draw procedure expecting it to draw to OpenGL.

How do I structure this item list and item base in a way to accommodate for this scenario? Here's what I have so far:

  TGLItems = class(TPersistent)
  private
    FItems: TList;
    function GetItem(Index: Integer): TGLItem;
    procedure SetItem(Index: Integer; const Value: TGLItem);
  public
    constructor Create;
    destructor Destroy; override;
    procedure Add(AItem: TGLItem);
    function Count: Integer;
    property Items[Index: Integer]: TGLItem read GetItem write SetItem; default;
  end;

  TGLItem = class(TPersistent)
  private
    FPosition: TGLPosition;
    FDimensions: TGLDimensions;
    FOwner: TGLItems;
    FItemClass: TGLItemClass;
    procedure PositionChanged(Sender: TObject);
    procedure DimensionsChanged(Sender: TObject);
    procedure SetPosition(const Value: TGLPosition);
    procedure SetDimensions(const Value: TGLDimensions);
  public
    constructor Create(Owner: TGLItems);
    destructor Destroy; override;
    procedure Draw;
    property Owner: TGLItems read FOwner;
    property ItemClass: TGLItemClass read FItemClass;
  published
    property Position: TGLPosition read FPosition write SetPosition;
    property Dimensions: TGLDimensions read FDimensions write SetDimensions;
  end;

implementation...

{ TGLItem }

constructor TGLItem.Create;
begin
  FPosition:= TGLPosition.Create;
  FPosition.OnChange:= PositionChanged;
  FDimensions:= TGLDimensions.Create;
  FDimensions.OnChange:= DimensionsChanged;
end;

destructor TGLItem.Destroy;
begin
  FPosition.Free;
  FDimensions.Free;
  inherited;
end;

procedure TGLItem.DimensionsChanged(Sender: TObject);
begin

end;

procedure TGLItem.Draw;
begin
  //Draw to gl scene

end;

procedure TGLItem.PositionChanged(Sender: TObject);
begin

end;

procedure TGLItem.SetDimensions(const Value: TGLDimensions);
begin
  FDimensions.Assign(Value);
end;

procedure TGLItem.SetPosition(const Value: TGLPosition);
begin
  FPosition.Assign(Value);
end;

{ TGLItems }

procedure TGLItems.Add(AItem: TGLItem);
begin
  FItems.Add(AItem);
  //Expects objects to be created and maintained elsewhere
  //This list object will not create/destroy any items
end;

function TGLItems.Count: Integer;
begin
  Result:= FItems.Count;
end;

constructor TGLItems.Create;
begin
  FItems:= TList.Create;
end;

destructor TGLItems.Destroy;
begin
  FItems.Free;
  inherited;
end;

function TGLItems.GetItem(Index: Integer): TGLItem;
begin
  Result:= TGLItem(FItems[Index]);
end;

procedure TGLItems.SetItem(Index: Integer; const Value: TGLItem);
begin
  TGLItem(FItems[Index]).Assign(Value);
end;

The OpenGL part of it isn't necessarily relevant in this scenario, I just wanted to explain a little detail of what this is intended for to have an idea of how I expect this to work.

I also have the idea of passing the TGLItems list object to each individual item in its constructor, and having each item register its self in the item list. In this case, the item list wouldn't have any add procedure, and I probably wouldn't even need a separate list object. I'm just sure there should be some big trick to this that I'm missing, and I'm open to any large scale changes to the structure to more efficiently accommodate for this.

1
PS - Resorting to a third-party library can't be an answer, as this project is actually meant for me to learn the lower-level aspects of Delphi. Therefore things like GLScene, which I already have, won't be the answer.Jerry Dodge

1 Answers

5
votes

This is the classic use of polymorphism. According to the XE2 documentation (C++, but applicable here):

Polymorphic classes: Classes that provide an identical interface, but can be implemented to serve different specific requirements, are referred to as polymorphic classes. A class is polymorphic if it declares or inherits at least one virtual (or pure virtual) function.

Here's an example that accomplishes exactly what you're wanting to do. It creates a base type (TBase) with an abstract virtual method (Draw) which each descendant must implement, and two separate descendant types (TChildOne and TChildTwo), each of which implements it's own Draw method.

An array of TBase is declared, with 10 items (see the NumChildren constant) and the SetLength(BaseArray, NumChildren) line. The array is iterated through, and if the current index is odd, one child type instance is created; if it's even, the other child type is created.

The array is then iterated again in reverse, and the generic TBase.Draw is called. The code outputs a different line prefix based on which class type's Draw is being called. Note that the call to each array item's Draw is just calling the TBase.Draw (without checking to see what type is in the array at that index), but the specific Draw method of the different types is being called instead depending on which type is found in the array at that index.

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  SysUtils;  // XE2: uses System.SysUtils;

type
  TBase = class(TObject)
    procedure Draw(const Msg: string); virtual; abstract;
  end;

  TChildOne = class(TBase)
    procedure Draw(const Msg: string); override;
  end;

  TChildTwo = class(TBase)
    procedure Draw(const Msg: string); override;
  end;

  TBaseArray = array of TBase;

procedure TChildOne.Draw(const Msg: string);
begin
  // Hard-coded for clarity. Change to something like this
  // to see without hard-coded name
  // WriteLn(Self.ClassName + '.Draw: ', Msg);
  Writeln('Type TChildOne.Draw: ', Msg);
end;

procedure TChildTwo.Draw(const Msg: string);
begin
  // Note missing 'T' before class type to make more apparent.
  // See note in TChildOne.Draw about removing hard-coded classname
  WriteLn('Type ChildTwo.Draw: ', Msg);
end;

var
  BaseArray: TBaseArray;
  i: Integer;

const
  NumChildren = 10;

begin
  SetLength(BaseArray, NumChildren);

  for i := 0 to NumChildren - 1 do
  begin
    if Odd(i) then
      BaseArray[i] := TChildOne.Create
    else
      BaseArray[i] := TChildTwo.Create;
  end;

  for i := NumChildren - 1 downto 0 do
    BaseArray[i].Draw('This is index ' + IntToStr(i));
  Readln;

end.

The output to the console window looks like this:

enter image description here