动态创建窗体问题!(50分)

  • 主题发起人 主题发起人 自我教育
  • 开始时间 开始时间

自我教育

Unregistered / Unconfirmed
GUEST, unregistred user!
错误提示:List index out of bounds(1)
如何解决?!请明示!
 
这个不是动态窗体的问题!而是其中控件的问题
 
肯定是你越界访问,把你的Source Code 贴出来让大家瞧瞧
 
越界访问?什么意思
 
你把源码贴出来大家看看就明白了
 
比如你的程序中
有个ListBox,Items有5个,Items[0..4]
但你访问了ListBox.Items[5]就会出现你那错误了
 
public
{ Public declarations }
strTableName:string;
strSeriesName,strSpecialityName:string;
end;

var
TfrmPrejLogin: TTfrmPrejLogin;

implementation
uses frmPrejManage,dmPrejManage;
{$R *.dfm}

{表名生成函数}
//---------------------------------------------------------
Function ProduceName(SeriesName,SpecialityName:string):String;
Var
SePhoneticize,SpPhoneticize,strSQL:String;
SpNumber:Integer;
Begin
{查询系列拼音码/专业拼音码/专业编号}
with TdmPrejManage do
Begin
strSQL:='Select SeriesPhoneticize,SpecialityPhoneticize, SpecialityNumber From SeriesCode_TABLE,SpecialityCode_TABLE Where '
+'SeriesCode_TABLE.SeriesName='+''''+SeriesName+''''
+'and SpecialityCode_TABLE.SpecialityName='+''''+SpecialityName+''''
+'and SpecialityCode_TABLE.SeriesNumber=SeriesCode_TABLE.SeriesNumber';
//注意sql语句取得变量值时前面要加"'",需要+''''四个单引号否则不能获得变量值
adoqSql.Close;
adoqSql.SQL.Clear;
adoqSql.SQL.Add(strSQL);
adoqSql.Open;
//---------------------------------------------------------------------------
{自动生成表名}
{赋值}
SePhoneticize:=trim(adoqSql.FieldByName('SeriesPhoneticize').AsString);
SpPhoneticize:=trim(adoqSql.FieldByName('SpecialityPhoneticize').AsString);
SpNumber:=adoqSql.FieldByName('SpecialityNumber').AsInteger;
Result:=SePhoneticize+SpPhoneticize+IntToStr(SpNumber)+'_ConditionTABLE';
End;
End;
//---------------------------------------------------
{自动生成编号函数}
//--------------------------------------------------------------
Function ProduceNumber(NumberName,TableName:string):Integer;
var
strSQL:string;
Begin
{连接表}
With TdmPrejManage.adoqSql do
Begin
Close;
SQL.Clear;
strSQL:='Select '+NumberName+' from '+TableName;
SQL.Add(strSQL);
Open;
{生成编号}
First;
if not Eof then
begin
Last;//指向最后一条记录
Result:=FieldByName(NumberName).Value+1;//编号加1
Next;
end
else
begin
{如果没有表为空则编号从1开始递增}
Result:=1;
end;
End;
End;

//---------------------------------------------------------------
{建表函数}
//---------------------------------------------------------------

Function CreateTable(strTableName,strSeriesName,strSpecialityName:string;intNumber:integer):Boolean;
var
strSQL:string;
Begin
{判断将要创建的表是否存在}
if not TdmPrejManage.adotTableList.Locate('TableName',strTableName,[]) then
{不存在责创建}
Begin

With TdmPrejManage.adoqSql do //定义adoqSQL去执行建表
begin
{将建立的表格信息插入到预审条件表列表中}
With TdmPrejManage.adotTableList do
Begin
if not active then Open;//打开表
Append;
Fields[0].Value:=intNumber;
Fields[1].Value:=strTableName;
Fields[2].Value:=strSeriesName;
Fields[3].Value:=strSpecialityName;
Post;
if Locate('TableName',strTableName,[]) then
Begin
//-----------------------------------------
{用sql创建表格}
With TdmPrejManage.adocmCreateTable do
Begin
Close;
strSQL:='Create Table '+strTableName
+'(Number int Primary Key not null,'
+'Edu_Level Char(10) not null,'
+'Computer Char(6) not null,'
+'ForLanuage Char(6) not null,'
+'TaskDate Char(2) not null,'
+'OccupyTime Char(2) not null)';
CommandText:=strSQL;
Execute;
End;
//-------------------------------------
Result:=True;
End
else
Begin
Result:=False;
End;
End;
end;
End
else
Begin
Result:=False;
End;

