smallu.pas

运筹学演示程序之运输问题

           end;
          else begin
             panel4.BringToFront;
             panel4.visible:=true;
             cedraw;
           end;
        end;
      end;
    end;
  end else messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
end;

procedure TPettyForm.SpinEdit1Change(Sender: TObject);
var i,j:byte;
    k:byte;
begin
  i:=spinedit2.Value;
  j:=spinedit1.value;
  with grid do
  begin
    colcount:=i+2;
    rowcount:=j+2;
    for k:=1 to i do
      cells[k,0]:=inttostr(k);
    for k:=1 to j do
      cells[0,k]:=inttostr(k);
    cells[0,j+1]:='销量Bi';
    cells[i+1,0]:='产量Ai';
  end;
end;

procedure TPettyForm.Button8Click(Sender: TObject);
var i,j:byte;
begin
  spinedit1.Value:=8;
  spinedit2.Value:=8;
  spinedit1change(sender);
  for i:=1 to 9 do for j:=1 to 9 do
    grid.cells[i,j]:='';
end;

procedure TPettyForm.Button10Click(Sender: TObject);
var x,y,i,j:byte;
begin
  x:=spinedit2.Value;
  y:=spinedit1.value;
  for i:=1 to x do for j:=1 to y do
    grid.cells[i,j]:='';
  for i:=1 to x do
    grid.cells[i,y+1]:='';
  for j:=1 to y do
    grid.cells[x+1,j]:='';
end;

procedure TPettyForm.Button2Click(Sender: TObject);
begin
  button2.enabled:=false;
  xbj_d_init(pc,sc,produce,sale,ma1,gridxbj,trackbar2.position);
  button3.enabled:=true;
end;

procedure TPettyForm.Button3Click(Sender: TObject);
var i,j:byte;
begin
  button3.enabled:=false;
//  if step_init(pc,sc,ma1) then
  if step_init2(pc,sc,ma1,c) then
    for i:=1 to pc do for j:=1 to sc do
      begin
        if (ma1[i-1,j-1]>=0) then
          gridxbj.cells[j,i]:=floattostr(ma1[i-1,j-1])
        else
          gridxbj.cells[j,i]:='';
      end;
  pause(trackbar2.position);
  panel2.visible:=false;
  panel2.sendtoback;
  panel5.BringToFront;
  panel5.visible:=true;
  stepdraw;
end;

procedure TPettyForm.Button6Click(Sender: TObject);
begin
  button6.enabled:=false;
  ce_d_init(pc,sc,produce,sale,c,ma1,gridce1,
                          gridce2,trackbar1.position);
  button7.enabled:=true;
end;

procedure TPettyForm.Button7Click(Sender: TObject);
var i,j:byte;
begin
  button7.enabled:=false;
//  if step_init(pc,sc,ma1) then
  if step_init2(pc,sc,ma1,c) then
    for i:=1 to pc do for j:=1 to sc do
      begin
        if (ma1[i-1,j-1]>=0) then
          gridzdfy2.cells[j,i]:=floattostr(ma1[i-1,j-1])
        else
          gridzdfy2.cells[j,i]:='';
      end;
  pause(trackbar1.position);
  panel3.visible:=false;
  panel3.sendtoback;
  panel5.BringToFront;
  panel5.visible:=true;
  stepdraw;
end;

procedure TPettyForm.Button4Click(Sender: TObject);
begin
  button4.enabled:=false;
  zdfy_d_init(pc,sc,produce,sale,c,ma1,gridzdfy1,
                          gridzdfy2,trackbar3.position);
  button5.enabled:=true;
end;

procedure TPettyForm.Button5Click(Sender: TObject);
var i,j:byte;
begin
  button5.enabled:=false;
//  if step_init(pc,sc,ma1) then
  if step_init2(pc,sc,ma1,c) then
    for i:=1 to pc do for j:=1 to sc do
      begin
        if (ma1[i-1,j-1]>=0) then
          gridzdfy2.cells[j,i]:=floattostr(ma1[i-1,j-1])
        else
          gridzdfy2.cells[j,i]:='';
      end;
  pause(trackbar3.position);
  panel4.visible:=false;
  panel4.sendtoback;
  panel5.BringToFront;
  panel5.visible:=true;
  stepdraw;
end;

procedure TPettyForm.Button9Click(Sender: TObject);
var rc:boolean;
begin
  savenow:=true;
//  rc:=draw_step(pc,sc,produce,sale,c,ma1,gridstep1,gridstep2,500);
  rc:=draw_step(pc,sc,produce,sale,c,ma1,gridstep1,gridstep2,500,edit1);
  if rc then
     showmessage('已经达到最优解！');
//  edit1.text:=floattostr(rc);
end;

procedure TPettyForm.Button11Click(Sender: TObject);
var i,j:byte;
    rc:real;
