lpdchxing.pas

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

procedure Tdchxingform.readcbx;       {将表cxbgrid2清空}
var i:integer;
begin
          with cxbgrid2 do
                    for i:=0 to rowcount-1 do
                        begin
                         cells[0,i]:='';
                         cells[1,i]:='';
                         cells[2,i]:='';
                        end;

end;

procedure Tdchxingform.FormCreate(Sender: TObject);

begin
     biaonum:=1;
     backbiaonum:=1;
     currentbiaonum:=1;
     totalcontrol:=1;
     totalcontrol2:=1;
     jisuan_over:=false;
     step:=1;
     usef6:=false;
end;

{*******************************************}
function Tdchxingform.getmstrofobj:string;
var i:integer;modulusofm,modulusofvalue:extended;
begin{返回目标函数的值，是一个表达式}
     modulusofm:=0;
     modulusofvalue:=0;
     for i:=1 to afterleashnum do
         if cb[i]=-bigm then
             if biaonum=1 then
             modulusofm:=modulusofm+b^[i]
             else
             modulusofm:=modulusofm+b1^[i]
         else
             if biaonum=1 then
             modulusofvalue:=modulusofvalue+cb[i]*b^[i]
             else
             modulusofvalue:=modulusofvalue+cb[i]*b1^[i];
         modulusofm:=(-1)*modulusofm;
         if modulusofm=0 then
              getmstrofobj:=floattostr(modulusofvalue)
         else
         begin
              if modulusofvalue<0 then
              getmstrofobj:=floattostr(modulusofm)+'M'+floattostr(modulusofvalue)
              else
              getmstrofobj:=floattostr(modulusofm)+'M'+'+'+floattostr(modulusofvalue);
         end;

end;
{****************************************}
procedure Tdchxingform.objvalue;{计算目标函数值}

begin
           statusbar1.panels[1].text:='OBJ=C1*B1+C2*B2+...+Ci*Bi+...(i=1,2,...,m)';
      repeat
           if biaonum=1 then
            objanswer:=objanswer+cb[totalcontrol]*b^[totalcontrol]
           else
            objanswer:=objanswer+cb[totalcontrol]*b1^[totalcontrol];
           if biaonum=1 then
           begin
                if studymode then
                   if objedit1.Text<>getmstrofobj then
                      showmessage('目标函数输入错误！');
                objedit1.text:=getmstrofobj;
           end
           else
           begin
                if studymode then
                   if objedit2.Text<>getmstrofobj then
                      showmessage('目标函数输入错误！');
                objedit2.text:=getmstrofobj;
           end;
           totalcontrol:=totalcontrol+1;
      until (totalcontrol=afterleashnum+1){ or usef7};
      totalcontrol:=1;
      totalcontrol2:=1;
      if (usef8=false)  then  {干吗用的？}
      usef7:=false;
      step:=step+1;{计算完目标函数值后要进入下一步}
end;
{***************************************************}
function getmstrofz:string;{这个函数计算Z的表达式}
var i:integer; modulusofm,modulusofvalue:extended;
   {modulusofm 表示M的系数modulusofvalue表示数值的系数}
begin
     modulusofm:=0;
     modulusofvalue:=0;
     for i:=1 to afterleashnum do
         if cb[i]=-bigm then
         begin
              if biaonum=1 then
              modulusofm:=modulusofm+a^[i,totalcontrol]{totalcontrol present the column number}
              else
              modulusofm:=modulusofm+a1^[i,totalcontrol]{totalcontrol present the column number}
         end
         else
             if biaonum=1 then
             modulusofvalue:=modulusofvalue+cb[i]*a^[i,totalcontrol]
             else
             modulusofvalue:=modulusofvalue+cb[i]*a1^[i,totalcontrol];

             modulusofm:=(-1)*modulusofm;
     if modulusofm=0 then
          getmstrofz:=floattostr(modulusofvalue)
     else
     begin
          if modulusofvalue<0 then
          getmstrofz:=floattostr(modulusofm)+'M'+floattostr(modulusofvalue)
          else
          getmstrofz:=floattostr(modulusofm)+'M'+'+'+floattostr(modulusofvalue);
     end;
