lpdchxing.pas

线性规划CAI应用程序及原代码

unit lpdchxing;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, StdCtrls, ToolWin, ComCtrls, ExtCtrls;

type
  Tdchxingform = class(TForm)
    Splitter1: TSplitter;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    agrid1: TStringGrid;
    cxbGrid1: TStringGrid;
    xiGrid1: TStringGrid;
    bdaGrid1: TStringGrid;
    czGrid1: TStringGrid;
    aGrid2: TStringGrid;
    cxbGrid2: TStringGrid;
    bdaGrid2: TStringGrid;
    czGrid2: TStringGrid;
    objedit1: TEdit;
    objedit2: TEdit;
    Bevel1: TBevel;
    Button1: TButton;
    Button3: TButton;
    Button4: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button5: TButton;
    Button2: TButton;
    Button6: TButton;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label11: TLabel;
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure readcbx;
    procedure FormActivate(Sender: TObject);
    procedure readintogrid;
    procedure findbasevar;
    function judge_basevar(i:integer):boolean;    
    procedure FormCreate(Sender: TObject);
    procedure objvalue;
    procedure calcu_Z_value;
    procedure calcu_c_z_value;
    procedure choosezhulie;{选择主列}
    procedure calcu_A_sijiao(hang,lie:integer);{计算a^[i]的值}
    procedure calcu_B_sijiao(hang,lie:integer);{计算b^[i]的值}
    procedure choosezhuhang;
    procedure freshscreen;
    procedure changejivar;
    procedure Button5Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure FormHide(Sender: TObject);
    function  getmstrofc_z:string;
    function  getmstrofobj:string;
    procedure Button1Click(Sender: TObject);
    procedure saveresult;{将最优解时的答案保存}
    procedure save_table1;
    procedure writeoriginofown;{在保存屏幕时，用自己的过程来写}
    procedure readfromfileofown;
    procedure readfromfileofowngrid2;
    procedure readdatafroma1;
    procedure Button2Click(Sender: TObject);
    procedure judgemultianswer;
    procedure freshscreen1;
    procedure Button6Click(Sender: TObject);
  private
    { Private declarations }
  public
  end;

var
  answer:boolean;
  getresult:boolean;{判断当前是否是得到了最优解}
  begincalculate:boolean;{表示是否开始计算第二张表（在一屏当中）}
  jisuan_over:boolean;
  dchxingform: Tdchxingform;{单纯形窗口}
  zhuhangchoose:boolean;{判断是否选择到了主行}
  fofown:text;{自己定义的文件类型}
  danbu,{单步判断}fenkuai{分块判断}:boolean;
  afteraddvarnum,afterleashnum:integer;  { Public declarations }
{暂定公用变量}
	bpafteraddvarnum:integer;
    bp_old_b:array[1..50]of extended;
    bp_old_a:array[1..50,1..50]of extended;
    z,Cb:array[1..50]of extended;
    bda:array[1..50]of extended; {这三个变量是用来存放单纯形表中的数据的}
    c_z:array [1..100]of extended;
    {**************************************}
    bpc_zarr:array[1..100]of string;
    bpbdaarr:array[1..50]of string;
    bp_array_agrid:array[1..100,1..50]of string;
    bp_array_cxbgrid:array[1..3,1..50]of string;
    bp_array_czgrid:array[1..100,1..2]of string;
    bp_array_bdagrid:array[1..50]of string;
    bp_array_xigrid:array[1..100,1..2]of string;
    bp_obj:string;
    savec_z,savez:array [1..100] of string;{}
    more_key:array[1..100]of integer;{记录出现多重解的列数}
    saveobj:string;
    {cxvarnum:array[1..10]of integer;}
    minbda,MAXc_z:extended;{分别用来存放bda 的最小值和c-z的最大值}
    objanswer:extended;{目标函数值}
    zhulie,zhuhang:integer;{表示主行主列的位置}
    rgvarexitjieduan:boolean;{表示二阶段中第一阶段运算完成后是否还有人工变量}
    filenum,bp_filenum:integer;
    bestanswer:boolean;{是否达到了最优解}
    duojiechoose:boolean;{是否在多解情况下}
    duojienumber:integer;{记录当前多解数}
    nowrite:boolean;{true present have no right to write，在写文件是可能没有权限}
    backbiaonum:integer;{保存返回时的当前表的号码}