begin
   savenow:=true;
   rc:=prj_step(pc,sc,produce,sale,c,ma1);
   edit1.text:=floattostr(rc);
   for i:=1 to pc do for j:=1 to sc do
    if (ma1[i-1,j-1]>0) then
      gridstep2.cells[j,i]:=floattostr(ma1[i-1,j-1])
    else
      gridstep2.cells[j,i]:='0';
   for i:=1 to pc do for j:=1 to sc do
     gridstep1.cells[j,i]:=floattostr(c[i-1,j-1]);
   for i:=1 to pc do
     gridstep1.cells[0,i]:=inttostr(i);
   for j:=1 to sc do
     gridstep1.cells[j,0]:=inttostr(j);
   gridstep1.refresh;
   gridstep2.refresh;
end;

procedure TPettyForm.Button13Click(Sender: TObject);
var i,j,k:byte;
    do_save:boolean;
begin
  i:=check_input;
  if (i<3) then  //小于3，输入无误
  begin
      sc:=spinedit2.Value;
      pc:=spinedit1.value;
      setlength(sale,sc);
      setlength(produce,pc);
      setlength(ma1,pc,sc);
      setlength(c,pc,sc);
      if radiobutton1.checked then
        init_type:=1    //西北角法
      else if radiobutton2.checked then
        init_type:=2    //最低费用法
      else init_type:=3;   //运费差额法，默认
      if (not get_input) then
      begin
        rec.init_type:=init_type;
        rec.pc:=pc;
        rec.sc:=sc;
        for j:=0 to pc-1 do rec.produce[j]:=produce[j];
        for j:=0 to sc-1 do rec.sale[j]:=sale[j];
        for j:=0 to pc-1 do for k:=0 to sc-1 do
          rec.c[j,k]:=c[j,k];
        for j:=0 to pc-1 do for k:=0 to sc-1 do
          rec.ma1[j,k]:=0;
        if (radiobutton1.checked) then rec.init_type:=1
        else if (radiobutton2.checked) then rec.init_type:=2
        else rec.init_type:=3;
        rec.data_type:=2;
        if savedialog1.Execute then
        begin
          do_save:=true;
          if (fileexists(savedialog1.filename)) then
            if (messagedlg('该文件已存在，覆盖原文件吗？',mtinformation,
                 [mbyes,mbno],0)<>mryes) then
              do_save:=false;
          if (do_save) then
          begin
            try
              assignfile(f,savedialog1.FileName);
              rewrite(f);
              write(f,rec);
            finally
              closefile(f);
            end;
            showmessage('数据存储完毕。');
          end;
        end;
      end else showmessage('数据错误。');
  end else messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
end;

function TPettyForm.getFileName:string;
begin
  if (opendialog1.Execute) then
    result:=opendialog1.FileName
  else
    result:='';
end;

procedure TPettyForm.Button12Click(Sender: TObject);
var j,k:byte;
    error:boolean;
begin
  error:=false;
  if (filename='') then filename:=getFileName;
  if (filename<>'') then
  begin
   if (fileexists(filename))then
   begin
    try
      try
        assignfile(f,filename);
        reset(f);
        read(f,rec);
      except
        error:=true;
      end;
    finally
      closefile(f);
    end;
    if (rec.data_type<>2) then
    begin
      messagedlg('该文件存储的数据这里无法处理！',mterror,[mbok],0);

     //   在这里可以考虑加入适当的语句，转移到处理相应数据的模块
     //   比如，读入的是大项目的存盘数据时，转去大项目模块？

    end
    else
    begin
      if (not error) then
      begin
        spinedit2.Value:=rec.sc;
        spinedit1.value:=rec.pc;
        for j:=0 to rec.pc-1 do for k:=0 to rec.sc-1 do
          grid.cells[k+1,j+1]:=floattostr(rec.c[j,k]);
        for j:=0 to rec.sc-1 do grid.cells[j+1,rec.pc+1]:=floattostr(rec.sale[j]);
        for j:=0 to rec.pc-1 do grid.cells[rec.sc+1,j+1]:=floattostr(rec.produce[j]);
        grid.refresh;
        case rec.init_type of
          1: begin
             radiobutton2.checked:=false;
             radiobutton3.checked:=false;
             radiobutton1.checked:=true;
             end;
          2: begin
             radiobutton1.checked:=false;
             radiobutton3.checked:=false;
             radiobutton2.checked:=true;
             end;
          else begin
             radiobutton1.checked:=false;
             radiobutton2.checked:=false;
             radiobutton3.checked:=true;
            end;
        end;
      end else
        messagedlg('数据读取错误！',mterror,[mbok],0);
    end;
   end
   else
     messagedlg('该文件不存在！',mterror,[mbok],0);
  end;
  filename:='';