end;{end of getmstr}
{**************************************************************}
procedure Tdchxingform.calcu_Z_value;{计算z[i]的值}
{上一个函数只是用来显示，这个才是内部的值}
begin
            statusbar1.panels[1].text:='Zj=C1*A1j+C2*A2j+...+Ci*Aij...(i=1,2,...,m)';
   repeat
         repeat{这儿totalcontrol2控制行的变化，totalcontrol控制列的变化}
             if biaonum=1 then
                 z[totalcontrol]:=z[totalcontrol]+cb[totalcontrol2]*a^[totalcontrol2,totalcontrol]
             else                                                {add 2}
                 z[totalcontrol]:=z[totalcontrol]+cb[totalcontrol2]*a1^[totalcontrol2,totalcontrol];
             totalcontrol2:=totalcontrol2+1;
         until  totalcontrol2=afterleashnum+1;{结束时算出一个z的值}
         totalcontrol2:=1;
         if biaonum=1 then{除了刚开始，都要写到第二张表里}
         begin
              if studymode then
                 if czgrid1.Cells [totalcontrol-1,0]<>getmstrofz then
                    showmessage('Z['+inttostr(totalcontrol)+']计算错误！');
         czgrid1.cells[totalcontrol-1,0]:=getmstrofz;
         end
         else
         begin
              if studymode then
                 if czgrid2.Cells [totalcontrol-1,0]<>getmstrofz then
                    showmessage('Z['+inttostr(totalcontrol)+']计算错误！');
         czgrid2.cells[totalcontrol-1,0]:=getmstrofz;
         end;
         totalcontrol:=totalcontrol+1;
         if totalcontrol=afteraddvarnum+1 then
         usef8:=false;
         if (usef8=false) then
         usef7:=false;
   until usef7=false;
   if totalcontrol=afteraddvarnum+1 then
      begin
      step:=step+1;
      totalcontrol:=1;
      totalcontrol2:=1;
      usef8:=true;
      end;
end;{计算Z的值}
{****************************************}
function tdchxingform.getmstrofc_z:string;
var posofm:integer;{得到c-z的表达式}
    value:extended;
    modulusofm:extended;
begin
     if biaonum=1 then
     begin
          posofm:=pos('M',czgrid1.cells[totalcontrol-1,0]);
          value:=strtofloat(copy(czgrid1.cells[totalcontrol-1,0],posofm+1,length(czgrid1.cells[totalcontrol-1,0])));
          if c^[totalcontrol].num<>-bigm then
               begin
               value:=c^[totalcontrol].num-value;
               if copy(czgrid1.cells[totalcontrol-1,0],1,posofm-1)<>'' then
                    if value<0 then
                    getmstrofc_z:=floattostr((-1)*strtofloat(copy(czgrid1.cells[totalcontrol-1,0],1,posofm-1)))+'M'+floattostr(value)
                    else
                    getmstrofc_z:=floattostr((-1)*strtofloat(copy(czgrid1.cells[totalcontrol-1,0],1,posofm-1)))+'M'+'+'+floattostr(value)
                    else
                    getmstrofc_z:=floattostr(value);
               end
          else
               begin
               if copy(czgrid1.cells[totalcontrol-1,0],1,posofm-1)<>'' then
                    modulusofm:=-1-strtofloat(copy(czgrid1.cells[totalcontrol-1,0],1,posofm-1))
               else
                    modulusofm:=-1;
               value:=strtofloat(copy(czgrid1.cells[totalcontrol-1,0],posofm+1,length(czgrid1.cells[totalcontrol-1,0])));
               value:=(-1)*value;
               if modulusofm<>0 then
                    getmstrofc_z:=floattostr(modulusofm)+'M'+floattostr(value)
               else
                    getmstrofc_z:=floattostr(value);

               end;
     end
     else{计算的不是第一张表时}
     begin
          posofm:=pos('M',czgrid2.cells[totalcontrol-1,0]);
          value:=strtofloat(copy(czgrid2.cells[totalcontrol-1,0],posofm+1,length(czgrid2.cells[totalcontrol-1,0])));
          if c^[totalcontrol].num<>-bigm then
             begin
             value:=c^[totalcontrol].num-value;
             if copy(czgrid2.cells[totalcontrol-1,0],1,posofm-1)<>'' then
                  if value<0 then
                  getmstrofc_z:=floattostr((-1)*strtofloat(copy(czgrid2.cells[totalcontrol-1,0],1,posofm-1)))+'M'+floattostr(value)
                  else
                  getmstrofc_z:=floattostr((-1)*strtofloat(copy(czgrid2.cells[totalcontrol-1,0],1,posofm-1)))+'M'+'+'+floattostr(value)
                  else
                  getmstrofc_z:=floattostr(value);
             end
          else{  if c^[totalcontrol].num<>-bigm then}
               begin
               if copy(czgrid2.cells[totalcontrol-1,0],1,posofm-1)<>'' then
               modulusofm:=-1-strtofloat(copy(czgrid2.cells[totalcontrol-1,0],1,posofm-1))
               else
               modulusofm:=-1;
               value:=strtofloat(copy(czgrid2.cells[totalcontrol-1,0],posofm+1,length(czgrid2.cells[totalcontrol-1,0])));
               value:=(-1)*value;
               if modulusofm<>0 then
               getmstrofc_z:=floattostr(modulusofm)+'M'+floattostr(value)
               else
               getmstrofc_z:=floattostr(value);
               end;
     end;
end;

