主程序中参数传到bpl里面。
帮忙帮忙。
我先谢谢了。主程序unit Sys_main;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ActnPopup, ToolWin, ActnMan, ActnCtrls,
ActnList, XPStyleActnCtrls, StdStyleActnCtrls, ExtCtrls, jpeg, ImgList,
StdActns, ComCtrls;type
TSysMain = class(TForm)
Image1: TImage;
Image2: TImage;
ToolBar2: TToolBar;
ToolButton9: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
OpenDialog: TOpenDialog;
MainMenu1: TMainMenu;
File1: TMenuItem;
FileNewItem: TMenuItem;
FileOpenItem: TMenuItem;
FileCloseItem: TMenuItem;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
Edit1: TMenuItem;
CutItem: TMenuItem;
CopyItem: TMenuItem;
PasteItem: TMenuItem;
Window1: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowTileItem2: TMenuItem;
WindowMinimizeItem: TMenuItem;
WindowArrangeItem: TMenuItem;
Help1: TMenuItem;
HelpAboutItem: TMenuItem;
ActionList1: TActionList;
FileNew1: TAction;
FileOpen1: TAction;
FileClose1: TWindowClose;
FileSave1: TAction;
FileSaveAs1: TAction;
FileExit1: TAction;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
WindowCascade1: TWindowCascade;
WindowTileHorizontal1: TWindowTileHorizontal;
WindowTileVertical1: TWindowTileVertical;
WindowMinimizeAll1: TWindowMinimizeAll;
WindowArrangeAll1: TWindowArrange;
HelpAbout1: TAction;
ImageList1: TImageList;
Button1: TButton;
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
aform: TForm;
{ Private declarations }
public
FPackageHandle: Integer;
stest:string;
{ Public declarations }
end;var
SysMain: TSysMain;implementation
uses uPkgTls;
{$R *.dfm}procedure TSysMain.Button1Click(Sender: TObject);
begin
showmessage(upkgtls.ddd);
end;procedure TSysMain.FormCreate(Sender: TObject);
begin
// Application.CreateForm(TGlbData, GlbData);
end;procedure TSysMain.ToolButton1Click(Sender: TObject);
begin
UnloadAddins;
end;
procedure TSysMain.ToolButton9Click(Sender: TObject);
var AClass: TClass;
begin
LoadAddinPackage('xs1000i_getdata', '.\bin\xs_1000i.bpl');
CreateFormByClassName('TfrxsGetdata');
upkgtls.ddd:='sss';
stest:='asdf';
end;
end.
bpl 程序
我想在下面的bpl程序中接到主程序的参数不知道怎样做呢？unit xs1000i_GetData;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TfrxsGetdata = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
ss: string;
{ Public declarations }
end;var
frxsGetdata: TfrxsGetdata;implementation
uses upkgtls,sys_main;
{$R *.dfm}procedure TfrxsGetdata.Button1Click(Sender: TObject);
begin
edit1.Text:=sysmain.stest;
end;procedure TfrxsGetdata.Button2Click(Sender: TObject);
begin
edit1.Text:=upkgtls.ddd;
end;procedure TfrxsGetdata.Button3Click(Sender: TObject);
begin
edit1.Text:=ss;
end;procedure TfrxsGetdata.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// upkgtls.UnloadAddins;
end;initialization
registerclass(TfrxsGetdata);finalization
UnRegisterClass(TfrxsGetdata);end.
bpl程序
unit uPkgTls;interfaceuses
Windows, SysUtils, Classes, Forms, Controls, Db, DBTables;type
TCAR_Field = record
STKNO: String;
CARPH: String; // 匡拒ó贺虏絏
CARNAME: String; // 匡拒ó贺(いゅ)嘿
CARNAME_E: String; // 匡拒ó贺(璣ゅ)嘿
CARYEAR: String; //
CC: String; // CC 计
end;{ Package }
function GetAddinPackages: TStrings;
function LoadAddinPackage(const PackageID, FileName: string): HMODULE;
procedure UnloadAddinPackage(ModuleInstance: HMODULE); overload;
procedure UnloadAddinPackage(const PackageID: string); overload;
procedure UnloadAddins;{ Form }
function FindTable(const TableName: string): TTable;
procedure CreateDataModule(dm: TComponentClass; var dmVar);
function CreateDataModuleByClassName(const ClassName: string): TDataModule;
function CreateFormByClassName(const ClassName: string): TCustomForm;
function ShowModalFormByClassName(const ClassName: string): integer;var
COMPANY_NO: String;
AddinPackages: TStrings;
ddd:string;
const tests:string='test';
implementationresourcestring
sErrorCreateForm = 'Error Message';function FindTable(const TableName: string): TTable;
var i, j: Integer;
A: TDataModule;
begin
Result := nil;
for i := 0 to Application.ComponentCount -1 do
begin
if Application.Components[i] is TDataModule then
begin
A := Application.Components[i] as TDataModule;
for j := 0 to A.ComponentCount -1 do
begin
if A.Components[j].Name = TableName then
begin
Result := A.Components[j] as TTable;
Break;
end;
end;
Break;
end;
end;
end;procedure CreateDataModule(dm: TComponentClass; var dmVar);
begin
Application.CreateForm(dm, dmVar);
end;function CreateDataModuleByClassName(const ClassName: string): TDataModule;
var dmTemp: TDataModule;
AClass: TPersistentClass;
begin
Result := nil;
AClass := GetClass(ClassName);
if (AClass <> nil) then
begin
dmTemp := TComponentClass(AClass).Create(Application) as TDataModule;
// dmTemp.Name := 'DataModule1';
Result := dmTemp;
end;
end;function GetAddinPackages: TStrings;
begin
Result:= AddinPackages;
end;function LoadAddinPackage(const PackageID, FileName: string): HMODULE;
var
ModuleInstance: HMODULE;
begin
ModuleInstance := GetModuleHandle(PChar(ExtractFileName(FileName)));
if ModuleInstance = 0 then
begin
ModuleInstance := LoadPackage(FileName);
if AddinPackages.IndexOfObject(Pointer(ModuleInstance)) < 0 then
AddinPackages.AddObject(UpperCase(PackageID), Pointer(ModuleInstance));
end;
Result := ModuleInstance;
end;procedure UnloadAddInPackage(ModuleInstance: HMODULE);
var
i: Integer;
M: TMemoryBasicInformation;
begin
{ Make sure there aren't any instances of any of the classes from Module
instantiated, if so then free them. (this assumes that the classes are
owned by the application) }
for i := Application.ComponentCount - 1 downto 0 do
begin
VirtualQuery(GetClass(Application.Components[i].ClassName), M, SizeOf(M));
if (ModuleInstance = 0) or (HMODULE(M.AllocationBase) = ModuleInstance) then
Application.Components[i].Free;
end;
UnRegisterModuleClasses(ModuleInstance);
UnloadPackage(ModuleInstance);
end;procedure UnloadAddinPackage(const PackageID: string);
var
i: integer;
begin
i := AddinPackages.IndexOf(UpperCase(PackageID));
if i < 0 then
Exit; UnloadAddinPackage(HMODULE(AddinPackages.Objects[i])); { Maintain loaded package list }
AddinPackages.Delete(i);
end;procedure UnloadAddins;
var
i: integer;
begin
for i := 0 to AddinPackages.Count-1 do
UnloadAddinPackage(HMODULE(AddinPackages.Objects[i]));
AddinPackages.Clear;
end;function CreateFormByClassName(const ClassName: string): TCustomForm;
var
AClass: TPersistentClass;
begin
{ Note that TApplication "owns" this form and thus it must be freed prior
to unloading the package }
AClass := GetClass(ClassName);
if AClass <> nil then
Result := TComponentClass(AClass).Create(Application) as TCustomForm
else
raise Exception.CreateFmt(sErrorCreateForm, [ClassName]);
end;function ShowModalFormByClassName(const ClassName: string): integer;
var
frm: TCustomForm;
begin
frm := CreateFormByClassName(ClassName);
try
Result := frm.ShowModal;
finally
frm.Release;
end;
end;initialization
AddinPackages := TStringList.Create;finalization
AddinPackages.Free;end.
帮忙帮忙。
我先谢谢了。主程序unit Sys_main;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Menus, ActnPopup, ToolWin, ActnMan, ActnCtrls,
ActnList, XPStyleActnCtrls, StdStyleActnCtrls, ExtCtrls, jpeg, ImgList,
StdActns, ComCtrls;type
TSysMain = class(TForm)
Image1: TImage;
Image2: TImage;
ToolBar2: TToolBar;
ToolButton9: TToolButton;
ToolButton1: TToolButton;
ToolButton2: TToolButton;
ToolButton3: TToolButton;
ToolButton4: TToolButton;
ToolButton5: TToolButton;
ToolButton6: TToolButton;
ToolButton7: TToolButton;
ToolButton8: TToolButton;
ToolButton10: TToolButton;
ToolButton11: TToolButton;
OpenDialog: TOpenDialog;
MainMenu1: TMainMenu;
File1: TMenuItem;
FileNewItem: TMenuItem;
FileOpenItem: TMenuItem;
FileCloseItem: TMenuItem;
FileSaveItem: TMenuItem;
FileSaveAsItem: TMenuItem;
N1: TMenuItem;
FileExitItem: TMenuItem;
Edit1: TMenuItem;
CutItem: TMenuItem;
CopyItem: TMenuItem;
PasteItem: TMenuItem;
Window1: TMenuItem;
WindowCascadeItem: TMenuItem;
WindowTileItem: TMenuItem;
WindowTileItem2: TMenuItem;
WindowMinimizeItem: TMenuItem;
WindowArrangeItem: TMenuItem;
Help1: TMenuItem;
HelpAboutItem: TMenuItem;
ActionList1: TActionList;
FileNew1: TAction;
FileOpen1: TAction;
FileClose1: TWindowClose;
FileSave1: TAction;
FileSaveAs1: TAction;
FileExit1: TAction;
EditCut1: TEditCut;
EditCopy1: TEditCopy;
EditPaste1: TEditPaste;
WindowCascade1: TWindowCascade;
WindowTileHorizontal1: TWindowTileHorizontal;
WindowTileVertical1: TWindowTileVertical;
WindowMinimizeAll1: TWindowMinimizeAll;
WindowArrangeAll1: TWindowArrange;
HelpAbout1: TAction;
ImageList1: TImageList;
Button1: TButton;
procedure ToolButton9Click(Sender: TObject);
procedure ToolButton1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
aform: TForm;
{ Private declarations }
public
FPackageHandle: Integer;
stest:string;
{ Public declarations }
end;var
SysMain: TSysMain;implementation
uses uPkgTls;
{$R *.dfm}procedure TSysMain.Button1Click(Sender: TObject);
begin
showmessage(upkgtls.ddd);
end;procedure TSysMain.FormCreate(Sender: TObject);
begin
// Application.CreateForm(TGlbData, GlbData);
end;procedure TSysMain.ToolButton1Click(Sender: TObject);
begin
UnloadAddins;
end;
procedure TSysMain.ToolButton9Click(Sender: TObject);
var AClass: TClass;
begin
LoadAddinPackage('xs1000i_getdata', '.\bin\xs_1000i.bpl');
CreateFormByClassName('TfrxsGetdata');
upkgtls.ddd:='sss';
stest:='asdf';
end;
end.
bpl 程序
我想在下面的bpl程序中接到主程序的参数不知道怎样做呢？unit xs1000i_GetData;interfaceuses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;type
TfrxsGetdata = class(TForm)
Button1: TButton;
Edit1: TEdit;
Button2: TButton;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
private
{ Private declarations }
public
ss: string;
{ Public declarations }
end;var
frxsGetdata: TfrxsGetdata;implementation
uses upkgtls,sys_main;
{$R *.dfm}procedure TfrxsGetdata.Button1Click(Sender: TObject);
begin
edit1.Text:=sysmain.stest;
end;procedure TfrxsGetdata.Button2Click(Sender: TObject);
begin
edit1.Text:=upkgtls.ddd;
end;procedure TfrxsGetdata.Button3Click(Sender: TObject);
begin
edit1.Text:=ss;
end;procedure TfrxsGetdata.FormClose(Sender: TObject; var Action: TCloseAction);
begin
// upkgtls.UnloadAddins;
end;initialization
registerclass(TfrxsGetdata);finalization
UnRegisterClass(TfrxsGetdata);end.
bpl程序
unit uPkgTls;interfaceuses
Windows, SysUtils, Classes, Forms, Controls, Db, DBTables;type
TCAR_Field = record
STKNO: String;
CARPH: String; // 匡拒ó贺虏絏
CARNAME: String; // 匡拒ó贺(いゅ)嘿
CARNAME_E: String; // 匡拒ó贺(璣ゅ)嘿
CARYEAR: String; //
CC: String; // CC 计
end;{ Package }
function GetAddinPackages: TStrings;
function LoadAddinPackage(const PackageID, FileName: string): HMODULE;
procedure UnloadAddinPackage(ModuleInstance: HMODULE); overload;
procedure UnloadAddinPackage(const PackageID: string); overload;
procedure UnloadAddins;{ Form }
function FindTable(const TableName: string): TTable;
procedure CreateDataModule(dm: TComponentClass; var dmVar);
function CreateDataModuleByClassName(const ClassName: string): TDataModule;
function CreateFormByClassName(const ClassName: string): TCustomForm;
function ShowModalFormByClassName(const ClassName: string): integer;var
COMPANY_NO: String;
AddinPackages: TStrings;
ddd:string;
const tests:string='test';
implementationresourcestring
sErrorCreateForm = 'Error Message';function FindTable(const TableName: string): TTable;
var i, j: Integer;
A: TDataModule;
begin
Result := nil;
for i := 0 to Application.ComponentCount -1 do
begin
if Application.Components[i] is TDataModule then
begin
A := Application.Components[i] as TDataModule;
for j := 0 to A.ComponentCount -1 do
begin
if A.Components[j].Name = TableName then
begin
Result := A.Components[j] as TTable;
Break;
end;
end;
Break;
end;
end;
end;procedure CreateDataModule(dm: TComponentClass; var dmVar);
begin
Application.CreateForm(dm, dmVar);
end;function CreateDataModuleByClassName(const ClassName: string): TDataModule;
var dmTemp: TDataModule;
AClass: TPersistentClass;
begin
Result := nil;
AClass := GetClass(ClassName);
if (AClass <> nil) then
begin
dmTemp := TComponentClass(AClass).Create(Application) as TDataModule;
// dmTemp.Name := 'DataModule1';
Result := dmTemp;
end;
end;function GetAddinPackages: TStrings;
begin
Result:= AddinPackages;
end;function LoadAddinPackage(const PackageID, FileName: string): HMODULE;
var
ModuleInstance: HMODULE;
begin
ModuleInstance := GetModuleHandle(PChar(ExtractFileName(FileName)));
if ModuleInstance = 0 then
begin
ModuleInstance := LoadPackage(FileName);
if AddinPackages.IndexOfObject(Pointer(ModuleInstance)) < 0 then
AddinPackages.AddObject(UpperCase(PackageID), Pointer(ModuleInstance));
end;
Result := ModuleInstance;
end;procedure UnloadAddInPackage(ModuleInstance: HMODULE);
var
i: Integer;
M: TMemoryBasicInformation;
begin
{ Make sure there aren't any instances of any of the classes from Module
instantiated, if so then free them. (this assumes that the classes are
owned by the application) }
for i := Application.ComponentCount - 1 downto 0 do
begin
VirtualQuery(GetClass(Application.Components[i].ClassName), M, SizeOf(M));
if (ModuleInstance = 0) or (HMODULE(M.AllocationBase) = ModuleInstance) then
Application.Components[i].Free;
end;
UnRegisterModuleClasses(ModuleInstance);
UnloadPackage(ModuleInstance);
end;procedure UnloadAddinPackage(const PackageID: string);
var
i: integer;
begin
i := AddinPackages.IndexOf(UpperCase(PackageID));
if i < 0 then
Exit; UnloadAddinPackage(HMODULE(AddinPackages.Objects[i])); { Maintain loaded package list }
AddinPackages.Delete(i);
end;procedure UnloadAddins;
var
i: integer;
begin
for i := 0 to AddinPackages.Count-1 do
UnloadAddinPackage(HMODULE(AddinPackages.Objects[i]));
AddinPackages.Clear;
end;function CreateFormByClassName(const ClassName: string): TCustomForm;
var
AClass: TPersistentClass;
begin
{ Note that TApplication "owns" this form and thus it must be freed prior
to unloading the package }
AClass := GetClass(ClassName);
if AClass <> nil then
Result := TComponentClass(AClass).Create(Application) as TCustomForm
else
raise Exception.CreateFmt(sErrorCreateForm, [ClassName]);
end;function ShowModalFormByClassName(const ClassName: string): integer;
var
frm: TCustomForm;
begin
frm := CreateFormByClassName(ClassName);
try
Result := frm.ShowModal;
finally
frm.Release;
end;
end;initialization
AddinPackages := TStringList.Create;finalization
AddinPackages.Free;end.
解决方案 »
- 初学delphi 遇到pascal语言的时候很难理解。
- 请问：Delphi有这样的功能吗？ 我们在按断点 F7一步步运行程序的时候...
- 怎么样实现：按Enter键跳到下一控件，但又不能让它自动跳到 Button 等不可接收输入的控件上去。
- 谁有我晚，啊……哈…哈哈~~~~~
- 我爆笑1
- 夫妻夜话（古龙篇）---献给程序届劳累过度的各位友人
- 丢了一个关于键盘的源程序，现在求救！谢谢帮助
- 在哪里能找到directsound.dcu(.pas)
- 我的东方影都--立体版，在win2000下播放时会蓝屏，解霸也偶尔会出现，为什么会出现这种问题？是不是win2000的bug?怎样解决呢？
- 关于 ReportSmith
- 纳闷.除数可以是0的变量标识符?
- SQL语句问题
能行的话bpl中也把参数传递给主程序里面。我做的这个程序打开bpl窗体后把值传过去，但是在bpl子窗体中点击查看时候是空的，没有值。
不知道在那里写错。请大虾指点。
exe 加载 这个 共享BPL包 数据
BPL 也加载这个 共享包数据 就可以 DELPHI 也是通过这样实现BPL之间的共享的
BPL --- OPTIONS ---- BUILE WITH RUNTIME PACKAGES 加载共享包进去