implementation

uses lpmain, leashinput,result, lmdfx;

{$R *.DFM}
procedure Tdchxingform.judgemultianswer;{判断是否有多重解}
var i,j,k,l:integer;
    is_basevar:boolean;
begin
     multi:=false;
     duojiechoose:=false; 
     { for i:=1 to afteraddvarnum do}
     i:=1;
     j:=0;
     l:=0;
     repeat
          begin
          if czgrid2.cells[i-1,1]='0' then
          begin
              j:=j+1;
              if j>leashnum then
              multi:=true;
              is_basevar:=false;
              for k:=1 to leashnum do             {判断是否是基变量}
                  begin
                       if i=basevar[k]then is_basevar :=true
                  end;
              if is_basevar=false then
              begin
              l:=l+1;
              more_key[l]:=i;
              end;
          end;
          end;
     i:=i+1;
     until (i=afteraddvarnum+1) ;
     if multi then
     if MessageDlg('该问题有多重解,是否查看其他解？',
        mtConfirmation, [mbYes, mbNo], 0) = mrYes then
        begin
        for i:=1 to l do
        begin
        duojienumber:=i;
        duojiechoose:=true;
        bestanswer:=false;
        button5.Enabled :=true;
        if not studymode then
        button3.Enabled :=true;
        if duojiechoose then zhulie:=more_key[duojienumber];
        if biaonum=1 then
        step:=4
        else
        step:=7;
        bestanswer:=false;
        jisuan_over:=false;
        end;
        end
        else
        begin
        multi:=false;
        end;
end;
procedure Tdchxingform.saveresult;{将最优解时的答案保存}
var i,j:integer;
begin
     nameoffileofown:='temp_result'+'.tem';
     assignfile(fofown,nameoffileofown);
     if fileexists(nameoffileofown) then
     deletefile(nameoffileofown);
     rewrite(fofown);
     try
        writeln(fofown);
        write(fofown,'最终结果表单保存如下：');
        writeln(fofown);
        for i:=1 to afteraddvarnum do    {系数c的值}
            begin
            write(fofown,xigrid1.cells[i-1,1]:8);{C^[i].num:8:2}{因为不用在grid2中写c的值，故不保存，写0}
            write(fofown,',');
