从数据库中动态创建窗体 ( 积分: 200 )

  • 主题发起人 主题发起人 gerp
  • 开始时间 开始时间
G

gerp

Unregistered / Unconfirmed
GUEST, unregistred user!
要求:
1 让用户自主创建窗体的属性,保存到数据库中
2 从数据库中动态创建窗体
 
这个不难,只不过写语句有点烦,我写过一些修改介面的东西,从INI文件中取控件的属性,然后修改程序界面。只不过我这里的没生成控件的语句,但是方法是一样的,你可以参考一下。
---------------------------
unit uLanguage;

interface

uses
{Windows, Messages,} SysUtils, {Variants,} Classes, {Graphics, Controls,} Forms,
{Dialogs, }StdCtrls, IniFiles, Menus, Buttons, ComCtrls, ExtCtrls, DBGrids;

function SetLanguagePack(Sender:Tobject;FileName:string;SectionName:string;bReadPack:boolean):integer;overload;
function SetLanguagePack(Sender:Tobject;FileName:string;SectionName:string):integer;overload;
function SetLanguagePack(Sender:Tobject;FileName:string):integer;overload;

implementation

function SetLanguagePack(Sender:Tobject;FileName:string;SectionName:string):integer;overload;
var
bReadPack:boolean;
begin
bReadPack:=FileExists(FileName);
SetLanguagePack(Sender,FileName,SectionName,bReadPack );
end;
function SetLanguagePack(Sender:Tobject;FileName:string;SectionName:string;bReadPack:boolean):integer;overload;
var
iIndex,i,j,iComponentCount:integer;
ComponentObject:TComponent;
iniFile:TiniFile;

lsObjList,lsComponentName:Tstrings;
sText:string;
begin


iniFile := TiniFile.Create(FileName);
lsObjList:=TstringList.Create;
lsComponentName:=TstringList.Create;
try


if bReadPack then
begin //读取语言包
inifile.ReadSection(SectionName,lsObjList);
iComponentCount:=lsObjList.Count;
end else
begin //生成语言包
iComponentCount:=(Sender as Tcomponent).ComponentCount ;
end;

for i:=0 to iComponentCount -1 do
begin
try
ComponentObject:=nil;

//取控件
if bReadPack then
begin
//分解字符串
lsComponentName.Clear;
ExtractStrings(['/'],[],PAnsiChar(lsObjList),lsComponentName);
//查找控件
ComponentObject:=(Sender as Tcomponent)
.FindComponent(lsComponentName[0]);
end else
begin
ComponentObject:= (Sender as Tcomponent).Components;
end;


if assigned(ComponentObject) then
begin //设置控件、读取控件设置

//
if bReadPack then
sText:=iniFile.ReadString(SectionName,lsObjList,'')
else sText:='write';

if sText <>'' then
begin
if ComponentObject is TLabel then
with ComponentObject as TLabel do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TCheckBox then
with ComponentObject as TCheckBox do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TGroupBox then
with ComponentObject as TGroupBox do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TButton then
with ComponentObject as TButton do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TMenuItem then
with ComponentObject as TMenuItem do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TBitBtn then
with ComponentObject as TBitBtn do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TForm then
with ComponentObject as TForm do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
//if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
//if Hint <> '' then
// iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TTabSheet then
with ComponentObject as TTabSheet do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TStatusBar then
with ComponentObject as TStatusBar do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Panels' then
begin
iIndex := strtoint(lsComponentName[2]);
Panels[iIndex].text := sText;
end;
end else
begin
for j:=0 to Panels.Count -1 do
begin
if Panels[iIndex].text <>'' then
iniFile.WriteString(SectionName,Name
+'/Panels/' +inttostr(j)+'/text'
, Panels[j].text);