End;
procedure TTfrmPrejLogin.FormCreate(Sender: TObject);
var
ttnSeries:TTreeNode;//treeview节点变量
strSeriesName,strSpecialityName,strSQL:string;
begin
{对系列和专业代码表进行是否为空检查}
//-----------------------------------------------
With TdmPrejManage do
Begin
if (adotSeries.IsEmpty)or(adotSpeciality.IsEmpty) then
begin
showMessage('请进行系列和专业代码维护先!');
end
else
Begin
{item初始化部分}
With TdmPrejManage do
Begin
{给cbSeriesList的item属性赋值}
//------------------------------------------
adotSeries.Close;
adotSeries.Open;
cbSeriesList.Items.Clear;//清空items
adotSeries.First;//将记录指针置首
While not adotSeries.Eof do
begin
cbSeriesList.Items.Add(adotSeries.FieldByName('SeriesName').Asstring);
adotSeries.Next;
cbSeriesList.ItemIndex:=0;
end;
TdmPrejManage.adotSpeciality.First;
CbSpecialityList.Items.Add(adotSpeciality.fieldByName('SpecialityName').AsString);
cbSpecialityList.ItemIndex:=0;
End;
End;
End;
//------------------------------------------
{TreeView的item初始化部分}
With TdmPrejManage do
Begin
adoqPrejTable.open;
adoqPrejTable.First;
tvPrejList.Items.Clear;
while not adoqPrejTable.eof do
Begin
{给系列名称变量赋值}
strSeriesName:=adoqPrejTable.FieldByName('SeriesName').AsString;
{添加系列根节点}
with tvPrejList.Items do
Begin
ttnSeries := Add(nil, strSeriesName); { 添加系列根节点 }
end;

{选择相同系列名称的专业名称}
adoqSql.Close;
adoqSql.SQL.Clear;
strSQL:='Select SpecialityName from PrejTableList_TABLE '
+'Where SeriesName='+''''+strSeriesName+'''';
adoqSql.SQL.Add(strSQL);
adoqSql.Open;
adoqSql.First;//将记录指针定位到第一条
while not adoqSql.Eof do //判断是否本系列的专业不存在
begin
strSpecialityName:=adoqSql.FieldByName('SpecialityName').AsString;
tvPrejList.Items.AddChild(ttnSeries,strSpecialityName);//treeview添加专业子节点
adoqSql.Next;
end;
begin
adoqPrejTable.Next;//表移动到下一条记录
end;
End;
End;
end;

procedure TTfrmPrejLogin.btnExitClick(Sender: TObject);
begin
TfrmPrejLogin.Close;
end;

procedure TTfrmPrejLogin.btnOkClick(Sender: TObject);
var
strSeriesName,strSpecialityName:string;
intNumber:integer;
begin
if TfrmPrejLogin.tbsNewPrej.Showing then

Begin
intNumber:=ProduceNumber('TableNumber','PrejTableList_TABLE');//条件表编号
strSeriesName:=trim(cbSeriesList.Text);//系列名
strSpecialityName:=trim(cbSpecialityList.Text);//专业名
if not(strSpecialityName='') then

Begin
strTableName:=ProduceName(strSeriesName,strSpecialityName);//表名
{创建表格}
if CreateTable(strTableName,strSeriesName,strSpecialityName,intNumber) then
begin
try
TfrmPrejManage:=TTfrmPrejManage.Create(Application);//建立维护窗口
TfrmPrejManage.ShowModal;
Finally
TfrmPrejManage.Free;
TfrmPrejLogin.Show;
end;
end
else
begin
ShowMessage('已经建立了该预审条件!');
TfrmPrejLogin.tbsSelectPrej.Show;
end;