//            writeln(fofown);
            end;
        writeln(fofown);
        writeln(fofown,'*****************以上为系数c****************');
        writeln(fofown);

     For j:=1 to afterleashnum do
        begin
             For i:=1 to afteraddvarnum do{grid中的第一个参数代表列的值，而且是从0开始}
                 begin
                 write(fofown,agrid2.cells[i-1,j-1]:8);
                 write(fofown,',');
  //               writeln(fofown);
                 end;
             writeln(fofown);
             writeln(fofown,'系数a的'+inttostr(j)+'行的值');
             writeln(fofown);
        End;
        writeln(fofown);
     writeln(fofown,'*****************以上为系数a****************');
     writeln(fofown);
{     For i:=1 to leashnum do{保存最优解时的b的值，cxbgrid2的第三列}
//          begin
{          write(fofown,cxbgrid2.cells[2,i-1]:8);
          write(fofown,',');

//          writeln(fofown);
          end;
     write(fofown,'*****************以上为系数b****************');
     writeln(fofown);{其实有了下面，上面不用写，只是为了和原来的读文件过程兼容}
     for i:=1 to afterleashnum do
         begin
         write(fofown,cxbgrid2.cells[0,i-1]:8);write(fofown,',');
//         writeln(fofown);
         write(fofown,cxbgrid2.cells[1,i-1]:8);write(fofown,',');
//         writeln(fofown);
         write(fofown,cxbgrid2.cells[2,i-1]:8);write(fofown,',');
//       writeln(fofown);
        writeln(fofown);
         writeln(fofown,'以上为单纯型表中B'+inttostr(i)+'所在的行的值');
         end;
        writeln(fofown);
     writeln(fofown,'*****************以上为表cxbgrid2的值****************');
     writeln(fofown);
     write(fofown,objedit2.text);
     writeln(fofown);
     writeln(fofown,'*****************以上为目标函数值****************');
     writeln(fofown);
     for i:=1 to afteraddvarnum do
         begin      {保存z和c-z}
         write(fofown,czgrid2.cells[i-1,0]:8);
//         writeln(fofown);
//         write(fofown,czgrid2.cells[i-1,1]);
//         writeln(fofown);
//         write(fofown,'系数X'+inttostr(i)+'对应的z和c-z的值');
//         writeln(fofown);
         write(fofown,',');
         end;
         writeln(fofown);
         writeln(fofown,'系数X对应的z的值');
         writeln(fofown);
     for i:=1 to afteraddvarnum do
         begin
         write(fofown,czgrid2.cells[i-1,1]:8);
         write(fofown,',');
         end;
         writeln(fofown);
         writeln(fofown,'系数X对应的c-z的值');
         writeln(fofown);
     writeln(fofown,'*****************以上为表czgrid2的值****************');
     writeln(fofown);
     for i:=1 to afterleashnum do{保存bda？？？空值}
     begin
         write(fofown,bdagrid2.cells[0,i-1]:8);
         write(fofown,',');
     end;
     writeln(fofown);
     writeln(fofown,'*****************以上为表bdagrid2的值****************');
       finally
     system.close(fofown);
     end;{end of try}

end;{end of saveresult}


procedure Tdchxingform.writeoriginofown;{在保存屏幕时，用自己的过程来写}
var i,j:integer;{这个过程同上一个的主要区别在于grid1和grid2的不同，其他基本上相同，不知道有什么好的方法可以解决，就是省点空间}
begin
      assignfile(fofown,nameoffileofown);
      if fileexists(nameoffileofown) then
      deletefile(nameoffileofown);
      rewrite(fofown);
     try
        for i:=1 to afteraddvarnum do    {系数c的值}
            begin
            write(fofown,xigrid1.cells[i-1,1]:8);{C^[i].num:8:2}{因为不用在grid2中写c的值，故不保存，写0}
            write(fofown,',');
//            writeln(fofown);
            end;
        writeln(fofown);
        writeln(fofown,'*****************以上为系数c****************');
        writeln(fofown);

     For j:=1 to afterleashnum do
        begin
             For i:=1 to afteraddvarnum do{grid中的第一个参数代表列的值，而且是从0开始}
                 begin
                 write(fofown,agrid1.cells[i-1,j-1]:8);
                 write(fofown,',');
  //               writeln(fofown);
                 end;
             writeln(fofown);
             writeln(fofown,'系数a的'+inttostr(j)+'行的值');
             writeln(fofown);
        End;
        writeln(fofown);
     writeln(fofown,'*****************以上为系数a****************');
     writeln(fofown);
{     For i:=1 to leashnum do{保存最优解时的b的值，cxbgrid2的第三列}
//          begin
{          write(fofown,cxbgrid2.cells[2,i-1]:8);
          write(fofown,',');

//          writeln(fofown);
          end;
     write(fofown,'*****************以上为系数b****************');
     writeln(fofown);{其实有了下面，上面不用写，只是为了和原来的读文件过程兼容}
     for i:=1 to afterleashnum do
         begin
         write(fofown,cxbgrid1.cells[0,i]:8);write(fofown,',');
//         writeln(fofown);
         write(fofown,cxbgrid1.cells[1,i]:8);write(fofown,',');
//         writeln(fofown);
         write(fofown,cxbgrid1.cells[2,i]:8);write(fofown,',');
//       writeln(fofown);
        writeln(fofown);
         writeln(fofown,'以上为单纯型表中B'+inttostr(i)+'所在的行的值');
         end;
        writeln(fofown);
     writeln(fofown,'*****************以上为表cxbgrid2的值****************');
     writeln(fofown);
     write(fofown,objedit1.text);
     writeln(fofown);
     writeln(fofown,'*****************以上为目标函数值****************');
     writeln(fofown);
     for i:=1 to afteraddvarnum do
         begin      {保存z和c-z}
         write(fofown,czgrid1.cells[i-1,0]:8);
//         writeln(fofown);
//         write(fofown,czgrid2.cells[i-1,1]);
//         writeln(fofown);
//         write(fofown,'系数X'+inttostr(i)+'对应的z和c-z的值');
//         writeln(fofown);
         write(fofown,',');
         end;
         writeln(fofown);
         writeln(fofown,'系数X对应的z的值');
         writeln(fofown);
     for i:=1 to afteraddvarnum do