|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Panel из DLL(.SO) Ошибка. Помогите разобраться, Идея создать набор библиотек с виджет
Есть такая идея сделать библитеку которая умеет создавать Виджет на основе
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. бьёмся с коллегами 3-й день. Либо убивается программа целиком. Либо вылетает Exception на 2782 строка в Conrol.inc . этом месте AParent.CheckChildClassAllowed(ClassType, True);. |
#2
|
|||
|
|||
Во первых.
Когда создаёте новый проект DLL, то Дельфи пишет в нём длинный коментарий. Внимательно читаем. |
#3
|
|||
|
|||
Не, там скорее всего связанно с тем, что TWinControl в DLL и в основной апликухе это разные классы.
Вообще, создавай на основе формы, при создании формы вызывай CreateParented() для ее создания. |