Модераторы: Poseidon, Snowy, bems, MetalFan

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Создание фрейма из DLL 
:(
    Опции темы
AlexLogos
Дата 14.6.2011, 12:26 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Хело, народ! У меня есть прога в которой на форме динамически создается фрейм, который выполняет ряд задач по роботе с БД. Хочу написать процедурку чтоб фрейм загружался из Dll. Написал процедуру в библиотеке
Код

procedure ConnectUniForm(AOwner:TWinControl; AParent:TWinControl);
var UniForm:TFrUniForm;
begin
  UniForm:=TFrUniForm.Create(AOwner);
  UniForm.Parent:=AParent;
  UniForm.Visible:=True;
end;

описал ее в программе 
Код

procedure ConnectUniForm(AOwner:TWinControl; AParent:TWinControl); stdcall; external 'ClassDll.dll' ;

вызываю ее нажатием на кнопке и получаю ошибку "Control 'FrUniForm' has no parent window". Как с этим бороться?
PM MAIL   Вверх
AlexLogos
Дата 14.6.2011, 16:45 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Народ, неужели никто не создавал компоненты из Dll, хотя б для пробы?
Профи, когда пишете комерческий продукт, все пакуете а один екзешник?
PM MAIL   Вверх
cemick
Дата 14.6.2011, 21:31 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
Попробуйте вот так, возможно поможет:
А именно:
В dll:
Код


var
  DllApp: TApplication;

    
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;

exports
  InitDll;

begin
  DllApp := nil;
  DLLProc := @btkDLLProc;
end.



Вызов метода инициализация надо выполнять до создания формы. Screen в dll тоже свой, и пойдее тоже можно заменить, но должно работать и так.

Если нет, не получается, то из dll возвращайте класс фрейма и создавайте в основном приложение, т.е. к выше приведеному коде допишите функцию экспорта класса
Код

     function GetFrameClass: TFrUniFormClass;
     begin
        result := TFrUniForm;
     end;
exports
  InitDll;
  GetFrameClass;


а в основном приложение как то так:
Код


TFrameDllFunc = function: TFrame;

procedure CreateFrame(Aparent: TWinControl);
var hLib : THandle;
begin
  hLib := GeLibrary;
  if hLib <> 0 then
  begin
    func := TFrameDllFunc (GetProcAddress(hLib, 'GetFrameClass'));
    @InitDllProc := GetProcAddress(FhLib, 'InitDll');
    if Assigned(InitDllProc ) then
    begin
      InitDllProc (Application, Screen);
    end else
     exit;
    if Assigned(func ) then
    begin
      frame := func.CreateParented(AParent);
    end; 
end;



Это сообщение отредактировал(а) cemick - 14.6.2011, 21:33
PM MAIL WWW   Вверх
RomanEEP
Дата 15.6.2011, 08:56 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 424
Регистрация: 18.5.2006
Где: Коломна

Репутация: 5
Всего: 8
я делал так:
1)функция в DLL GetFrameInterface: IMyFrame;
Код

IMyFrame = interface(IUnknown)
  procedure Show(ParentWnd: THandle);
  procedure SetSize(Width, Height: Integer);
  procedure Hide;
end;


в методе procedure Show я
2)создаю форму на ParentWnd с Border = bsNone
3)создаю на форме фрейм

прослойка в виде формы нужна, чтобы работал метод SetFocus() компонентов, который ищет активную форму


--------------------
Электронные экзамены
PM MAIL   Вверх
AlexLogos
Дата 15.6.2011, 09:23 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
попробовал сначала без экспорта класса но получаю сообщение что "Cannot assign a TFont to a TFont"...

пробую сделать експорт класса но на процедуре
Код

function GetFrameClass: TFrUniForm;
begin
  Result := TFrUniForm;
end;

получаю ошибку "[DCC Error] ClassDll.dpr(112): E2010 Incompatible types: 'TFrUniForm' and 'Class reference'"...

Это сообщение отредактировал(а) AlexLogos - 15.6.2011, 09:28
PM MAIL   Вверх
cemick
Дата 15.6.2011, 13:18 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
Цитата(AlexLogos @  15.6.2011,  09:23 Найти цитируемый пост)
function GetFrameClass: TFrUniForm;

Что это у вас такое? 
Там должена быть ссылка на класс, т.е. 
Код

TFrUniFormClass= class of TFrUniForm;

и соответственно:
Код

