📄 lpmain.pas
字号:
unit lpmain;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, StdCtrls, ExtCtrls, ComCtrls, Grids,
delglobe,startopen,{}
deltlqua, Buttons;
{var dd:integer;}
const min=0.0001;
type
{ arraytype=array [1..10] of Tlabel;}
Tmain = class(TForm)
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
L1: TMenuItem;
O1: TMenuItem;
T1: TMenuItem;
C1: TMenuItem;
H1: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
N14: TMenuItem;
readfromfiledlg: TOpenDialog;
N16: TMenuItem;
N17: TMenuItem;
StringGrid1: TStringGrid;
StringGrid2: TStringGrid;
StringGrid3: TStringGrid;
Label1: TLabel;
StringGrid4: TStringGrid;
Label2: TLabel;
Button1: TButton;
SaveDialog1: TSaveDialog;
Label3: TLabel;
Label4: TLabel;
N19: TMenuItem;
N20: TMenuItem;
N21: TMenuItem;
N22: TMenuItem;
N15: TMenuItem;
N24: TMenuItem;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
SpeedButton3: TSpeedButton;
SpeedButton4: TSpeedButton;
SpeedButton5: TSpeedButton;
SpeedButton6: TSpeedButton;
SpeedButton7: TSpeedButton;
SpeedButton8: TSpeedButton;
SpeedButton9: TSpeedButton;
SpeedButton10: TSpeedButton;
SpeedButton11: TSpeedButton;
SpeedButton12: TSpeedButton;
procedure N2Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure N17Click(Sender: TObject);
procedure StringGrid4MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid4SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure StringGrid3SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure Label2Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure showfiledata;
procedure readfromfile;
procedure StringGrid2SelectCell(Sender: TObject; ACol, ARow: Integer;
var CanSelect: Boolean);
procedure StringGrid1KeyPress(Sender: TObject; var Key: Char);
procedure N18Click(Sender: TObject);
procedure StringGrid4MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid3MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid1MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure StringGrid2MouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure N19Click(Sender: TObject);
procedure L1Click(Sender: TObject);
procedure FormClick(Sender: TObject);
procedure N20Click(Sender: TObject);
procedure N21Click(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N13Click(Sender: TObject);
procedure N15Click(Sender: TObject);
procedure N24Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure SpeedButton3Click(Sender: TObject);
procedure SpeedButton7Click(Sender: TObject);
procedure SpeedButton4Click(Sender: TObject);
procedure SpeedButton5Click(Sender: TObject);
procedure SpeedButton6Click(Sender: TObject);
procedure SpeedButton10Click(Sender: TObject);
procedure SpeedButton11Click(Sender: TObject);
procedure SpeedButton12Click(Sender: TObject);
procedure SpeedButton9Click(Sender: TObject);
procedure SpeedButton8Click(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure N1Click(Sender: TObject);
procedure N14Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
const
bigm=1000000;{用来代表M}
var
main: Tmain;
f:text;{文件类型}
rgbnum,rgbnumtime,mainchoose:integer;
backupvarnum:integer;
jieduan1,jieduan2:boolean;
bigques:boolean;{当前是否为大问题}
havedata:boolean;{判断当前是否有数据}
datafromfile:boolean;{表示当前的数据是从文件中读取的}
startx,starty:integer;{表示鼠标的位置，用来控制数值输入窗口的开始位置}
step:integer;{表示算的是第几步}
totalcontrol,totalcontrol2:integer;{用来控制每一步计算的变量}
usef6,usef7,usef8:boolean;{标明按的是F6,F7还是F8，
F6表示直接出结果，F7表示一个数一个数的算，F8表示一块一块的算}
{ createtime:boolean;}
{ justshow:boolean;}{表示是否刚刚换了}
biaonum:integer;{表示正在算的是哪个表}
currentbiaonum:integer;{表示回退到哪张表}
{ dddd:boolean;}
basevar:array [1..50] of integer;{记录基变量的位置}
{********************************************}
arraygrid1:array[0..100,0..50]of string; {used in lmdfxmainmain 备份最优解时的agrid1}
arraygrid2:array[0..50]of string; {used in lmdfxmainmain 备份最优解时的bdagrid1}
arraygrid3:array[0..100]of string; {used in lmdfxmainmain 备份最优解时的czgrid1}
arraygrid4:array[0..100]of string; {used in lmdfxmainmain 备份最优解时的xigrid1}
b_value_array:array[0..50]of string; {used in lmdfxmainmain 备份最优解时的cxbgrid1中的b的值}
bptiaojianarr,bptiaojian1arr:array[1..100]of integer;
{********************************************}
c1,c,c01,ccopy:ccp; {线性规划结构的定义}
a1,a:aap;
xb1,b1,b:tcbp;
tiaojian,tiaojian1:ttiaojianp;
{线性规划结构的定义}
bzh,typeoffx:string[3];{用于向文件中写入信息}
{ m,n,ntj:integer;
ntj0,n0,m0:integer;}
i,j:integer;
m0:integer;{记录添加的变量数}
{ c1:ccp;
xb1,b1:tcbp;
a1:aap;}
{ sel_t:boolean;}
nameoffileofown,nameoffile:string;{文件名}
canceloperate:boolean;{表示取消了修改文件名的操作}
thesamename:boolean;{表示要把同名的文件修改}
datachange,datachange1,datachange2:boolean;{表示数据是否已经修改过}
filedata:boolean;{表示数据是从文件中读取的}
standardornot:boolean;{标识是否要标准化，在二阶段法是不要标准化}
originvarnum,originleashnum:integer;{记录上一次的变量数}
tiaojianx,tiaojianvar,tiaojianequal:array [1..100] of TLabel;{动态生成X的属性的标签}
tiaojianequalarr:array [1..100] of integer;{用来记录X的属性}
tiaojianfree:boolean;{表示动态生成的标签是否被释放过}
tiaojianpos:integer; {控制标签的位置}
tiaojian1x,tiaojian1var,tiaojian1equal:array [1..100] of TLabel;{动态生成X的属性的标签}
tiaojian1equalarr:array [1..100] of integer;{用来记录X的属性}
tiaojian1free:boolean;{表示动态生成的标签是否被释放过}
tiaojian1pos:integer; {控制标签的位置}
tiaojian2x,tiaojian2var,tiaojian2equal:array [1..100] of TLabel;{动态生成X的属性的标签}
tiaojian2equalarr:array [1..100] of integer;{用来记录X的属性}
tiaojian2free:boolean;{表示动态生成的标签是否被释放过}
tiaojian2pos:integer; {控制标签的位置}
top_num:integer;{记录生成指针label的高度}
{currentx,currenty:integer;}{记录当前点击的CELL}
sele:boolean;{识别是否选择了变量}
adjust:integer;{用以调整GRID的宽度}
roww,colw:integer;{用户提供的行宽和列宽}
which_in_form:integer;
leashnum,varnum:integer;{分别 是约束条件和变量数}
afteraddnum:integer;{标准化时未加剩余变量前的变量数}
objtype:string[3];{目标函数的类型}
mouseinput,selecell:boolean;
docalculate:boolean;{识别是否是生成新界面，是”真“时要生成}
whichcellx,whichcelly,whichgrid:integer;{区分鼠标单击的是那一个对象}
defaultwidth:integer;{控制GRID的宽度}
prestep:boolean;{表示是否处在回退的状态}
bound,modulus,right,value:boolean;{表明用户选择了那些要求}
studymode:boolean;{真时表示是在学习模式下}
firstrun:boolean;
multi:boolean;{判断是否有多重解}
unbound:boolean;{标识无界解}
notsave:boolean;{judge current whether is saved}
yanshi:boolean;{表示演示}
add_num:array[1..50] of integer;{记录增加后变量的变量数}
old_num:array[1..50] of integer;{记录要增加变量的变量数}
xorder:array [1..50] of string;{记录最优解中的X变量}
xvalue:array [1..50] of string;{记录最优解中的X的值}
//*************************************************
lmdfxarr:array[0..2] of char;{记录对什么变量进行灵敏度分析}
//*************************************************
implementation
uses {inputdata,} leashinput, calform, lpdchxing, changecol,
ftiaojian, duiou, xinxi;
{手工输入变量} {鼠标输入数值} {计算单纯形表} {改变对象的宽度}
{$R *.DFM}
procedure writeorigin;{向文件中写入数据}
{var f:text;m:integer;}
begin
try
assignfile(f,nameoffile);
rewrite(f);
{$I-}Writeln(f,'ORG');
write(f,objtype:3,varnum:3,leashnum:3);
writeln(f);
{----写入c[i]---}
For i:=1 to varnum do
begin
write(f,C^[i].num:8:2) ;
end;
writeln(f);
For i:=1 to varnum do
begin
c^[i].att:=trim(c^[i].att);
c^[i].att:=concat(c^[i].att,' ');
write(f,C^[i].att:3);
end;
writeln(f);
{----写入a[i,j]--}
For j:=1 to leashnum do
begin
For i:=1 to varnum do write(f,A^[j,i]:8:2);
writeln(f);
End;
{-------------写入TiaoJian-------------------}
for j:=1 to leashnum do
begin
tiaojian^[j]:=trim(tiaojian^[j]);
tiaojian^[j]:=concat(tiaojian^[j],' ');
Write(f,TiaoJian^[j]:3);
end;
Writeln(f);
{-----b[i]--}
For i:=1 to leashnum do write(f,B^[i]:8:2);
writeln(f);{$I+}
system.close(f);
thesamename:=false;{恢复程序原来的状态}
except
showmessage('对不起，写文件时有错误，请检查是否有写文件的权限');
end;
end;
procedure Tmain.readfromfile;{从文件中读数据}
begin
if not notsave then
begin
try
assignfile(f,nameoffile);
Reset(f);
new(c);
new(a);
new(b);
new(tiaojian);
Readln(f,BZH);
readln(f,typeofFx,varnum,leashnum);
if (varnum>8)or(leashnum>8) then
bigques:=true
else
bigques:=false;
objtype:=typeoffx;
For i:=1 to varnum do
read(f,c^[i].num);
readln(f);
For i:=1 to varnum do
read(f,c^[i].att);
readln(f);
{----a[i,j]--}
For i:=1 to leashnum do
begin
For j:=1 to varnum do
read(f,a^[i,j]);
readln(f);
End;
{---------TiaoJian----------------}
For j:=1 to leashnum Do
begin
Read(f,TiaoJian^[j]);
tiaojian^[j]:=tiaojian^[j];
end;
readln(f);
{-----b[i]--}
For i:=1 to leashnum do read(f,B^[i]);
readln(f);
system.Close(f);
except
showmessage('读取文件时发生错误');
end;
end;{if not notsave}
end;
Procedure tlBiaoZhunhua;{将原文件标准化}
Var
ok,j,i,k,l:integer;{OK基本上没有什么用}
begin
new(xb1);
For i:=1 to leashnum do {TO AVOID B<0}
if b^[i]<0 then {如果b小于0 那么将其变为大于0的形式}
begin
for j:=1 to varnum Do a^[i,j]:=(-1)*a^[i,j];
b^[i]:=(-1)*b^[i];
if trim(tiaojian^[i])='>=' then {changenew}
tiaojian^[i]:=' <=';
if trim(tiaojian^[i])='<=' then
tiaojian^[i]:='>= ';
end;
{*********计算变量中有正负不限的情况**********}
m0:=0;
l:=0;
for i:=1 to varnum do
begin
old_num[i]:=0;
add_num[i]:=0;
end;
for i:=1 to varnum do {找出正负不限的个数}
if trim(c^[i].att)='<=>' then
begin
inc(m0);{如果有X的属性是正负不限，则加一个变量}
l:=l+1;
old_num[l]:=i;
end;
afteraddnum:=varnum+m0;
for i:=1 to m0 do
begin
add_num[2*i-1]:=old_num[i]+i-1;
add_num[2*i]:=old_num[i]+i;
end;
i:=m0+varnum;
ok:=i; {此时ok中为增加后的变量X数}
for k:=varnum downto 1 do
begin
if trim(c^[k].att)<>'<=>' then{如果不是正负不限，则向后移动，给添加的其他变量留出位置}
begin
for j:=1 to leashnum do a^[j,i]:=a^[j,k]; {j为列，k为行}
c^[i]:=c^[k];
end
else{如果是正负不限，则加一个’}
begin
for j:=1 to leashnum do
begin
a^[j,i]:=(-1)*a^[j,k];{将当前列的a变为其的相反数}
a^[j,i-1]:=a^[j,k]; {前一列不变}
end;
c^[i].att:='>= ';c^[i].num:=c^[k].num*(-1);
dec(i);c^[i]:=c^[k];{c^[i].num:=c^[i].num*(-1);c^[k].num:=c^[k].num*(-1)}{mostmost}
end;
dec(i);
end; {end of k:=varnum downto1 do}
for i:=m0+varnum downto 1 do{将X变为-X}
if trim(c^[i].att)='<=' then
begin
for j:=1 to leashnum do a^[j,i]:=(-1)*a^[j,i];
c^[i].num:=c^[i].num*(-1);
end;
for i:=1 to leashnum do xb1^[i]:=0;{没有什么用}
// k:=0;
// for i:=1 to leashnum do {当条件不是>=0时，要加一个变量}
// if trim(tiaojian^[i])='<=' then
// else
// k:=k+1;
for i:=1 to leashnum do {添加剩余变量 }
if trim(tiaojian^[i])='>=' then
begin
inc(m0);
c^[m0+varnum].att:='SYB';c^[m0+varnum].num:=0;
for j:=1 to leashnum do a^[j,m0+varnum]:=0;
a^[i,m0+varnum]:=-1;
end
else
if trim(tiaojian^[i])='<=' then
begin {添加松弛变量}
inc(m0);
c^[m0+varnum].att:='SCB';
c^[m0+varnum].num:=0;
for j:=1 to leashnum do a^[j,m0+varnum]:=0;
a^[i,m0+varnum]:=1;
xb1^[i]:=m0+varnum;
end;
for i:=1 to leashnum do {添加人工变量}
if (trim(tiaojian^[i])='>=') or (trim(tiaojian^[i])='=') then
begin
inc(m0);
for j:=1 to leashnum do a^[j,m0+varnum]:=0;
c^[m0+varnum].num:=bigm;c^[m0+varnum].att:='RGB';
a^[i,m0+varnum]:=1;xb1^[i]:=m0+varnum;
end;
if typeoffx='Min' then{如果是最小化的问题，将目标函数改变}
for i:=1 to m0+varnum do c^[i].num:=(-1)*c^[i].num;
afteraddvarnum:=m0+varnum;
End; {of biaozhunhua}
procedure Tmain.N2Click(Sender: TObject); {手工输入菜单}
var labnum,labnum2:integer;
begin
//image1.visible:=false;
docalculate:=true;
filedata:=false;
nameoffile:='';
leashin.show;
end;
procedure Tmain.N6Click(Sender: TObject); {关闭程序菜单}
begin
close;
end;
procedure Tmain.FormCreate(Sender: TObject);
var currentTime:longint;
begin
{createtime:=true;}
//startopenform.show;
answer:=false;
currentTime:=gettickcount div 1000;
while((gettickcount div 1000)<(currenttime+3))do
begin
{此处语句为空}
end;
firstrun:=true;
bound:=true;
varnum:=3;
leashnum:=3;
nameoffile:='';
top:=1;
left:=1;
originvarnum:=0;
originleashnum:=0;
sele:=false;
selecell:=false;
colw:=60;
roww:=24;
adjust:=7;
stringgrid1.DefaultColWidth :=colw;
stringgrid1.DefaultRowHeight:=roww;
stringgrid2.DefaultColWidth :=colw;
stringgrid2.DefaultRowHeight:=roww;
stringgrid3.DefaultColWidth :=colw;
stringgrid3.DefaultRowHeight:=roww;
stringgrid4.DefaultColWidth :=colw;
stringgrid4.DefaultRowHeight:=roww;
defaultwidth:=40
end;
procedure Tmain.FormActivate(Sender: TObject);
var i,ij:integer;
enter_num:integer;{记录生成label的回车数}
begin
stringgrid1.ScrollBars :=ssnone;
stringgrid2.ScrollBars :=ssnone;
stringgrid3.ScrollBars :=ssnone;
stringgrid4.ScrollBars :=ssnone;
if (varnum<>0) and (leashnum<>0) then
begin
biaonum:=1;
calculate.hide;
leashin.hide;
if sele and docalculate then
begin
leashin.hide;
stringgrid1.ColCount :=varnum+1;
stringgrid1.rowcount:=leashnum+1;
if (not tiaojianfree) then {表示条件的标签如果没有释放，就释放掉}
begin
for i:=1 to originvarnum do
begin
tiaojianx[i].visible:=false;
tiaojianvar[i].visible:=false;
tiaojianequal[i].visible:=false;
tiaojianx[i].free;
tiaojianvar[i].free;
tiaojianequal[i].free;
label3.visible:=false;
label4.visible:=false;
end;
tiaojianfree:=true;
end;{表示条件的标签如果没有释放，就释放掉}
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -