Мастера DELPHI (документация, исходники, скачать)

Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

« предыдущая ветвь | форум | следующая ветвь »

DLL немодальный вызов, MDI [D7, Win2k, WinXP]

Страницы: 1 2 3 4 >
IntruderLab © (2008-03-11 15:32:00)
Задачка такова, необходимо разработать MDI приложение, все формы хранятся в dll. Не получается вызов формы как Child формы, как сделать?
Привожу кусочек из DLL
var
DLLForm : TDLLForm;
CallForm : THandle;
implementation

{$R *.DFM}
//******************************************************************************
function ShowModalForm: Integer;
//Modal Call
begin
DllForm := TDllForm.Create(Application);
Result := DLLForm.ShowModal;
DLLForm.Free;
end;
//******************************************************************************
procedure ShowForm(Appl, Form: THandle);
//NonModal Call
begin
Application.Handle := Appl;
DllForm := TDllForm.Create(Application);
DLLForm.FormStyle := fsMDIChild;
DLLForm.Color := clMoneyGreen;
CallForm := Form;
DLLForm.Show;
end;
//******************************************************************************

и кусочек из приложения
procedure TTestMain.Button1Click(Sender: TObject);
// Модальный вызов
begin
Button2.Enabled := False;
label1.Caption := 'ModalResult = '+IntToStr(ShowModalForm);
label1.Show; // Показываем результат вызова
Button2.Enabled := True
end;

procedure TTestMain.Button2Click(Sender: TObject);
// Немодальный вызов
begin
Button1.Enabled := False;
Button2.Enabled := False;
Button3.Enabled := True; label1.Hide;
ShowForm(Application.Handle, Self.Handle) ;
end;

IntruderLab (2008-03-31 11:20:00) [1]
Представляю :) Спасибо всем!!!

Loginov Dmitry (2008-03-21 23:04:00) [2]
> Вобщем то для тех кому интересно - решилось простым не прописыванием
>
> FreeLibrary(LibHandle);

Логично. Ты создавал в библиотеке дочернюю форму и тут же выгружал эту библиотеку а вместе с нею и код всех обработчиков, которые наверняка присутствовали у дочерней формы. А представляешь, каково это - обработчики без кода! :)

Сергей М. (2008-03-21 10:57:00) [3]
И вот еще что : везде stdcallпонатыкано - это "щоб було" или как ?)

Сергей М. (2008-03-21 10:38:00) [4]

> завершаю работу формы из самой дочерней формы

Причем здесь форма ?

Я тебе про саму dll говорю - ты убрал LoadLibrary, значит ты не выгружаешь dll из памяти процесса.

> вроде как она уничтожается

Это она тебе сама сказала ?)

IntruderLab (2008-03-21 10:33:00) [5]
Я завершаю работу формы из самой дочерней формы, и вроде как она уничтожается

Сергей М. (2008-03-19 17:24:00) [6]

> решилось простым не прописыванием
> FreeLibrary

Тогда библиотека останется в памяти процесса до конца работы приложения, даже если форма, реализованная в ней, будет уничтожена и никогда более не создана вплоть до окончания работы приложения.

Тебе оно надо ?

Если надо, то дело хозяйское)

IntruderLab (2008-03-19 15:59:00) [7]
Вобщем то для тех кому интересно - решилось простым не прописыванием
FreeLibrary(LibHandle);

intruderlab (2008-03-13 22:35:00) [8]
извини,просто запарил,сейчас убиру и попробую запустить.

Сергей М. (2008-03-13 19:56:00) [9]
Я тоже "русскостью", увы, "похвастать" не вправе)

Но .. надо же быть внимательным, когда это в твоихинтересах)

intruderlab (2008-03-13 19:52:00) [10]
ты знаешь нет, я башкир :). Убираю

Сергей М. (2008-03-13 19:03:00) [11]

> IntruderLab (13.03.08 17:24) [63]

> library dll;
> uses
> ShareMem,

Ты вообще-то русский ?)

IntruderLab (2008-03-13 17:28:00) [12]
на главной форме при запуске дочки caption исчезает

IntruderLab (2008-03-13 17:24:00) [13]
unit UfrmMain;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus;