function GetFrameClass: TFrUniFormClass;
begin
  Result := TFrUniForm;
end


Это сообщение отредактировал(а) cemick - 15.6.2011, 14:28
PM MAIL WWW   Вверх
AlexLogos
Дата 15.6.2011, 14:41 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Спасибо, исправил. Пока нужны подсказки, ибо это моя первая проба работы с библиотеками.
В общем я изменил процедуру которую написал cemick, так ка я себе это представляю (в оригинале были ошибки)
Код

procedure CreateFrame(Aparent: TWinControl);
var hLib : THandle;
func:TFrameDllFunc;
InitDllProc: procedure(Appl:TApplication; AScreen:TScreen);
Frame:TFrame;
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
     exit;
    if Assigned(func) then
    begin
    try
      frame := func.CreateParented(AParent.Handle);
    except
      ShowMessage('error!');
    end;
    end;
  end;
end;

в итоге получаю сообщение об ошибке в блоке try. Что изменить? И еще, после закрытия главного окна программы получаю AV. Что это?
PM MAIL   Вверх
cemick
Дата 15.6.2011, 16:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
У меня такой способ прокатывал для создания формы, с фреймам все равно вышло "TForm can not Assignt to Tform", потому выход только использовать Build with runtime package, что бы везде использовались одинаковые типы. А ошибка у вас скорее из за отсутствия в uses'ах ShareMem (Ну или FastMM, смотря что у вас там).

Смотрим пример

Это сообщение отредактировал(а) cemick - 15.6.2011, 16:03

Присоединённый файл ( Кол-во скачиваний: 55 )
Присоединённый файл  FrameFromDll.rar 17,31 Kb
PM MAIL WWW   Вверх
AlexLogos
Дата 15.6.2011, 17:03 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
что это за ссылка, перехожу по ней - закачивается какой-то html.
PM MAIL   Вверх
cemick
Дата 15.6.2011, 17:21 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
Цитата(AlexLogos @  15.6.2011,  17:03 Найти цитируемый пост)
что это за ссылка, перехожу по ней - закачивается какой-то html. 

Сдается что у вас браузер какой то странный.  Ссылка сформирована стандартным механизмом форума для приаттачивания файлов. У меня в хроме все ок, загружает rar.
PM MAIL WWW   Вверх
AlexLogos
Дата 16.6.2011, 10:06 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Народ, при закрытии окна программы постоянно получаю ошибку AV, несмотря на то что и в dll и в проге прописан первым в uses ShareMem. Что за беда?
PM MAIL   Вверх
cemick
Дата 16.6.2011, 11:16 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
Цитата(AlexLogos @  16.6.2011,  10:06 Найти цитируемый пост)
Народ, при закрытии окна программы постоянно получаю ошибку AV, несмотря на то что и в dll и в проге прописан первым в uses ShareMem. Что за беда? 

В какой программе? В том примере что я выложил? Или получаешь в своей? Если в своей, то то это старая проблема гадания на кофейной гуще, выкладывай свой пример где получаешь.

Это сообщение отредактировал(а) cemick - 16.6.2011, 11:17
PM MAIL WWW   Вверх
AlexLogos
Дата 20.6.2011, 12:08 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Не в том месте указал ShareMem. Теперь все нормально - не выскакивает AV при закрытии приложения.

Это сообщение отредактировал(а) AlexLogos - 20.6.2011, 12:11
PM MAIL   Вверх
AlexLogos
Дата 20.6.2011, 12:29 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Бывалый
*


Профиль
Группа: Участник
Сообщений: 229
Регистрация: 23.4.2009

Репутация: нет
Всего: 1
Что ж, продолжение следует  smile 
Я взял присланный 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". Что опять не то?
PM MAIL   Вверх
cemick
Дата 23.6.2011, 13:51 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 416
Регистрация: 6.7.2006
Где: Санкт-Петербург

Репутация: 2
Всего: 6
А что с галочкой  Build with runtime package ?
PM MAIL WWW   Вверх
Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi: Общие вопросы"
SnowyMetalFan
bemsPoseidon
Rrader

Запрещается!

1. Публиковать ссылки на вскрытые компоненты

2. Обсуждать взлом компонентов и делиться вскрытыми компонентами

  • Литературу по Дельфи обсуждаем здесь
  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, Snowy, MetalFan, bems, Poseidon, Rrader.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Delphi: Общие вопросы | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.1008 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.