我在无线电组上分组了四个单选按钮。有创建文件,创建文件夹,删除和复制单选按钮,但我遇到了复制按钮的问题。
它主要工作正常,但是消息窗口(说文件被复制到硬盘驱动器的位置)没有关闭。我怎么能把它关闭?或者有没有办法刷新单选按钮?
这是一个家庭作业问题。
这是我的代码:
procedure TForm1.btnsubmitClick(Sender: TObject);
var
i,j,k,t,index,pred,delp,temp,temp2:integer;
begin
if rbtncreatefolder.checked = true then
begin
if (length(edit3.Text)>0) and (edit3.Text<>'..') then begin
if (VS>=3) then begin
if sush(true,nk1,edit3.Text) then begin
i:=tabld[nk1].nach;
while fat[i]<>1024 do i:=fat[i];
fat[i]:=freep(i);
tabld[fat[i]].name:=edit3.Text;
tabld[fat[i]].format:='';
tabld[fat[i]].tip:=true;
fat[fat[i]]:=1024;
k:=freep(fat[i]);
tabld[fat[i]].nach:=k;
tabld[k].name:='.';
tabld[k].tip:=true;
tabld[k].nach:=fat[i];
t:=freep(k);
fat[k]:=t;
tabld[t].name:='..';
tabld[t].tip:=true;
tabld[t].nach:=nk1;
fat[t]:=1024;
tabld[fat[i]].razmer:=0;
tabld[i].razmer:=tabld[i].razmer+1;
reload;
end
end
else
showmessage('Not enough free memory!');
end
else
showmessage('Incorrect data or absent!');
end
else if rbtncreatefile.Checked = true then
begin
if (length(edit3.Text)>0) and (length(edit4.Text)>0)then begin
if strtoint(edit4.Text)<32*VS then begin
if sush(false,nk1,edit3.Text) then begin
i:=tabld[nk1].nach;
while fat[i]<>1024 do i:=fat[i];
fat[i]:=freep(i);
tabld[fat[i]].name:=edit3.Text;
tabld[fat[i]].format:=copy(edit3.Text,length(edit3.Text)-4,3);
tabld[fat[i]].tip:=false;
tabld[fat[i]].razmer:=strtoint(edit4.Text);
if radiobutton1.Checked then
tabld[fat[i]].format:='txt'
else
tabld[fat[i]].format:='bin';
tabld[fat[i]].nach:=freep(fat[i]);
k:=tabld[fat[i]].nach;
fat[fat[i]]:=1024;
for j:=1 to (tabld[fat[i]].razmer-9) div 32 do begin
fat[k]:=freep(k);
k:=fat[k];
end;
fat[k]:=1024;
reload;
end
end
else
showmessage('Not enough free memory!');
end
else
showmessage('You did not enter name and \ or File Size!');
end
else if rbtndelete.checked = true then
begin
if listbox1.ItemIndex>=0 then begin
if listbox1.Items.Strings[listbox1.ItemIndex]<>'dir>..' then begin
pred:=tabld[nk1].nach;
index:=tabld[nk1].nach;
for i:=0 to listbox1.ItemIndex do begin
index:=fat[index];
if i>0 then
pred:=fat[pred];
end;
delP:=index;
fat[pred]:=fat[index];
if tabld[index].tip then begin
showmessage('directory "'+tabld[index].name+'" and all its subdirectories have been deleted!');
rekur(tabld[delp].nach);
fat[delp]:=0;
fat[tabld[delp].nach]:=0;
end
else begin
showmessage('file "'+tabld[index].name+'.'+tabld[index].format+'" was removed!');
i:=tabld[index].nach;
while fat[i]<>1024 do begin
j:=i;
i:=fat[i];
fat[j]:=0;
end;
fat[i]:=0;
fat[index]:=0;
end;
reload;
end
else
showmessage('You can not delete this directory!');
end
else
showmessage('You did not select the folder to delete!');
end
else if rbtncopy.checked = true then
begin
if listbox1.ItemIndex>=0 then begin
if listbox1.Items.Strings[listbox1.ItemIndex]<>'dir>..' then begin
index:=tabld[nk1].nach;
for i:=0 to listbox1.ItemIndex do
index:=fat[index];
if tabld[index].tip then begin
showmessage('directory "'+tabld[index].name+'" and all its subdirectories are copied to the directory "'+edit2.text+'" !');
temp:=nk1;
nk1:=nk2;
edit3.Text:=tabld[index].name;
btnsubmit.Click;
temp2:=tabld[nk2].nach;
while (fat[temp2]<>1024) and (tabld[temp2].name<>tabld[nk1].name) do temp2:=fat[temp2];
rekurC(fat[tabld[index].nach],temp2);
nk1:=temp;
end
else begin
showmessage('file "'+tabld[index].name+'.'+tabld[index].format+'" was copied to directory "'+edit2.Text+'"!');
temp:=nk1;
nk1:=nk2;
edit3.Text:=tabld[index].name;
edit4.Text:=inttostr(tabld[index].razmer);
btnsubmit.Click;
nk1:=temp;
end
end
else
showmessage('This directory may not be copied!');
end
else
showmessage('You have not picked anything up to copy!');
reload;
end
else
showmessage('select an operator please');
end;
答案 0 :(得分:10)
这个相当可怕的事件处理程序的结尾就是这段代码:
showmessage('file "'+tabld[index].name+'.'+tabld[index].format+
'" was copied to directory "'+edit2.Text+'"!');
...//do stuff
btnsubmit.Click;
然后,只要在消息框中单击“确定”,就会重新输入事件处理程序,因为您调用了btnsubmit.Click
,因此整个例程再次启动。然后会显示消息框,然后按OK,然后再次调用btnsubmit.Click
,依此类推。如果你有足够的耐心,你应该能够得到堆栈溢出错误!