德尔福的单选按钮

时间:2012-01-03 17:03:52

标签: delphi

我在无线电组上分组了四个单选按钮。有创建文件,创建文件夹,删除和复制单选按钮,但我遇到了复制按钮的问题。

它主要工作正常,但是消息窗口(说文件被复制到硬盘驱动器的位置)没有关闭。我怎么能把它关闭?或者有没有办法刷新单选按钮?

这是一个家庭作业问题。

这是我的代码:

 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;

1 个答案:

答案 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,依此类推。如果你有足够的耐心,你应该能够得到堆栈溢出错误!