Что ж, продолжение следует 
Я взял присланный cemick'ом архив и использовал его при тестировании его способа формирования фрейма
Вот собственно коды проекта и библиотеки
| Код |
unit UTryCD;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TMain = class(TForm)
Panel1: TPanel;
Panel2: TPanel;
BTry: TButton;
BTry2: TButton;
procedure BTryClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TFrameClass = class of TFrame;
TFrameDllFunc = function: TFrameClass;
TInitProc = procedure (Appl:TApplication; AScreen:TScreen);
var
Main: TMain;
Frame:TFrame;
implementation
{$R *.dfm}
procedure CreateFrame(Aparent: TWinControl);
var
hLib : THandle;
func:TFrameDllFunc;
InitDllProc:TInitProc;
begin
hLib := LoadLibrary('ClassDll.dll');
if hLib <> 0 then
begin
func := TFrameDllFunc (GetProcAddress(hLib, 'GetFrameClass'));
@InitDllProc := (GetProcAddress(hLib, 'InitDll'));
if Assigned(InitDllProc) then
begin
InitDllProc(Application, Screen);
end else
begin
ShowMessage('not Assigned(InitDllProc)');
exit;
end;
if Assigned(func) then
begin
try
frame := func.CreateParented(AParent.Handle);
Frame.Align := alClient;
Frame.Parent := AParent;
frame.Visible := True;
ShowMessage(Frame.ClassName);
except
ShowMessage('error!');
end;
end;
end;
end;
procedure TMain.BTryClick(Sender: TObject);
begin
CreateFrame(Panel2);
end;
end.
|
Библиотека
| Код |
library ClassDll;
uses
ShareMem,
SysUtils,
Classes,
Windows,
Forms,
Dialogs,
frFrameUnit in 'frFrameUnit.pas' {frFrame: TFrame};
type TFr= class of TfrFrame;
var
DllApp: TApplication;
{$R *.res}
procedure InitDll(Appl:TApplication; AScreen:TScreen);
begin
//Подмена указателей на данные объекты необходима для корректного создания фрейма
//в основном приложении, так как у dll свой Application и как правило равный nil
DllApp := Application;
Application := Appl;
end;
procedure btkDLLProc(Reason: Integer);
begin
//Возращаем на место ссылку на application перед выгрузкой dll
if Reason = DLL_PROCESS_DETACH then
begin
// Если DLL is выгружается, то восстанавливаем значение указателя Application}
if (Assigned(DllApp)) then
begin
Application := DllApp;
end;
end;
end;
function GetFrameClass: TFr;
begin
Result := TfrFrame;
end;
exports
InitDll,
GetFrameClass;
begin
DllApp := nil;
DLLProc := @btkDLLProc;
end.
|
в итоге я получаю сообщение "Cannot assign TFont to a TFont". Что опять не то? |
)