smallu.pas

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

unit SmallU;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Grids, Spin, ExtCtrls, ComCtrls, BasicU, StepU;

type
  rcpetty=record
    data_type:byte;
      // data_type : 1 -> 演示数据   2 -> 小规模问题   3 -> 大规模问题
      //             4 -> 迭代中数据
    init_type:byte;
      // init_type : 1 -> 西北角法   2 -> 最低费用法   3 -> 运费差额法
    pc,sc:integer;
    produce,sale:array [0..7] of real;
    c,ma1:array [0..7,0..7] of real;
  end;
  TPettyForm = class(TForm)
    Panel1: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Label9: TLabel;
    SpinEdit1: TSpinEdit;
    SpinEdit2: TSpinEdit;
    Grid: TStringGrid;
    Button1: TButton;
    Panel2: TPanel;
    GroupBox1: TGroupBox;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    RadioButton3: TRadioButton;
    Label7: TLabel;
    Gridxbj: TStringGrid;
    Button2: TButton;
    Button3: TButton;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Label8: TLabel;
    Gridzdfy1: TStringGrid;
    Gridzdfy2: TStringGrid;
    Label10: TLabel;
    Label11: TLabel;
    Button4: TButton;
    Button5: TButton;
    Label12: TLabel;
    Gridce1: TStringGrid;
    Gridce2: TStringGrid;
    Label13: TLabel;
    Label14: TLabel;
    Button6: TButton;
    Button7: TButton;
    TrackBar1: TTrackBar;
    Label15: TLabel;
    TrackBar3: TTrackBar;
    Label21: TLabel;
    Label18: TLabel;
    Gridstep1: TStringGrid;
    Gridstep2: TStringGrid;
    Label19: TLabel;
    Label20: TLabel;
    Button9: TButton;
    TrackBar2: TTrackBar;
    Label24: TLabel;
    Button8: TButton;
    Button10: TButton;
    Button11: TButton;
    Panel6: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Button12: TButton;
    Button13: TButton;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Button14: TButton;
    SaveStep: TSaveDialog;
    Button15: TButton;
    Openstep: TOpenDialog;
    Label16: TLabel;
    Edit1: TEdit;
    Button16: TButton;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button13Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button14Click(Sender: TObject);
    procedure Button15Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button16Click(Sender: TObject);
  private
    { Private declarations }
    init_type:1..3;
    c,ma1:matrix;
    pc,sc:byte;
    produce,sale:array of real;
    function getFileName:string;
    function getStepFileName:string;
    procedure do_balance;
    procedure xbjdraw;
    procedure zdfydraw;
    procedure cedraw;
    procedure stepdraw;
  public
    { Public declarations }
    savenow:boolean;
    filename,stepfilename:string;
  end;

var
  PettyForm: TPettyForm;

implementation

uses Main;

{$R *.DFM}
var
  f:file of rcpetty;
  rec:rcpetty;

procedure TPettyForm.FormCreate(Sender: TObject);
var i:byte;
begin
  savenow:=true;
  with grid do
  begin
    cells[0,0]:='产＼销';
    for i:=1 to 8 do
    begin
      cells[i,0]:=inttostr(i);
      cells[0,i]:=inttostr(i);
    end;
    cells[0,9]:='销量Bi';
    cells[9,0]:='产量Ai';
  end;
end;

function get_input:boolean;
var x,y:byte;
    i,j:byte;
    have_error:boolean;
begin
  with pettyform do
  begin
    x:=spinedit2.Value;
    y:=spinedit1.value;
    have_error:=false;
    try
      for i:=1 to x do for j:=1 to y do
       begin
         if (grid.cells[i,j]='') then
         begin
           grid.cells[i,j]:='0';
           c[j-1,i-1]:=0;
         end
         else
           c[j-1,i-1]:=strtofloat(grid.cells[i,j]);
       end;
      for i:=1 to x do
      begin
         if (grid.cells[i,y+1]='') then
         begin
           grid.cells[i,y+1]:='0';
           sale[i-1]:=0;
         end
         else
           sale[i-1]:=strtofloat(grid.cells[i,y+1]);
      end;
      for j:=1 to y do
      begin
         if (grid.cells[x+1,j]='') then
         begin
           grid.cells[x+1,j]:='0';
           produce[j-1]:=0;
         end
         else
           produce[j-1]:=strtofloat(grid.cells[x+1,j]);
      end;
    except
      messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
      have_error:=true;
    end;
    result:=have_error;
  end;