end;

procedure TPettyForm.Button14Click(Sender: TObject);
var k,j:byte;
    do_save:boolean;
begin
  rec.data_type:=4;
  rec.init_type:=init_type;
  rec.pc:=pc;
  rec.sc:=sc;
  for j:=0 to pc-1 do rec.produce[j]:=produce[j];
  for j:=0 to sc-1 do rec.sale[j]:=sale[j];
  for j:=0 to pc-1 do for k:=0 to sc-1 do
     rec.c[j,k]:=c[j,k];
  for j:=0 to pc-1 do for k:=0 to sc-1 do
     rec.ma1[j,k]:=ma1[j,k];
  if (radiobutton1.checked) then rec.init_type:=1
  else if (radiobutton2.checked) then rec.init_type:=2
  else rec.init_type:=3;
  if savestep.Execute then
  begin
    do_save:=true;
    if (fileexists(savestep.filename)) then
    if (messagedlg('该文件已存在，覆盖原文件吗？',mtinformation,
       [mbyes,mbno],0)<>mryes) then
    do_save:=false;
    if (do_save) then
    begin
      try
        assignfile(f,savestep.FileName);
        rewrite(f);
        write(f,rec);
      finally
        closefile(f);
      end;
      showmessage('数据存储完毕。');
    end;
  end;
  savenow:=false;
end;

function TPettyForm.getStepFileName:string;
begin
  if openstep.Execute then
    result:=openstep.filename
  else
    result:='';
end;

procedure TPettyForm.Button15Click(Sender: TObject);
var i,j,k:byte;
    error,breakit,ifsavenow:boolean;
    rt:word;
begin
 breakit:=false;
 ifsavenow:=savenow;
 if (savenow) then
 begin
   rt:=messagedlg('保存现有数据吗？',mtinformation,[mbyes,mbno,mbcancel],0);
   if (rt=mryes) then
     button14.click;
   if (rt=mrcancel) then
     breakit:=true;
 end;
 if (not breakit) then
 begin
  error:=false;
  if stepfilename='' then stepfilename:=getStepFileName;
  if (stepfilename<>'') then
  begin
    if (fileexists(stepfilename)) then
    begin
      try
        try
          assignfile(f,stepfilename);
          reset(f);
          read(f,rec);
        except
          error:=true;
        end;
      finally
        closefile(f);
      end;
      if (rec.data_type<>4) then
      begin
        messagedlg('该文件存储的数据这里无法处理！',mterror,[mbok],0);
      end
      else
      begin
        if (not error) then
        begin
          savenow:=false;
          ifsavenow:=savenow;
          pc:=rec.pc;
          sc:=rec.sc;
          init_type:=rec.init_type;
          setlength(produce,pc);
          setlength(sale,sc);
          setlength(c,pc,sc);
          setlength(ma1,pc,sc);
          for i:=1 to sc do for j:=1 to pc do
          begin
            gridstep1.cells[i,j]:='';
            gridstep2.cells[i,j]:='';
          end;
          for j:=0 to pc-1 do for k:=0 to sc-1 do
          begin
            c[j,k]:=rec.c[j,k];
            ma1[j,k]:=rec.ma1[j,k];
          end;
          for j:=0 to sc-1 do sale[j]:=rec.sale[j];
          for j:=0 to pc-1 do produce[j]:=rec.produce[j];
          stepdraw;
          for i:=1 to pc do for j:=1 to sc do
          if (ma1[i-1,j-1]>0) then
          begin
            gridstep2.cells[j,i]:=floattostr(ma1[i-1,j-1]);
            gridstep1.cells[j,i]:=floattostr(c[i-1,j-1]);
          end
          else
            gridstep2.cells[j,i]:='0';
            gridstep2.refresh;
          edit1.text:='';
        end else
          messagedlg('数据读取错误！',mterror,[mbok],0);
      end;
    end
    else
      messagedlg('该文件不存在！',mterror,[mbok],0);
  end;
 end;
 stepfilename:='';
 savenow:=ifsavenow;
end;

procedure TPettyForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if MessageDlg('退出小问题练习吗？', mtConfirmation,
    [mbYes, mbNo], 0) = mrYes then
 begin
    mainform.SetFocus;
    mainform.exercise.checked:=false;
    mainform.bexercise.down:=false;
    Action := caFree;
 end
 else
    Action := caNone;
end;

procedure TPettyForm.Button16Click(Sender: TObject);
begin
  if (messagedlg('开始一个新项目吗？'+chr(13)+'(未保存的数据将丢失！)',mtconfirmation,
     [mbyes,mbno],0)=mryes) then
  begin
    panel5.visible:=false;
    panel1.visible:=true;
    panel5.sendtoback;
    panel1.BringToFront;
    button8.click;
  end;
end;

end.