|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
Двусторонний обмен данными с MDIChild Dll
Ребята, делфи пользуюсь давно, но как продвинутый пользователь. Недавно столкнулся с задачей сделать MDI DLL, программа была написана без модулей.. Скачал в интернете пример MDI DLL окна, прочитал данную тему, но ничего толком не понял в каком месте объявлять переменные, чтобы они были доступны двусторонне.. Стоит задача передать переменные из главной формы, чтобы изменить их и уже при закрытии MDI формы изменённые значения использовать в главной форме, помогите пожалуйста! Чувствую, моиз знаний недостаточно для этого, нервничать уже начал (
Если кому не сложно - измените пример по ссылке, пожалуйста! Нужно передать и принять в главной форме несколько переменных. Огромное спасибо заранее тому, кто поможет! Вот здесь скачал пример MDI DLL |
#2
|
|||
|
|||
или лучше использовать bpl пакет? кто-нибудь имеет в наличии рабочий пример?
|
#3
|
|||
|
|||
нашёл пример bpl, решил его использовать
http://www.delphikingdom.com/asp/vie...?catalogid=274 адаптирую свой старый юнит с формой, но вылетает ошибка: Method 'Exporter Name' not found in base class.. Где ошибка? Код:
unit FieldEdit; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DataModule; type TFieldEditForm = class(TForm) FieldEdit: TEdit; Label3: TLabel; AddButton: TButton; CancelButton: TButton; EditButton: TButton; procedure AddButtonClick(Sender: TObject); procedure CancelButtonClick(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private public class function ExporterName: string; override; end; var FieldEditForm: TFieldEditForm; InputFieldKey, InputFieldName, OutputFieldKey, OutputFieldName:string; implementation uses UClassManager; {$R *.dfm} class function TFieldEditForm.ExporterName: string; begin Result := 'Редактирование месторождения'; end; procedure TFieldEditForm.AddButtonClick(Sender: TObject); begin end; procedure TFieldEditForm.FormShow(Sender: TObject); end; procedure TFieldEditForm.FormClose(Sender: TObject; var Action: TCloseAction); begin end; { ============================================= } initialization { ============================================= } ClassManager.Add(TFieldEditForm); { ============================================= } finalization { ============================================= } ClassManager.Remove(TFieldEditForm); end. Код:
{ ============================================= } unit UClassManager; { ============================================= } { ============================================= } interface { ============================================= } uses Classes; type TClassManager = class(TList); function ClassManager: TClassManager; { ============================================= } implementation { ============================================= } var Manager: TClassManager; function ClassManager: TClassManager; begin Result := Manager; end; { ============================================= } initialization { ============================================= } Manager := TClassManager.Create; { ============================================= } finalization { ============================================= } Manager.Free; end{ ========================================== }. Последний раз редактировалось sorockinalex, 17.08.2012 в 21:12. |
#4
|
|||
|
|||
понял в чём дело..
другой пакет использует того же наследника класса... но при попытке добавить в секцию requires ту же DCU, содержащую описания этих классов возникает ошибка "Another File with the same nase name is already on the search path" Как избежать дублирования? Иначе пакет в исполняемом файле отказывается загружатся с ошибкой: "Cannot load the package. It contains unit which is also contained in package..." Короче, он не может загрузить пакет, так как он содержит юнит, который уже загружен в другом пакете... Помогите пожалуйста, друзья! |
#5
|
|||
|
|||
блин, вот я туплю... разобрался... удалил путь поиска в Delphi\Projects\BPL )))
|
#6
|
||||
|
||||
театр одного актера
Понять, что хочет заказчик - бесценно, ведь он платит MasterCard |
#7
|
|||
|
|||
ребята, помогите, пожалуйста! не силён в этом, простите уж.. мучаюсь, мучаюсь, никак не разберусь... как заставить форму мою FieldEditForm открываться при нажатии кнопки FieldEditForm на главной формею.. Никак не пойму устройство классов в примере...
http://zalil.ru/33688750 |
#8
|
|||
|
|||
Пожалуйста, прошу помощи! Сегодня опять взялся за код, ничего не вышло
|
#9
|
|||
|
|||
Ребята, нашёл другой пример, сделал небольшой шаблон. bpl форма грузится из главного окна, но при выполнении действия после нажатия кнопки вылетает ошибка: Access Violation.
Дело в том, что в bpl я использую модуль DataModule, на котором стоит ADOQuery. И по нажатии на кнопку OK должен происходить запрос, а при попытке обращения к нему и вылезает ошибка. DataModule включил в uses... Не пойму в чём дело... Яндекс не помог (( Код:
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls, DM; type //signature of the "ExecuteChild" procedure from the Package TExecuteChild = procedure; TMainForm = class(TForm) MainMenu: TMainMenu; mnuStructure: TMenuItem; mnuStructureEdit: TMenuItem; mnuStructureView: TMenuItem; Timer1: TTimer; procedure FormDestroy(Sender: TObject); procedure mnuStructureEditClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); private LoginPackage : HModule; ExecuteChild : TExecuteChild; procedure LoginPackageLoad; public { Public declarations } end; var MainForm: TMainForm; implementation //uses DM; {$R *.dfm} procedure TMainForm.LoginPackageLoad; begin //try loading the package (let's say it's in the same folder, where the main app. exe is) LoginPackage := LoadPackage('login_.bpl'); //if loaded, try locating the ExecuteChild procedure if LoginPackage <> 0 then try @ExecuteChild := GetProcAddress(LoginPackage,'ExecuteChild'); except //display an error message if we fail ShowMessage ('Íå íàéäåí login.bpl'); end; if Assigned(ExecuteChild) then ExecuteChild; end; procedure TMainForm.mnuStructureEditClick(Sender: TObject); begin //lazzy load package // if StructureEditModule = 0 then PackageLoad; //if the ExecuteChild procedure was found in the package, call it if Assigned(ExecuteChild) then ExecuteChild; end; procedure TMainForm.FormDestroy(Sender: TObject); begin // if the package was loaded, make sure to free the resources // if StructureEditModule <> 0 then UnloadPackage(StructureEditModule); end; procedure TMainForm.FormCreate(Sender: TObject); begin MainForm.Width:=Screen.WorkAreaWidth; MainForm.Height:=Screen.WorkAreaHeight; MainForm.Left:=0; MainForm.Top:=0; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin { If Logon_Key<>0 then begin LoginForm.ADODataSet.CommandText:= 'SELECT * FROM LogonLogoff WHERE Key='+inttostr(Logon_Key); LoginForm.ADODataSet.Active:=true; LoginForm.ADODataSet.Edit; LoginForm.ADODataset['LogoffTime']:= Date+Time; LoginForm.ADODataSet.UpdateBatch; LoginForm.ADODataSet.Close; LoginForm.ADODataSet.Active:=false; Application.Terminate; end;} end; procedure TMainForm.FormShow(Sender: TObject); begin if (Employee_Key=0) or (Employee_Id=0) or (Employee_Pass='') or (Logon_Key=0) then LoginPackageLoad end; procedure TMainForm.Timer1Timer(Sender: TObject); begin MainForm.Caption:='TPMDocs - ['+inttostr(Employee_Id)+' '+Employee_Name1+' '+Employee_Name2+' '+Employee_Name3+']'; end; end. Код:
unit login; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBClient, Provider, ADODB, DM; type TLoginForm = class(TForm) Edit_EmployeeId: TEdit; Edit_EmployeePass: TEdit; Label_EmployeeId: TLabel; Label_EmployeePass: TLabel; Btn_OK: TButton; Btn_Close: TButton; procedure Btn_OKClick(Sender: TObject); procedure Btn_CloseClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public end; procedure ExecuteChild; { Public declarations } //var // LoginForm: TLoginForm; implementation //uses DM; {$R *.dfm} procedure TLoginForm.Btn_OKClick(Sender: TObject); var EmployeeId_Temp : PChar; EmployeePass_Temp : String; n:Cardinal; MessageText, MessageCaption:string; begin if (Edit_EmployeeId.Text<>'') and (Edit_EmployeePass.Text<>'') then begin EmployeeId_Temp:=PChar(Edit_EmployeeId.Text); EmployeePass_Temp:=Edit_EmployeePass.Text; DM1.Query.SQL.Clear; DM1.Query.SQL.Add('SELECT Key, Id, Pass, Name1, Name2, Name3'); DM1.Query.SQL.Add('FROM Employees'); DM1.Query.SQL.Add('WHERE (Id='+EmployeeId_Temp+') AND (Employees.Pass="'+EmployeePass_Temp+'")'); DM1.Query.Active:=True; DM1.Query.Open; n:=DM1.Query.RecordCount; //Åñëè íàéäåíî åäèíñòâåííîå ñîâïàäåíèå ëîãèíà è ïàðîëÿ If n=1 then begin //Ñîõðàíÿåì ãëîáàëüíûå ïåðåìåííûå ïîëüçîâàòåëÿ: êëþ÷ êîëüçîâàòåëÿ, òàáåëüíûé, ïàðîëü Employee_Key:=DM1.Query['Key']; Employee_Id:=DM1.Query['Id']; Employee_Pass:=DM1.Query['Pass']; Employee_Name1:=DM1.Query['Name1']; Employee_Name2:=DM1.Query['Name2']; Employee_Name3:=DM1.Query['Name3']; DM1.Query.Close; DM1.Query.Active:=False; DM1.Query.Free; //Äîáàâëÿåì çàïèñü â òàáëèöó ëîãèíîâ DM1.DataSet.CommandText:= 'SELECT * FROM LogonLogoff'; DM1.DataSet.Active:=true; DM1.DataSet.Insert; DM1.Dataset['EmployeeKey']:= Employee_Key; DM1.Dataset['LogonTime']:= Date+Time; DM1.DataSet.UpdateBatch; Logon_Key:=DM1.Dataset['Key']; DM1.DataSet.Close; DM1.DataSet.Active:=false; // LoginForm.Close; end //Åñëè íàéäåíî áîëåå îäíîãî ñîâïàäåíèÿ ëîãèíà è ïàðîëÿ Else If n>1 then begin MessageText:='Ñ âàøèì òàáåëüíûì íîìåðîì íàéäåíî áîëåå îäíîãî ïîëüçîâàòåëÿ â áàçå äàííûõ!'+ #13#10+'Îáðàòèòåñü ê ñèñòåìíîìó àäìèíèñòðàòîðó.'; MessageCaption:='Äóáëèðîâàííûå çàïèñè â áàçå äàííûõ' end else begin MessageText:='Íåâåðíûé ïàðîëü!'+ #13#10+'Îáðàòèòåñü ê ñèñòåìíîìó àäìèíèñòðàòîðó çà íîâûì ïàðîëåì.'; MessageCaption:='Íåâåðíûé ïàðîëü' end; //Ïîêàçûâàåì èíôîðìàöèîííîå îêíî ïðè íåóäà÷íîì ëîãèíå If (MessageText<>'') and (MessageCaption<>'') then MessageBox(Application.Handle,PChar(MessageText),PChar(MessageCaption), MB_OK); end; end; procedure TLoginForm.Btn_CloseClick(Sender: TObject); begin //LoginForm.Close; end; procedure TLoginForm.FormClose(Sender: TObject; var Action: TCloseAction); begin //since this is an MDI child, make sure it gets closed when the user clicks the x button. Action := caFree; end; procedure ExecuteChild; begin TLoginForm.Create(Application); end; exports //NOTE!! The export name is CASE SENSITIVE ExecuteChild; end. Код:
unit DM; interface uses SysUtils, Classes, DB, ADODB; type TDM1 = class(TDataModule) Query: TADOQuery; DataSet: TADODataSet; procedure DataModuleCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var DM1: TDM1; //Ãëîáàëüíûå ïåðåìåííûå äëÿ ëîãèíà ïîëüçîâàòåëÿ Employee_Key:Cardinal; Employee_Id:Cardinal; Employee_Pass, Employee_Name1, Employee_Name2, Employee_Name3:string; Logon_Key:Cardinal; implementation {$R *.dfm} Procedure ScanDir(StartDir,Mask: String; List: TStrings); Var SearchRec: TSearchRec; begin IF Mask=''then Mask:='*.*'; IF StartDir[Length(StartDir)]<>'\'then StartDir := StartDir + '\'; // Ñíà÷àëà íàõîäèì è ïå÷àòàåì âñå ôàéëû èç // ãëàâíîé ïàïêè ïî ìàñêå Mask List.Add(StartDir); IF FindFirst(StartDir+Mask,faAnyFile,SearchRec)=0 then Repeat IF(SearchRec.Attr and faDirectory)<>faDirectory then List.Add(StartDir+SearchRec.Name); Until FindNext(SearchRec)<>0; // Òåïåðü íàõîäèì âñå ïîäïàïêè è ïðîäîëæàåì â íèõ ïîèñê IF FindFirst(StartDir+'*.*',faAnyFile,SearchRec)=0 then Repeat IF((SearchRec.Attr and faDirectory)=faDirectory)and ((SearchRec.Name<>'..')and(SearchRec.Name <> '.'))then ScanDir(StartDir+SearchRec.Name+'\',Mask,List); Until FindNext(SearchRec)<>0; FindClose(SearchRec); end; procedure TDM1.DataModuleCreate(Sender: TObject); var path:string; begin path:=ExtractFilePath(ParamStr(0))+'db.mdb'; DM1.Query.ConnectionString:='Provider=Microsoft.Jet.OLEDB.4.0;Data Source='+path+';Persist Security Info=False;'; end; end. |
#10
|
||||
|
||||
Цитата:
А в том коде что ты привёл не поймёшь где возникает ошибка. А вообще мне не нравится вот эта строка: Код:
EmployeeId_Temp:=PChar(Edit_EmployeeId.Text); Последний раз редактировалось poli-smen, 21.08.2012 в 16:50. |
#11
|
|||
|
|||
Цитата:
|
#12
|
|||
|
|||
Цитата:
Цитата:
Убрал PChar, всё равно также... Насчёт "продвинутости" у меня своя лесенка: чайник - HelloWorld, продвинутый профи - чьё призвание в программировании |
#13
|
||||
|
||||
Цитата:
Но в твоём случае ошибка возникает внутри bpl. Тут сложнее. Во-первых нужно узнать с какого адреса загрузилась bpl-ка, а во-вторых откомпилировать её с включённой генерацией Map-файла: "Options" -> "Linker" -> "Map file" -> "Detailed" Или прикрепи исходники проекта, я дома посмотрю. Цитата:
|
Этот пользователь сказал Спасибо poli-smen за это полезное сообщение: | ||
sorockinalex (26.08.2012)
|
#14
|
|||
|
|||
Последний раз редактировалось sorockinalex, 26.08.2012 в 23:57. |
#15
|
|||
|
|||
сделал, работают функции:
Код:
unit Main; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls, DM; type //signature of the "ExecuteChild" procedure from the Package TExecuteChild = procedure; TFamilyName = function:string; TPluginName = function:string; TVersionNumber = function:cardinal; TMainForm = class(TForm) MainMenu: TMainMenu; mnuStructure: TMenuItem; mnuStructureEdit: TMenuItem; mnuStructureView: TMenuItem; Timer1: TTimer; procedure FormDestroy(Sender: TObject); procedure mnuStructureEditClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure Timer1Timer(Sender: TObject); procedure FormShow(Sender: TObject); private LoginPackage : HModule; ExecuteChild : TExecuteChild; FamilyName : TFamilyName; PluginName : TPluginName; VersionNumber : TVersionNumber; procedure LoginPackageLoad; public { Public declarations } end; var MainForm: TMainForm; implementation //uses DM; {$R *.dfm} procedure TMainForm.LoginPackageLoad; begin //try loading the package (let's say it's in the same folder, where the main app. exe is) LoginPackage := LoadPackage('login_.bpl'); //if loaded, try locating the ExecuteChild procedure if LoginPackage <> 0 then try @FamilyName := GetProcAddress(LoginPackage,'FamilyName'); @PluginName := GetProcAddress(LoginPackage,'PluginName'); @VersionNumber := GetProcAddress(LoginPackage,'VersionNumber'); @ExecuteChild := GetProcAddress(LoginPackage,'ExecuteChild'); except //display an error message if we fail ShowMessage ('Не найден login_.bpl'); end; if Assigned(ExecuteChild) then ExecuteChild; if Assigned(FamilyName) then showmessage(FamilyName); if Assigned(PluginName) then showmessage(PluginName); if Assigned(VersionNumber) then showmessage(VersionNumber); end; procedure TMainForm.mnuStructureEditClick(Sender: TObject); begin //lazzy load package // if StructureEditModule = 0 then PackageLoad; //if the ExecuteChild procedure was found in the package, call it if Assigned(ExecuteChild) then ExecuteChild; end; procedure TMainForm.FormDestroy(Sender: TObject); begin // if the package was loaded, make sure to free the resources if LoginPackage <> 0 then UnloadPackage(LoginPackage); end; procedure TMainForm.FormCreate(Sender: TObject); begin MainForm.Width:=Screen.WorkAreaWidth; MainForm.Height:=Screen.WorkAreaHeight; MainForm.Left:=0; MainForm.Top:=0; end; procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction); begin If Logon_Key<>0 then begin DM1.DataSet.CommandText:= 'SELECT * FROM LogonLogoff WHERE Key='+inttostr(Logon_Key); DM1.DataSet.Active:=true; DM1.DataSet.Edit; DM1.Dataset['LogoffTime']:= Date+Time; DM1.DataSet.UpdateBatch; DM1.DataSet.Close; DM1.DataSet.Active:=false; Application.Terminate; end; end; procedure TMainForm.Timer1Timer(Sender: TObject); begin if Employee_Id<>0 then showmessage('TPMDocs - ['+inttostr(Employee_Id)+' '+Employee_Name1+' '+Employee_Name2+' '+Employee_Name3+']'); end; procedure TMainForm.FormShow(Sender: TObject); begin if (Employee_Key=0) or (Employee_Id=0) or (Employee_Pass='') or (Logon_Key=0) then LoginPackageLoad; end; end. Код:
unit login; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, DB, DBClient, Provider, ADODB, DM; type TLoginForm = class(TForm) Edit_EmployeeId: TEdit; Edit_EmployeePass: TEdit; Label_EmployeeId: TLabel; Label_EmployeePass: TLabel; Btn_OK: TButton; Btn_Close: TButton; procedure Btn_OKClick(Sender: TObject); procedure Btn_CloseClick(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); private { Private declarations } public end; procedure ExecuteChild; function FamilyName: string; function PluginName: string; function VersionNumber: cardinal; //var // LoginForm: TLoginForm; implementation {$R *.dfm} procedure TLoginForm.Btn_OKClick(Sender: TObject); var EmployeeId_Temp : string; EmployeePass_Temp : String; n:Cardinal; MessageText, MessageCaption:string; begin if (Edit_EmployeeId.Text<>'') and (Edit_EmployeePass.Text<>'') then begin EmployeeId_Temp:=Edit_EmployeeId.Text; EmployeePass_Temp:=Edit_EmployeePass.Text; if (DM1.Query.Prepared) then showmessage('1') else showmessage('2'); DM1.Query.SQL.Clear; DM1.Query.SQL.Add('SELECT Key, Id, Pass, Name1, Name2, Name3'); DM1.Query.SQL.Add('FROM Employees'); DM1.Query.SQL.Add('WHERE (Id='+EmployeeId_Temp+') AND (Employees.Pass="'+EmployeePass_Temp+'")'); DM1.Query.Active:=True; DM1.Query.Open; n:=DM1.Query.RecordCount; //Если найдено единственное совпадение логина и пароля If n=1 then begin //Сохраняем глобальные переменные пользователя: ключ кользователя, табельный, пароль Employee_Key:=DM1.Query['Key']; Employee_Id:=DM1.Query['Id']; Employee_Pass:=DM1.Query['Pass']; Employee_Name1:=DM1.Query['Name1']; Employee_Name2:=DM1.Query['Name2']; Employee_Name3:=DM1.Query['Name3']; DM1.Query.Close; DM1.Query.Active:=False; DM1.Query.Free; //Добавляем запись в таблицу логинов DM1.DataSet.CommandText:= 'SELECT * FROM LogonLogoff'; DM1.DataSet.Active:=true; DM1.DataSet.Insert; DM1.Dataset['EmployeeKey']:= Employee_Key; DM1.Dataset['LogonTime']:= Date+Time; DM1.DataSet.UpdateBatch; Logon_Key:=DM1.Dataset['Key']; DM1.DataSet.Close; DM1.DataSet.Active:=false; Self.Close; end //Если найдено более одного совпадения логина и пароля Else If n>1 then begin MessageText:='С вашим табельным номером найдено более одного пользователя в базе данных!'+ #13#10+'Обратитесь к системному администратору.'; MessageCaption:='Дублированные записи в базе данных' end else begin MessageText:='Неверный пароль!'+ #13#10+'Обратитесь к системному администратору за новым паролем.'; MessageCaption:='Неверный пароль' end; //Показываем информационное окно при неудачном логине If (MessageText<>'') and (MessageCaption<>'') then MessageBox(Application.Handle,PChar(MessageText),PChar(MessageCaption), MB_OK); end; end; procedure TLoginForm.Btn_CloseClick(Sender: TObject); begin Self.Close; end; procedure TLoginForm.FormClose(Sender: TObject; var Action: TCloseAction); begin //since this is an MDI child, make sure it gets closed when the user clicks the x button. Action := caFree; end; function FamilyName: string; begin Result := 'TPMDocs'; end; function PluginName: string; begin Result := 'Login'; end; function VersionNumber: cardinal; begin Result := 1; end; procedure ExecuteChild; var LoginForm:TLoginForm; begin LoginForm := TLoginForm.Create(Application); Loginform.Hide; LoginForm.Showmodal; end; exports //NOTE!! The export name is CASE SENSITIVE ExecuteChild, FamilyName, PluginName, VersionNumber; end. Последний раз редактировалось sorockinalex, 26.08.2012 в 23:58. |