largeu.pas

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

var i:byte;
begin
  i:=check_input;
  if (i<3) then  //小于3，输入无误
  begin
    if (i=2) then     //产销不平衡
      do_balance
    else
    begin
      sc:=spinedit2.Value;
      pc:=spinedit1.value;
      setlength(sale,sc);
      setlength(produce,pc);
      setlength(ma1,pc,sc);
      setlength(c,pc,sc);
      if (not get_input) then
      begin
        do_cal;
        panel1.SendToBack;
        panel1.visible:=false;
        panel2.BringToFront;
        stepdraw;
        panel2.visible:=true;
      end;
    end;
  end else messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
end;

procedure TLargeForm.SpinEdit1Change(Sender: TObject);
var i,j:integer;
    k:byte;
begin
  i:=spinedit2.Value;
  j:=spinedit1.value;
  if (i<2) then
  begin
    messagedlg('销地数量最少为2个！',mtinformation,[mbok],0);
    spinedit2.value:=2;
    i:=2;
  end
  else if (i>max) then
  begin
    messagedlg('请将销地数量控制在'+inttostr(max)+'个以内。',
                        mtinformation,[mbok],0);
    spinedit2.value:=max;
    i:=max;
  end;
  if (j<2) then
  begin
    messagedlg('产地数量最少为2个！',mtinformation,[mbok],0);
    spinedit1.value:=2;
    j:=2;
  end
  else if (j>max) then
  begin
    messagedlg('请将产地数量控制在'+inttostr(max)+'个以内。',
                        mtinformation,[mbok],0);
    spinedit1.value:=max;
    j:=max;
  end;
  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 TLargeForm.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 TLargeForm.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 TLargeForm.Button13Click(Sender: TObject);
var j,k:byte;
    do_save:boolean;
begin
//  i:=check_input;
//  if (i<3) then
//  begin
//    if (i=2) then
//      do_balance
//    else
//    begin
      sc:=spinedit2.Value;
      pc:=spinedit1.value;
      setlength(sale,sc);
      setlength(produce,pc);
      setlength(ma1,pc,sc);
      setlength(c,pc,sc);
      if (not get_input) then
      begin
        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;
        rec.data_type:=3;
        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;
            messagedlg('数据存储完毕。',mtinformation,[mbok],0);
          end;
        end;
      end;
//    end;
//  end else messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
end;

function Tlargeform.getfilename:string;
begin
  if opendialog1.Execute then
    result:=opendialog1.filename
  else
    result:='';
end;

procedure TLargeForm.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<>3) 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;
      end else
        messagedlg('数据读取错误！',mterror,[mbok],0);
    end;
   end
   else
     messagedlg('该文件不存在！',mterror,[mbok],0);
  end;
  filename:='';
end;

procedure TLargeForm.Button14Click(Sender: TObject);
var i,j:byte;
    do_save:boolean;
    fl:textfile;
begin
  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(fl,savestep.FileName);
        rewrite(fl);
        writeln(fl,'');
        writeln(fl,'       **********************************');
        writeln(fl,'       *          最佳运输方案          *');
        writeln(fl,'       **********************************');
        writeln(fl,'');
        writeln(fl,'');
        writeln(fl,'    一、产方：');
        writeln(fl,'');
        for i:=0 to pc-1 do for j:=0 to sc-1 do
          if (ma1[i,j]>0) then
            writeln(fl,' 由产地 '+inttostr(i+1)+' 运往销地 '+inttostr(j+1)
               +' 的物资为：  '+floattostr(ma1[i,j])+'单位。');
        writeln(fl,'');
        writeln(fl,'');
        writeln(fl,'');
        writeln(fl,'    二、销方：');
        for j:=0 to sc-1 do for i:=0 to pc-1 do
          if (ma1[i,j]>0) then
            writeln(fl,' 销地 '+inttostr(j+1)+' 得到产地 '+inttostr(i+1)
               +' 运来的物资为：  '+floattostr(ma1[i,j])+'单位。');
        writeln(fl,'');
        writeln(fl,'');
        writeln(fl,' *********** '+datetostr(date)+' '+timetostr(time)+'******');
        writeln(fl,'');
        writeln(fl,'');
        writeln(fl,'');
      finally
        closefile(fl);
      end;
      showmessage('数据存储完毕。');
    end;
  end;
end;

procedure TLargeForm.Button2Click(Sender: TObject);
var i,j:byte;
    x,y:byte;
begin
  y:=spinedit2.Value;
  x:=spinedit1.value;
  randomize;
  for i:=1 to x+1 do for j:=1 to y+1 do
    grid.cells[j,i]:=floattostr(20+random(2000));
end;

procedure TLargeForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 if MessageDlg('退出大项目解答部分吗？', mtConfirmation,
    [mbYes, mbNo], 0) = mrYes then
 begin
    mainform.SetFocus;
    mainform.bigprj.checked:=false;
    mainform.bbigprj.down:=false;
    Action := caFree;
 end
 else
    Action := caNone;
end;

procedure TLargeForm.Panel1DblClick(Sender: TObject);
begin
  button2.visible:=not button2.visible;
end;

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

end.