end;
end;
end
else
if ComponentObject is TListView then
with ComponentObject as TListView do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Columns' then
begin
iIndex := strtoint(lsComponentName[2]);
if lsComponentName[3] = 'Caption' then
Columns[iIndex].Caption := sText;
end;
end else
begin
for j:=0 to Columns.Count -1 do
begin
if Columns[j].Caption <>'' then
iniFile.WriteString(SectionName,Name+'/Columns/'
+inttostr(j)+'/Caption'
, Columns[j].Caption);

end;
end;
end
else
{if ComponentObject is TTBSubmenuItem then
with ComponentObject as TTBSubmenuItem do
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end
else }
if ComponentObject is TRadioButton then
with ComponentObject as TRadioButton do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TRadioGroup then
with ComponentObject as TRadioGroup do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TPanel then
with ComponentObject as TPanel do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TBevel then
with ComponentObject as TBevel do
begin
if bReadPack then
begin
//if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
//if Caption <> '' then
// iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TTabControl then
with ComponentObject as TTabControl do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Tabs' then
begin
iIndex := strtoint(lsComponentName[2]);
Tabs[iIndex] := sText;
end;
end else
begin
for j:=0 to Tabs.Count -1 do
begin
if Tabs[j] <>'' then
iniFile.WriteString(SectionName,Name+'/Tabs/' +inttostr(j), Tabs[j]);

end;
end;

end
else
if ComponentObject is TTabSheet then
with ComponentObject as TTabSheet do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TToolButton then
with ComponentObject as TToolButton do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end else
begin
if Caption <> '' then
iniFile.WriteString(SectionName,Name+'/Caption',Caption);
if Hint <> '' then
iniFile.WriteString(SectionName,Name+'/Hint',Hint);
end;
end
else
if ComponentObject is TDBGrid then
with ComponentObject as TDBGrid do
begin
if bReadPack then
begin
if lsComponentName[1] = 'Columns' then
begin
iIndex := strtoint(lsComponentName[2]);

while iIndex >= Columns.Count do
begin
with Columns.Add do
begin
end;
end;

if lsComponentName[3] = 'FieldName' then
begin
Columns[iIndex].FieldName :=sText;
end else

if lsComponentName[3] = 'Expanded' then
begin
if sText <> '0' then
Columns[iIndex].Expanded :=true;
end else

if lsComponentName[3] = 'Visible' then
begin
if sText <> '0' then
Columns[iIndex].Visible :=true;
end else

if lsComponentName[3] = 'Title' then
begin
if lsComponentName[4] = 'Caption' then
Columns[iIndex].Title.Caption:= sText;
end;
end;
end else
begin
for j:=0 to Columns.Count -1 do
begin
if Columns[j].FieldName <>'' then
iniFile.WriteString(SectionName,Name+'/Columns/' +inttostr(j)+ '/FieldName'
,Columns[j].FieldName);

if Columns[j].Expanded then
iniFile.WriteString(SectionName,Name+'/Columns/' +inttostr(j)+ '/Expanded'
,'1');

if not Columns[j].Visible then
iniFile.WriteString(SectionName,Name+'/Columns/' +inttostr(j)+ '/Visible'
,'0');

if Columns[j].Title.Caption <>'' then
iniFile.WriteString(SectionName,Name+'/Columns/' +inttostr(j)+ '/Title/Caption'
,Columns[j].Title.Caption);

end;

end;
end
{else
if ComponentObject is TCheckBox then
with ComponentObject as TCheckBox do
begin
if lsComponentName[1] = 'Caption' then Caption:= sText;
if lsComponentName[1] = 'Hint' then Hint := sText;
end}

else
begin

end;

end; //if sText <>''
end; //if assigned(Compo]

except

end; //end try
end;//for i

finally
iniFile.Free;
lsObjList.Free;
lsComponentName.Free;
end; //end try
end;
function SetLanguagePack(Sender:Tobject;FileName:string):integer;overload
begin
SetLanguagePack(Sender,FileName,sender.ClassName );
end;
end.
 
to:qqjm
老兄!需要用那么长的代码么!
如果楼住知识想保存窗体的属性,最好用INI!
方便!
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
751
SUNSTONE的Delphi笔记
S
后退
顶部