type
TfrmMain = class(TForm)
menu: TMainMenu;
mnuTest: TMenuItem;
procedure mnuTestClick(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmMain: TfrmMain;

implementation

{$R *.dfm}
//******************************************************************************
procedure TfrmMain.mnuTestClick(Sender: TObject);
var LibHandle : THandle;
ShowChild:function :Longint;StdCall;
begin
LibHandle := LoadLibrary('dll.dll');
if LibHandle <> 0 then
begin
@ShowChild := GetProcAddress(LibHandle,'ShowChild');
ShowChild;
end;
FreeLibrary(LibHandle);
end;
//******************************************************************************
end.

library dll;
uses
ShareMem,
Windows,
Messages,
SysUtils,
Variants,
Classes,
Controls,
Forms,
Dialogs,
UfrmChild in 'UfrmChild.pas' {frmChild};

{$R *.res}
//******************************************************************************
function ShowChild:Longint;StdCall;
var frmChild:TfrmChild;
begin
try
Application.CreateForm(TfrmChild,frmChild);
except
on E:Exception do ShowMessage(E.ClassName + ' ' + E.Message);
end;
Result := 1;
end;
//******************************************************************************
exports
ShowChild;
//******************************************************************************
begin
end.

Сейчас форма реально появилась на экране - но приложение подвисло!

Сергей М. (2008-03-13 17:04:00) [14]
Это, ты считаешь, тестовыйпроект, да ?)

И я во всем этом хламе должен разбираться ?)

Убирай нафих из всех форм все!
И никаких лишних юнитов в проектах не должно быть, только действительно необходимые для теста !
Формы должны быть девственно чистыми !

ShareMem убрать к лешему везде ! Мало того , что не знаешь зачем оно надо, да еще и влупил его в хост-проекте совсем не туда, куда требует документация.

IntruderLab (2008-03-13 16:58:00) [15]
не проблема :) выкладываю
unit UfrmMain;

interface

uses
ShareMem, Windows, Messages, SysUtils,
Variants, Classes, Graphics,
Controls, Forms,
Dialogs,
ComCtrls, Menus,
ADODB,
DB,
DBTables,
SConnect,
Sockets,
DBClient,
MConnect, StdCtrls, ImgList, jpeg, ExtCtrls,
Registry, Buttons, OleCtrls, SHDocVw, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient, IdMessageClient, IdSMTP, JvExStdCtrls,
JvMemo, JvDotNetControls, JvExControls, JvComponent, JvEditorCommon,
JvUnicodeEditor, JvUnicodeHLEditor, JvaScrollText, JvCheckBox,
IdAntiFreezeBase, IdAntiFreeze, JvRichEdit,
Consts, ConvUtils, Math, SyncObjs, ComObj, UfrmAbout, StrUtils,
URemoteReadNews,
URemoteKKMSettings,
IdFTP,
IniFiles, frxClass, JvEdit, ToolWin, DBCtrls, JvDBDotNetControls,
JvScrollMax, JvExExtCtrls, Grids, JvListBox, ShellAPI, ActnList, Tabs;

type
TfrmMain = class(TForm)
status: TStatusBar;
menu: TMainMenu;
frmReg: TMenuItem;
mnuLogOn: TMenuItem;
mnuVvod: TMenuItem;
mnuNotes: TMenuItem;
mnuReports: TMenuItem;
mnuOSV: TMenuItem;
mnuNumerators: TMenuItem;
mnuhLIST_FACTORY_FILIAL: TMenuItem;
mnuhLIST_TYPE_DOCUMENTS: TMenuItem;
mnuhLIST_DOCUMENT_NUMERATOR: TMenuItem;
mnuhLIST_ROLE: TMenuItem;
mnuWorkers: TMenuItem;
iList: TImageList;
mnuClientShow: TMenuItem;
mnuTourOperators: TMenuItem;
mnuShowDocuments: TMenuItem;
mnuSettings: TMenuItem;
mnuKKMServer: TMenuItem;
mnuXReport: TMenuItem;
mnuZReport: TMenuItem;
tcp: TTcpClient;
IdAntiFreeze1: TIdAntiFreeze;
N6: TMenuItem;
mnuCloseSeans: TMenuItem;
N1: TMenuItem;
ftp: TIdFTP;
mnuTourOperatorList: TMenuItem;
mnuUserNotes: TMenuItem;
mnuLIST_COUNTRY: TMenuItem;
mnuLIST_CITY: TMenuItem;
N8: TMenuItem;
mnuLIST_HOTELS: TMenuItem;
mnuAnalitica: TMenuItem;
frmKKMFunction: TMenuItem;
N5: TMenuItem;
mnuChangeOrderClient: TMenuItem;
mnuInsertPay: TMenuItem;
mnuGetPay: TMenuItem;
N2: TMenuItem;
aList: TActionList;
aEsc: TAction;
Panel1: TPanel;
N3: TMenuItem;
ts: TTabSet;
sm1: TJvScrollMax;
JvScrollMaxBand2: TJvScrollMaxBand;
lblKKMHost: TLabel;
lblKKMPort: TLabel;
JvScrollMaxBand3: TJvScrollMaxBand;
lblGetLocalIP: TLabel;
lblClientHostName: TLabel;
JvScrollMaxBand5: TJvScrollMaxBand;
Label1: TLabel;
Label2: TLabel;
dtpBegin: TDateTimePicker;
dtpEnd: TDateTimePicker;
smTypeDocuments: TJvScrollMaxBand;
ckOrders: TCheckBox;
ckInvoice: TCheckBox;
ckAnnulOrders: TCheckBox;
ckPays: TCheckBox;
ckTours: TCheckBox;
ckSortDate: TCheckBox;
mnuDocumentsNM: TMenuItem;
mnuProgramParameters: TMenuItem;
ckUpdates: TCheckBox;
ckNews: TCheckBox;
Panel2: TPanel;
txtNews: TMemo;