end;

procedure TPettyForm.xbjdraw;
var i,j:byte;
begin
  with gridxbj do
  begin
    left:=(738-(sc+2)*60)div 2;
    top:=100+((8-pc)*10);
    width:=(sc+2)*60;
    height:=(pc+2)*26;
    colcount:=sc+2;
    rowcount:=pc+2;
    cells[0,0]:='产＼销';
    for i:=1 to sc do for j:=1 to pc do
      cells[i,j]:='';
    for i:=1 to sc do
    begin
      cells[i,0]:=inttostr(i);
      cells[i,pc+1]:=floattostr(sale[i-1]);
    end;
    for j:=1 to pc do
    begin
      cells[0,j]:=inttostr(j);
      cells[sc+1,j]:=floattostr(produce[j-1]);
    end;
    cells[0,pc+1]:='销量Bi';
    cells[sc+1,0]:='产量Ai';
  end;
  button2.enabled:=true;
  button3.enabled:=false;
end;
procedure TPettyForm.zdfydraw;
var i,j:byte;
begin
    gridzdfy1.colcount:=sc+1;
    gridzdfy1.rowcount:=pc+1;
    gridzdfy1.cells[0,0]:='产＼销';
    gridzdfy2.colcount:=sc+1;
    gridzdfy2.rowcount:=pc+1;
    gridzdfy2.cells[0,0]:='Ai＼Bi';
    for i:=1 to sc do for j:=1 to pc do
    begin
      gridzdfy1.cells[i,j]:='';
      gridzdfy2.cells[i,j]:='';
    end;
    for i:=1 to sc do
    begin
      gridzdfy1.cells[i,0]:=inttostr(i);
      gridzdfy2.cells[i,0]:=floattostr(sale[i-1]);
    end;
    for j:=1 to pc do
    begin
      gridzdfy1.cells[0,j]:=inttostr(j);
      gridzdfy2.cells[0,j]:=floattostr(produce[j-1]);
    end;
    for i:=1 to sc do for j:=1 to pc do
    begin
      gridzdfy1.cells[i,j]:=floattostr(c[j-1,i-1]);
      gridzdfy2.cells[i,j]:='';
    end;
  button4.enabled:=true;
  button5.enabled:=false;
end;
procedure TPettyForm.cedraw;
var i,j:byte;
begin
    gridce1.colcount:=sc+1;
    gridce1.rowcount:=pc+1;
    gridce1.cells[0,0]:='行＼列差';
    gridce2.colcount:=sc+1;
    gridce2.rowcount:=pc+1;
    gridce2.cells[0,0]:='产＼销';
    for i:=1 to sc do for j:=1 to pc do
    begin
      gridce1.cells[i,j]:='';
      gridce2.cells[i,j]:='';
    end;
    for i:=1 to sc do
    begin
      gridce1.cells[i,0]:='';
      gridce2.cells[i,0]:=floattostr(sale[i-1]);
    end;
    for j:=1 to pc do
    begin
      gridce1.cells[0,j]:='';
      gridce2.cells[0,j]:=floattostr(produce[j-1]);
    end;
    for i:=1 to sc do for j:=1 to pc do
    begin
      gridce1.cells[i,j]:=floattostr(c[j-1,i-1]);
      gridce2.cells[i,j]:='';
    end;
  button6.enabled:=true;
  button7.enabled:=false;
end;
procedure TPettyForm.stepdraw;
var i,j:byte;
begin
    edit1.text:='';
    gridstep1.colcount:=sc+1;
    gridstep1.rowcount:=pc+1;
    gridstep1.cells[0,0]:='产\销';
    gridstep2.colcount:=sc+1;
    gridstep2.rowcount:=pc+1;
    gridstep2.cells[0,0]:='Ai\Bi';
    for i:=1 to sc do for j:=1 to pc do
    begin
      gridstep1.cells[i,j]:='';
      gridstep2.cells[i,j]:='';
    end;
    for i:=1 to sc do
    begin
      gridstep1.cells[i,0]:='';
      gridstep2.cells[i,0]:=floattostr(sale[i-1]);
    end;
    for j:=1 to pc do
    begin
      gridstep1.cells[0,j]:='';
      gridstep2.cells[0,j]:=floattostr(produce[j-1]);
    end;
    for i:=1 to sc do for j:=1 to pc do
      if (ma1[j-1,i-1]>=0) then
      begin
        gridstep1.cells[i,j]:=floattostr(c[j-1,i-1]);
        gridstep2.cells[i,j]:=floattostr(ma1[j-1,i-1]);
      end;
