[kaneghost]

Есть такая идея сделать библитеку которая умеет создавать Виджет на основе
Tpanel и 2-х на ней Tlabel.
вот сама библиотека

Код:

{
  Example library
}
library subs;

{$mode objfpc}{$H+}

uses Forms, Classes, Controls, ExtCtrls, StdCtrls, Graphics, Interfaces,dialogs;

type

    { TWidget }

    TWidget = class (TPanel)
      private
      l1  : TLabel;
      l2  : TLabel;
      //colorr : TColor;
      public
      constructor Create (p : pointer; s1, s2 : string; colorrr : TColor);
      function UpdateValue(s:string):boolean;
      destructor Destroy;
    end;






  //TWidget.Create(p: TWinControl; s1, s2: string; colorrr: TColor),TWidget.UpdateValue(s: string): boolean,TWidget.Destroy();

{ TWidget }

constructor TWidget.Create(p: pointer; s1, s2: string; colorrr: TColor);
begin
   Inherited Create(tComponent(p));


   self.Color:=colorrr;
   //self.Owner:=p;
   //self.Width:=  round (Self.Parent.Width * 0.6);    // Ширина виджета относительно родителя
   //self.Height:= round (Self.Parent.Height * 0.5);  // Высота виджета относительно родителя
   self.Width:=22;
   self.Height:=22;
   self.Left:= 10;//round (Self.Parent.Width * WLeft);
   self.Top:= 50; //round (Self.Parent.Height * WTop);
   self.Caption:=s1;
   parent:=TWinControl(p);

   //ShowMessage('blablabla'+s1);
   //
   l1:=tlabel.create(self);
   l1.Parent:=self;
   l1.Font.Color:= clWhite;
   l1.AutoSize:=TRUE;
   l1.Caption:=s1;
   l1.Top:= round(self.Height*0.2);
   l1.Left:=round(self.Width*0.4);

   l2:=tlabel.create(self);
   l2.Parent:=self;
   l2.Font.Color:= clWhite;
   l2.AutoSize:=TRUE;
   l2.Caption:=s2;
   l2.Top:= round(self.Height*0.3);
   l2.Left:=round(self.Width*0.2);

   //self.Parent:=pointer(p);

end;

function TWidget.UpdateValue(s: string): boolean;
begin
  self.l2.Caption:=s;
end;

destructor TWidget.Destroy;
begin
  self.l2.Destroy;
  self.l1.Destroy;
  self.Free;

end;

function WidgetCreate(p:pointer;s,s2:string;tcol:tcolor):pointer;cdecl;export;
begin
  result:=TWidget.Create((p),s,s2,tcol);
end;
function WidgetUpdate(p:pointer;s:string):boolean;cdecl;export;
begin
  if assigned(twidget(p)) then
  begin
   twidget(p).l2.Caption:=s; exit(true)
  end

  else
   exit(false)
end;

exports
  WidgetCreate,widgetUpdate;

end.

вот Апликуха(программа) которая ее использует

Код:

{

unit testsubs;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  ExtCtrls, dl, dynlibs;

type
  //{ TWidget }
  //
  //  TWidget2 = class (TPanel)
  //    private
  //    l1  : TLabel;
  //    l2  : TLabel;
  //    //colorr : TColor;
  //    public
  //    constructor Create (p : TWinControl; s1, s2 : string; colorrr : TColor);
  //    function UpdateValue(s:string):boolean;
  //    destructor Destroy;
  //  end;

  { TForm1 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Panel1: TPanel;
    procedure Button2Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;


Type
  Twidget =
    function (p:pointer;s,s2:string;tcol:tcolor):pointer;cdecl;

var
  Form1: TForm1;
  widget:tpanel;
implementation

{$R *.lfm}

{ TForm1 }



procedure TForm1.Button2Click(Sender: TObject);
var s1,s2,s3 : string;

    MyLibHandel:TlibHandle =dynlibs.NilHandle;
    ShowWidget:Twidget;
    path:string;
begin
   s1:= Edit1.Text;
   s2:= Edit2.Text;
   s3:= Edit3.Text;

   path:= ExtractFilePath(Application.ExeName) +'libsubs.so';
   MyLibHandel:=LoadLibrary(path);
   if MyLibHandel=0 then exit;

   ShowWidget:=Twidget(GetProcedureAddress(MyLibHandel,'WidgetCreate'));

   widget:=tpanel(ShowWidget(form1.panel1,s1,s2,clblue));




end;

end.

Ошибка возникает когда назначается у создаваемого объекта parent.
бьёмся с коллегами 3-й день. Либо убивается программа целиком. Либо вылетает Exception на 2782 строка в Conrol.inc . этом месте AParent.CheckChildClassAllowed(ClassType, True);.