Передача типа как параметра

[Troublemaker]

В ветке по лазарю я спрашивал, как лучше создавать радиокнопки в рантайме.
Теперь попутный вопрос. Мне надо заполнить несколько групбоксов радиокнопками по одному и тому же алгоритму, но с разными параметрами. Основная идея: количество кнопок определяется мощностью перечислимого типа, которая, как и сам тип, зависит от конкретной задачи.
Например, для коллекций вопросов мне нужно три кнопки: "коллекция-теория", "коллекция-практика" и "смешанная коллекция". В коллекции может быть два типа модулей: "модуль-теория" и "модуль-практика". В практическом модулек может быть (на данный момент) 4 варианта вопросов, отличающихся способом ввода ответа: "выбрать несколько (1 или больше) правильных из предложенных вариантов", "вписать строковый (буквы и (или) цифры) ответ", "вписать числовой ответ", "расставить предложенные варианты в правильном порядке"

Было бы логично передавать все данные для создания набора кнопок в некую процедуру типа:

proc MakeButtons(var где:tgroupbox;подписи:array of strings;var buttons:array of tradiobutton;enum:type)

где enum - это перечислимый тип, количество элементов в котором определяет количество создаваемых кнопок, размер массива подписей и т.д.

Зачем этот тип передавать? Потому что хочу создавать кнопки в таком цикле:

var i:enum
for i:=low(enum) to high(enum) do СоздатьКнопкуИЗадатьЕёПараметры...

Вот мне и интересно, можно ли сочинить такую конструкцию или на каждую группу заводить свой цикл, создавая кучи однотипного кода?

[shade]

Лазаря у меня сейчас нет... потестить не на чём...

Но для каждого класса есть тип, даже не знаю как его правильно назвать, который может ссылать на класс. Для TObject определен TClass = class of TObject; Переменной такого типа можно присваивать любые классы, например:

Код: Выделить всё

var AClass: TClass;
  AClass := TStringList;

Через переменую такого типа можно вызывать конструкторы (которые могут быть виртуальными) и class-методы объекта.

Вот примерчик для наводки

Код: Выделить всё

{$mode objfpc}
uses SysUtils, Classes;

type
  TFoo = class
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  TArrayOfFoo = array of TFoo;
  TClassOfFoo = class of TFoo;

  TBar = class (TFoo)
    constructor Create; override;
    destructor Destroy; override;
  end;

  TBanana = class (TFoo)
    constructor Create; override;
    destructor Destroy; override;
  end;


function CreateObjects(const ClassList: array of TClassOfFoo): TArrayOfFoo;
var i, len: Integer;
begin
  Len := Length(ClassList);
  SetLength(Result, Len);
  for i := 0 to Len-1 do
  begin
    Result[i] := ClassList[i].Create;
  end; // for i
end;

procedure FreeObjects(var FooList: TArrayOfFoo);
var i: Integer;
begin
  for i := Low(FooList) to High(FooList) do
  begin
    FooList[i].Free;
  end; // for i
  SetLength(FooList, 0);
end;

constructor TFoo.Create;
begin
  writeln('TFoo.Create');
end;

destructor TFoo.Destroy;
begin
  writeln('TFoo.Destroy');
end;

constructor TBar.Create;
begin
  writeln('TBar.Create');
end;

destructor TBar.Destroy;
begin
  writeln('TBar.Destroy');
end;

constructor TBanana.Create;
begin
  writeln('TBanana.Create');
end;

destructor TBanana.Destroy;
begin
  writeln('TBanana.Destroy');
end;

var
  FooList: TArrayOfFoo;
  i: Integer;

begin
  FooList := CreateObjects( [TFoo, TBar, TBanana] );
  writeln;

  for i := Low(FooList) to High(FooList) do
  begin
    writeln('there is object of class ', FooList[i].ClassName);
  end; // for i

  writeln;
  FreeObjects(FooList);
end.

[Troublemaker]

для каждого класса есть тип, даже не знаю как его правильно назвать, который может ссылать на класс

Уважаемый, вы тредом не ошиблись? Может я туплю, но не вижу никакой связи между вашим ответом и своим вопросом. Или эта связь слишком неочевидна для меня.

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

[dymken]

Если следовать только заголовку, то shade ответил правильно (чтобы передать тип, а вернее класс), однако я не до конца понял, что хочет автор вопроса.

Создать процедуру, которая генерировала бы панель (или groupbox - неважно) с одним из типов вопроса для анкеты?
Можно увидеть примерно, что должно получится на выходе в виде картинок и какие на вход должны поступать данные для каждого случая?

На вскидку приходит полиморфизм, но не думаю, что стоит бить из пушки по воробьям...

[B4rr4cuda]

Уважаемый, вы тредом не ошиблись? Может я туплю, но не вижу никакой связи между вашим ответом и своим вопросом. Или эта связь слишком неочевидна для меня.

Все правильно shade написал. Забываем кларион и начинаем думать в ООП-стиле.
У нас есть класс предок TFoo, обеспечивающий общие методы. Есть потомки TBar и TBanana использующие и свои методы и методы предка (если их не перекрыли, как в этом примере).
Есть фунца CreateObjects, создающая массив классов. И FreeObjects их освобождающая.
Фактически, используя эту методику, мы абстрагируемся от конкретных классов и групп и используем ОДНУ процедуру для их обработки вместо трех. Ессно методы для каждого класса надо реализовать. Но их обработку выносим в общую процедуру.
Т.е все, как и просили - избегаем написания однотипного кода.

[Troublemaker]

Коллеги, я стараюсь быть точным в выражениях. Хорошо, перейдем к конкретике.