procedure mnuDocumentsNMClick(Sender: TObject);
private

public
//Наборы данных подключения к серверу и пользовательских параметров
slServer : TStringList;
slUser : TStringList;
//Параметры удаленного сервера
sServerAddress : String;
sServerName : String;
sServerPort : String;
sServerGUID : String;
sInterceptGUID : String;
sServerBegin : String;
sServerEnd : String;
//Параметры ККМ
sKKMCode : String;
//Даты текущего периода
sBegin, sEnd : String;
//Параметры фильтрации документов
sOrders, sInvoice, sAnnulOrders, sTours, sPays, sDateSort, sDogTour, sZayavkaTour, sUpdates, sNews : String;
//Поток считывания версий системы
coRemoteKKMSettings : TRemoteKKMSettings;
//Параметры локального компьютера
sHost : String;
//Параметры пользователя
sUSER_ID : String;
sUSER_NICKNAME : String;
sUSER_PASSWORD : String;
sUSER_FULLNAME : String;
sUSER_FILIAL_ID : String;
sUSER_KKM_USE : String;
sUSER_IS_ADMIN : String;
sUSER_FILIAL_NAME : String;
sUSER_ROLE_ID : String;
sUSER_DOVERENNOST : String;
sUSER_TOURS : String;
sSESSION : String;
end;

function AddLog(sText:String):Longint;StdCall;external'events.dll';

var
frmMain: TfrmMain;

implementation

{$R *.dfm}

//******************************************************************************
procedure TfrmMain.mnuDocumentsNMClick(Sender: TObject);
var LibHandle : THandle;
ShowDocumentsNM : function (slServer,slUsers:TStringList):Integer;StdCall;
begin
LibHandle := LoadLibrary('iHercules.dll');
if LibHandle <> 0 then
begin
@ShowDocumentsNM := GetProcAddress(LibHandle,'ShowDocumentsNM');
ShowDocumentsNM(slServer,slUser);
end;
FreeLibrary(LibHandle);
end;
//******************************************************************************
end.

dll
library iHercules;

uses
ShareMem,
ActiveX,
Windows,
Messages,
SysUtils,
Variants,
Classes,
Graphics,
Controls,
Forms,
Dialogs,
ComCtrls,
Menus,
ADODB,
DB,
DBTables,
SConnect,
Sockets,
DBClient,
MConnect,
Registry,
DateUtils,
Math,
UfrmShowDocuments in 'UfrmShowDocuments.pas' {frmShowDocuments};

{$R *.res}

//******************************************************************************
function ShowDocumentsNM(slServer,slUsers:TStringList):Integer;StdCall;
var frmShowDocuments : TfrmShowDocuments;
begin
try
Application.CreateForm(TfrmShowDocuments,frmShowDocuments);
except
on E:Exception do ShowMessage(E.ClassName + ' ' + E.Message);
end;
end;
//******************************************************************************
exports
ShowDocumentsNM;
//******************************************************************************
begin
end.
//******************************************************************************

Сергей М. (2008-03-13 16:52:00) [16]
Тебе что, сложно выложить тестовыйпроект здесь?

Там всего-то два-три десятка строчек)

IntruderLab (2008-03-13 16:49:00) [17]
почту или аську мож дашь чтобы не светить - можешь прислать на intruderlab@mail.ru

IntruderLab (2008-03-13 16:48:00) [18]
После отлова exception вывалил debugger fault notification а перед этим висел :(

Сергей М. (2008-03-13 16:45:00) [19]

> что я не так делаю

Приводи уже полный текст тестового dll-проекта ..

IntruderLab (2008-03-13 16:44:00) [20]
никаких реакций, что я не так делаю :(

Страницы: 1 2 3 4 >

Наверх

	« предыдущая ветвь \| форум \| следующая ветвь »