Добавление Delphi компонента в Гедымин

Версия 19:01, 14 марта 2007

В платформу Гедымин встроено несколько сотен уже готовых визуальных и невизуальных компонентов. При необходимости можно добавить свои компоненты. Для этого придется взять с сайта исходный код платформы, внести в него изменения и перекомпилировать. Предположим, что у нас есть компонент TMyLabel, наследованный от TLabel. Данный компонент позволяет выводить текст под любым углом и даже обводить его одинарной или двойной рамкой. Компонент расширяет родительский TLabel методом Flash, который на долю секунды отрисовывает текст в инвертированном цвете.

 type
   // тип рамки вокруг текста: нет, одинарная или двойная
   TBorderType = (btNone, btSingle, btDouble);

 TMyLabel = class(TLabel)
 private
   FBorderType: TBorderType;
   FAngle: Integer;

 published
   procedure Flash;

   property BorderType: TBorderType read FBorderType;
   property Angle: Integer read FAngle write FAngle;
 end;

Теперь добавим этот компонент в Гедымин:

Добавление интерфейса в библиотеку типов

Первым шагом следует добавить в библиотеку типов GEDEMIN/REPORT/GEDEMIN.TLB новый интерфейс IgsMyLabel:

И наполнить его необходимыми методами и свойствами:

Далее, следует создать CoClass с именем gs_gsMyLabel и добавить в список поддерживаемых интерфейсов IgsMyLabel:

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

Создание класса оболочки

Класс-оболочка реализует созданный нами интерфейс. Оболоски стандартных компонент хранятся в модуле GEDEMIN\PROPERTY\OBJ_WRAPPERDELPHICLASSES.PAS. Оболочка для нашего гипотетического класса могла бы выглядеть следующим образом:

 TwrpMyLabel = class(TwrpLabel, IgsMyLabel)
 private
   function  GetMyLabel: TMyLabel;
 protected
   function Get_Angle: Integer; safecall;
   procedure Set_Angle(Value: Integer); safecall;
   function Get_BorderStyle: Integer; safecall;
   procedure Set_BorderStyle(Value: Integer); safecall;
   procedure Flash; safecall;
 end;

 ...

 function TwrpMyLabel.GetMyLabel: TMyLabel;
 begin
   Result := GetObject as TMyLabel;
 end;

 function TwrpMyLabel.Get_Angle: Integer;
 begin
   Result := GetObject.Angle;
 end;

 procedure TwrpMyLabel.Set_Angle(Value: Integer);
 begin
   GetMyLabel.Angle := Value;
 end;
  
 function TwrpMyLabel.Get_BorderStyle: Integer;
 begin
   Result := Integer(GetObject.BorderStyle);
 end;

 procedure TwrpMyLabel.Set_BorderStyle(Value: Integer);
 begin
   GetMyLabel.BorderStyle := TBorderStyle(Value);
 end;

 procedure TwrpMyLabel.Flash;
 begin
   GetMyLabel.Flash;
 end;

Регистрация класса

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

 RegisterGdcOLEClass(TMyLabel, TwrpMyLabel, ComServer.TypeLib, IID_IgsMyLabel);