Вот примеры перечислимых типов, которые я хотел бы передавать для обработки. На выходе, соответственно, должны быть групбоксы с 3, 3, 4 и 2 кнопками. При этом количество элементов в типе может меняться во время программирования.

Код: Выделить всё

  T_CollectionKind=(ckTheory,ckExam,ckMixed);
  T_ExamKind=(ekExam,ekTrain,ekLab);
  T_QuestionKind=(qkOneChoice,qkString,qkNumber,qkReorder);
  T_AnswerKind=(akEntered,akGenerated);

Сейчас я создаю их так:

Код: Выделить всё

{можно обойтись и без этих массивов, сделал их просто чтобы не потерять из виду созданные кнопки, вдруг понадобятся}
var CKButtons:array[T_CollectionKind] of TRadioButton; 
  QKButtons:array[T_QuestionKind] of TRadioButton; 

  QTypeBox,ColTypeBox:TGroupBox; //размещены на форме, хотя могут создаваться и в рантайме

procedure TEditForm.Init_ColType;
var i:T_CollectionKind;
begin
  for i:=Low(T_CollectionKind) to High(T_CollectionKind) do begin
    CKButtons[i]:=TRadioButton.Create(ColTypeBox);
    with CKButtons[i] do begin
      Width:=cDefRButHeight;
      Height:=cDefRButHeight;
      Hint:=cCKhint[i];
      Visible:=true;
      Tag:=ord(i);
      Caption:=cCKname[i];
      Parent:=ColTypeBox;
      Name:='CKButton'+Format('%2.2D',[Tag]);
      OnClick:=@RGQ_KindClick;
    end;
  end;
end;

procedure TEditForm.Init_QType;
var i:T_QuestionKind;
begin
  for i:=Low(T_QuestionKind) to High(T_QuestionKind) do begin
    QKButtons[i]:=TRadioButton.Create(QTypeBox);
    with QKButtons[i] do begin
      Width:=cDefRButHeight;
      Height:=cDefRButHeight;
      Hint:=cQKhint[i];
      Visible:=true;
      Tag:=ord(i);
      Caption:=cQKname[i];
      Parent:=QTypeBox;
      Name:='QKButton'+Format('%2.2D',[Tag]);
      OnClick:=@RGQ_KindClick;
    end;
  end;
end;

Не понимаю, причем здесь массивы классов и т.п.?

[dymken]

Ну вариантов много.
Первый вариант - не заморачиваться над передачей типов, а тупо сделать различные циклы для каждого T_XxxKind (В паскале принято писать тип без подчеркивания - TXxxKind);
Чтобы упростить создание радиокнопки, можно сделать для него фабричный метод:

Код: Выделить всё

function TEditForm.CreateRadioButton(AHint, ACaption: string):TRadioButton;
begin
  Result := TRadioButton.Create(Self);
  Result.Width := cDefRButnWidth;
  Result.Height := cDefRButHeight;
  Result.Hint := AHint;
  Result.Caption := ACaption;
  Result.Parent := ColTypeBox;
//  Result.Name имхо не нужен... 
end;

А вызов делать так:

Код: Выделить всё

procedure TEditForm.InitCollectionKind;
begin
  for i:=Low(T_CollectionKind) to High(T_CollectionKind) do begin
  begin
    CKButtons[i] := CreateRadioButton(cCKHints[i], cCKNames[i]);
    CKButtons[i].OnClick := @DoCKClick;
  end;
end;

Если же кол-во таких Kind'ов заранее неизвестно и их ожидается много, то я бы создал общий класс, а уже в потомках определил бы нюансы их создания и поведения.

Далее, из кода вообще говоря не понятно, зачем передавать этот тип, когда тупо можно передать количество радиокнопок... Причем тоже неявно:

Код: Выделить всё

procedure InitRadioButtons(AHints: THintArray; ACaptions: TCaptionArray; ADoClick: TNotifyEvent);
begin
  for i:= 0 to High(ACaptions) do
  begin
    ... и в общем то тоже самое что у вас ...
  end;
end;

procedure Ini_CK;
begin
  InitRadioButtons(cCKHints, cCKNames, @RGQ_KindClick);
end;

Ну вот что-то типа того...

[Troublemaker]

тупо можно передать количество радиокнопок

...InitRadioButtons(AHints: THintArray...

Хм... а вот до этого я не додумался, что можно передавать не тип, а массив этого типа и уже из него брать количество элементов. Спасибо, буду комбинировать!

[*vmr]

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

Эта бодяга называется метаклассом

Хм... а вот до этого я не додумался, что можно передавать не тип, а массив этого типа и уже из него брать количество элементов. Спасибо, буду комбинировать!

Это и пытался тебе втолкать shade

[Cheb]

RTTI надо уметь пользоваться!

Код: Выделить всё

{$typeinfo on}
uses ... ,typinfo ,...
type T_CollectionKind=(ckTheory,ckExam,ckMixed);
proc MakeButtons(.....; enum:PTypeInfo);
var
  EData: PTypeData;
  valname: string;
begin
  if enum^.Kind <> tkEnumeration then raise Exception.Create('это не перечеслимый тип блаблабла');
  EData:=GetTypeData(enum)
  For i:=0 to EData^.MinValue to EData^.Maxvalue do begin
    valname:= GetEnumName(enum, i)
    ... // где ValName будет принимать 'ckTheory', 'ckExam', 'ckMixed'.
  end;
...
end;

вызывается как: MakeButtons(....., TypeInfo(T_CollectionKind));

[Troublemaker]

RTTI надо уметь пользоваться!

И за это спасибо.
Здорово мешает то, что нет чего-то вроде развернутого howto по FPC/Lazarus: возможностей и "фишек" очень много, но неизвестно, что именно в наличии.