procedure Tdchxingform.freshscreen1;{二阶段法中的第一阶段完成后的屏幕刷新}
var i,j:integer;
begin
     bpafteraddvarnum:=afteraddvarnum;

     c^:=ccopy^;
{**********************将所有表2清空，移向表1***************似乎有问题？？？***}
     for i:=1 to afterleashnum do
     begin
         cb[i]:=c^[basevar[i]].num;
         cxbgrid1.Cells [0,i]:=floattostr(cb[i]);
         cxbgrid1.Cells [1,i]:='X'+floattostr(basevar[i]);
     end;
     for i:=1 to afterleashnum do
         for j:=0 to 1 do
           cxbgrid2.cells[j,i-1]:='';
     for i:=1 to afteraddvarnum do
         for j:=1 to afterleashnum do
             if biaonum>1 then
              a^[j,i]:=a1^[j,i];
     for i:= 1 to afterleashnum do
         if biaonum>1 then
         b^[i]:=b1^[i];
     for i:=1 to afteraddvarnum do
         for j:=1 to afterleashnum do
           begin
             agrid1.Cells[i-1,j-1]:=floattostr(a^[j,i]);
             agrid2.cells[i-1,j-1]:='';
           end;
     for i:=1 to afterleashnum do
       begin
         cxbgrid1.cells[2,i]:=floattostr(b^[i]);
         cxbgrid2.cells[2,i-1]:='';
       end;
     for i:=0 to afteraddvarnum-1 do
         begin
         czgrid1.cells[i,0]:='';{floattostr(z[i+1])}
         czgrid1.cells[i,1]:='';{floattostr(c_z[i+1])}

         czgrid2.cells[i,0]:='';
         czgrid2.cells[i,1]:='';
         end;
     for i:=0 to afterleashnum-1 do
         begin
         bdagrid1.Cells [0,i+1]:='';
         bdagrid2.Cells [0,i]:='';
         end;
     objvalue;
     objedit1.text:=floattostr(objanswer);
     objedit2.text:='';
           begin
                  afteraddvarnum:=afteraddvarnum-rgbnum;
                  xigrid1.Width :=xigrid1.Width -(defaultwidth+1)*rgbnum;
                  agrid1.Width :=agrid1.Width -(defaultwidth+1)*rgbnum;
                  czgrid1.Width :=czgrid1.Width -(defaultwidth+1)*rgbnum;
                  agrid2.Width :=agrid2.Width -(defaultwidth+1)*rgbnum;
                  czgrid2.Width :=czgrid2.Width -(defaultwidth+1)*rgbnum;
                  bdagrid1.left:=bdagrid1.left-(defaultwidth+1)*rgbnum;
                  bdagrid2.left:=bdagrid2.left-(defaultwidth+1)*rgbnum;
           end;
     with xigrid1 do
           for i := 1 to afteraddvarnum do
              cells[i-1,1]:=floattostr(c^[i].num);

           button1.Enabled :=false;
           button5.Enabled :=true;
           if not studymode then
           button3.Enabled :=true;
           button2.Enabled :=false;
           button6.Enabled :=false;
     biaonum:=1;
     step:=1;
end;

procedure Tdchxingform.calcu_c_z_value;{计算c-z[i]的值}
var i:integer;
begin
            statusbar1.panels[1].text:='Cj-Zj=Cj-C1*A1j+C2*A2j+...+Ci*Aij...(i=1,2,...,m)';
      repeat
            c_z[totalcontrol]:=c^[totalcontrol].num-z[totalcontrol];
            z[totalcontrol]:=0;
            if biaonum=1 then
            begin
               if studymode then
                 if czgrid1.Cells [totalcontrol-1,1]<>getmstrofc_z then
                    showmessage('C['+inttostr(totalcontrol)+']-Z['+inttostr(totalcontrol)+']计算错误！');
            czgrid1.cells[totalcontrol-1,1]:=getmstrofc_z;
            end
            else
            begin
               if studymode then
                 if czgrid1.Cells [totalcontrol-1,1]<>getmstrofc_z then
                    showmessage('C['+inttostr(totalcontrol)+']-Z['+inttostr(totalcontrol)+']计算错误！');
            czgrid2.cells[totalcontrol-1,1]:=getmstrofc_z;
            end;

            totalcontrol:=totalcontrol+1;
            if totalcontrol=afteraddvarnum+1 then
            usef8:=false;
            if usef8=false then
            usef7:=false;
      until usef7=false;
      if  totalcontrol>afteraddvarnum then
      begin
      totalcontrol:=1;
      step:=step+1;
      usef8:=true;
      end;
      for i:=1 to afteraddvarnum do
       if biaonum=1 then
           bpc_zarr[i]:=czgrid1.cells[i-1,1]
       else
           bpc_zarr[i]:=czgrid2.cells[i-1,1];


end;

procedure Tdchxingform.choosezhulie;{选择主列}
var i,j:integer;
    rgvarexit:boolean;

begin  maxc_z:=-32760;
       zhulie:=0;
       statusbar1.panels[1].text:='入变量=Max[Cj-Zj>0](j=1,2,...,N)';
       for i:=1 to afteraddvarnum do
       begin
       if judge_basevar(i)=false then
          begin
                if (c_z[i]>0)and(C_Z[i]>maxc_z) then
                   begin
                   maxc_Z:=c_z[i];