end;

function check_input:byte;
                        //1->  无问题
                        //2->  产销不平衡
                        //3->  输入有误
var i,j:byte;
    x,y:byte;
    pcount,scount:real;
    have_error:byte;
begin
  with pettyform do
  begin
    x:=spinedit2.Value;
    y:=spinedit1.value;
  end;
  have_error:=1;
  pcount:=0;
  scount:=0;
  try
    for i:=1 to x do
    begin
       if (pettyform.grid.cells[i,y+1]<>'') then
         scount:=scount+strtofloat(pettyform.grid.cells[i,y+1]);
    end;
    for j:=1 to y do
    begin
       if (pettyform.grid.cells[x+1,j]<>'') then
         pcount:=pcount+strtofloat(pettyform.grid.cells[x+1,j]);
    end;
    if (scount<>pcount) then have_error:=2;
  except
    have_error:=3;
  end;
  result:=have_error;
end;

procedure TPettyForm.do_balance;
var i,j,k:byte;
    x,y:byte;
    pcount,scount:real;
begin
  messagedlg('产销不平衡，先增加虚拟点。',mtinformation,[mbok],0);
  x:=spinedit2.Value;  //  sc
  y:=spinedit1.value;  //  pc
  pcount:=0;
  scount:=0;
  try
    for i:=1 to x do
      begin
       if (grid.cells[i,y+1]<>'') then
         scount:=scount+strtofloat(pettyform.grid.cells[i,y+1]);
      end;
    for j:=1 to y do
      begin
       if (grid.cells[x+1,j]<>'') then
         pcount:=pcount+strtofloat(pettyform.grid.cells[x+1,j]);
      end;
    if (scount>pcount) then
    begin
      if (y>=8) then
         messagedlg('由于产地数已达到了8个，无法再增加虚发点。'+chr(13)
                +'请将该问题移到大项目部分计算。',mterror,[mbok],0)
      else
      begin
        y:=y+1;  spinedit1.value:=y;
        with grid do
        begin
          rowcount:=y+2;
          cells[0,y]:=inttostr(y);
          cells[0,y+1]:='销量Bi';
          for k:=1 to x do
          begin
            cells[k,y+1]:=cells[k,y];
            cells[k,y]:='0';
          end;
          cells[x+1,y]:=floattostr(scount-pcount);
        end;
      end;
    end
    else if (scount<pcount) then
    begin
       if (x>=8) then
         messagedlg('由于销地数已达到了8个，无法再增加虚收点。'+chr(13)
                +'请将该问题移到大项目部分计算。',mterror,[mbok],0)
       else
       begin
        x:=x+1;  spinedit2.value:=x;
        with grid do
        begin
          colcount:=x+2;
          cells[x,0]:=inttostr(x);
          cells[x+1,0]:='产量Ai';
          for k:=1 to y do
          begin
            cells[x+1,k]:=cells[x,k];
            cells[x,k]:='0';
          end;
          cells[x,y+1]:=floattostr(pcount-scount);
        end;
       end;
    end;
  except
    messagedlg('数据有误，请检查一下您的输入。',mterror,[mbok],0);
  end;
end;

procedure TPettyForm.Button1Click(Sender: TObject);
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 radiobutton1.checked then
        init_type:=1    //西北角法
      else if radiobutton2.checked then
        init_type:=2    //最低费用法
      else init_type:=3;   //运费差额法，默认
      if (not get_input) then
      begin
        panel1.SendToBack;
        panel1.visible:=false;
        case init_type of
          1: begin
             panel2.BringToFront;
             panel2.visible:=true;
             xbjdraw;
           end;
          2: begin
             panel3.BringToFront;
             panel3.visible:=true;
             zdfydraw;