IPB
ЛогинПароль:

 
 Ответить  Открыть новую тему 
> Panel из DLL(.SO) Ошибка. Помогите разобраться, Идея создать набор библиотек с виджетами
сообщение
Сообщение #1





Группа: Пользователи
Сообщений: 1
Пол: Мужской
Реальное имя: maxim gusev
Skype: kaneghost

Репутация: -  0  +


Есть такая идея сделать библитеку которая умеет создавать Виджет на основе
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);.


за решение с нас пивас drinks.gif drinks.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Большевик–концептуал
**

Группа: Пользователи
Сообщений: 120
Пол: Мужской
Реальное имя: Иван Левашев
Jabber: octagram@jabber.ru
Skype: i.levashew
QQ: 3152538431
WeChat
Ада: Сторонник
Embarcadero Delphi: Сторонник
Free Pascal: Разработчик
Turbo Pascal: Установлен

Репутация: -  0  +


Вообще это большая тема, но если вкратце, нужно делать пакеты. Ключевое слово package, а не library. В Delphi это файлы dpk.

У вас получаются свои отдельные версии TComponent в библиотеке и программе, и при какой-нибудь проверке класс в библиотеке не окажется наследником нужного класса в программе. И память, если выделить под строку в программе, освободить в библиотеке, окажется повреждённой, если аллокаторы несинхронизированы. Я уж не говорю об ABI полей и методов TComponent, который поедет при любом несинхронизированном обновлении RTL и/или FCL.

Сообщение отредактировано: OCTAGRAM -


--------------------
If you want to get to the top, you have to start at the bottom
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 




- Текстовая версия 20.09.2017 10:46
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"