End
Else
Begin
ShowMessage('专业代码值不能为空!请进行专业代码维护!');
End;

End


Else
Begin
With TdmPrejManage.adotPrejManage do
Begin
{设置数据连接}
Active:=False;
TdmPrejManage.strTableName:=strTableName;
TableName:=strTableName;
Active:=True;
{创建窗体}
End;
Try
if assigned(TfrmPrejManage) then TfrmPrejManage.show;
TfrmPrejManage:=TTfrmPrejManage.Create(Application);
TfrmPrejManage.ShowModal;
Finally
TfrmPrejManage.Free;
End;

End;

end;

procedure TTfrmPrejLogin.cbSeriesListSelect(Sender: TObject);
var
intSeriesNumber:integer;
begin

strSeriesName:=trim(cbSeriesList.Text);//取得系列名称值
with TdmPrejManage.adotSeries do
Begin
if locate('SeriesName',strSeriesName,[]) then //定位选择的系列
Begin
intSeriesNumber:=FieldByName('SeriesNumber').Value;//取系列编号
Begin
cbSpecialityList.Items.Clear;//清除专业combobox
With TdmPrejManage.adoqAddItem do
Begin
{按系列编号查询专业代码表}
Close;
Parameters.ParamByName('SeriesNumber').Value:=intSeriesNumber;
Open;
First;
{给combobox添加专业名称值}
while not Eof do //是否结尾不要用if否则只显示一条记录
begin
//添加该专业名称到combobox
cbSpecialityList.Items.Add(FieldByName('SpecialityName').AsString);
//移动到下一条记录
Next;
cbSpecialityList.ItemIndex:=0;
end;
End;
End;
End;
End;

end;

procedure TTfrmPrejLogin.tvPrejListChange(Sender: TObject;
Node: TTreeNode);
begin

With tvPrejList do
if Selected.Parent=nil then//判断是否为根节点
begin
lblSelectSeries.Caption:=Selected.Text;//显示系列值
lblSelectSpeciality.Caption:='';
{赋值}
strSeriesName:=Selected.Text;
end
else
Begin
lblSelectSeries.Caption:=Selected.Parent.Text; //显示系列值
lblSelectSpeciality.Caption:=Selected.Text;//显示专业值
{赋值}
strSeriesName:=Selected.Parent.Text;
strSpecialityName:=Selected.Text;
strTableName:=ProduceName(strSeriesName,strSpecialityName);

End;
end;

procedure TTfrmPrejLogin.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
Action:=caFree;
end;
 
TfrmPrejManage:=TTfrmPrejManage.Create(self);
程序运行到这提示越界!
 

With TdmPrejManage.adotPrejManage do
Begin
{设置数据连接}
Active:=False;
TdmPrejManage.strTableName:=strTableName;
TableName:=strTableName;
Active:=True;
此处可疑性最大,我改成连接DATASET就好了!
 
to 自我教育:
{创建窗体}
if assigned(TfrmPrejManage) then TfrmPrejManage.show;
TfrmPrejManage:=TTfrmPrejManage.Create(Application);
TfrmPrejManage.ShowModal;
你这样在第二次运行时,会出现两个TfrmPrejManage窗体,不信称运行两次后,拖动第二个窗体
到别的位置,你就会看见第二个窗体有两个。
应改为
{创建窗体}
if not assigned(TfrmPrejManage) then
begin
TfrmPrejManage:=TTfrmPrejManage.Create(Application);
TfrmPrejManage.ShowModal;
end;
在TfrmPrejManage窗体的这两个事件中加入
procedure TTfrmPrejManage.FormDestroy(Sender: TObject);
begin
TfrmPrejManage:=nil;
end;

procedure TTfrmPrejManage.FormClose(Sender: TObject;
var Action: TCloseAction);
begin
action:=cafree;
end;


 
拿一个数组存放创建的窗体,逐个加一个的存放,就OK了。
 
TfrmPrejManage:=TTfrmPrejManage.Create(self);
程序运行到这提示越界!
在这里设置个断点,F7单步跟踪进去,这中小问题很好找的
 
问题解决是我的item出了问题!谢谢各位!
 
后退
顶部