程序转换问题(215分)

  • 主题发起人 shihongtai
  • 开始时间
S

shihongtai

Unregistered / Unconfirmed
GUEST, unregistred user!
现在有一个BASIC语言的程序,请将它转为Delphi语言程序,全部大洋奉上。

20 SCREEN 2
30 PF$="配方"
40 CLS
50 KEY OFF:LOCATE 25:pRINT " ";TIME$
60 READ M,N,P
70 CLS
80 LOCATE 25:pRINT " ";TIME$
90 PRINT "计算机输入 "
100 PRINT "原料个数";M,"约束条件个数";N
110 DIM AC$(M),CF$(15),CF(17)
120 PRINT
130 REM 变量数目
140 FOR AB=1 TO M
150 READ AC$(AB):NEXT AB
160 REM 指标数目
170 FOR AB=1 TO 12
180 READ CF$(AB):NEXT AB
190 DIM A(N+3,N+M+1),X(M),L(N+1)
200 DIM B(N+3,N+M+1)
210 PRINT "计算机输入数学模型:"
220 FOR I=2 TO N+1
230 FOR J=1 TO M+2
240 READ A(I,J):B(I,J)=A(I,J)
250 PRINT TAB(6*J);A(I,J);
260 NEXT J
270 PRINT
280 NEXT I
290 FOR I=2 TO N+1
300 FOR J=1 TO M+2
310 LET A(I,J)=A(I,J)*SGN(A(I,M+2))
320 NEXT J
330 NEXT I
340 PRINT
350 PRINT "计算机输入各原料价格: "
360 FOR I=1 TO M
370 READ A(1,I)
380 C(I)=A(1,I)
390 PRINT TAB(6*I);A(1,I);
400 NEXT I
410 PRINT
420 IF A(R,I)-A(R,T)<-E GOTO 1010
430 LET X(S)=A(I,N+M+1)
440 DATA 9,21,-1
480 DATA 1,1,1,1,1,1,1,1,1,0,100
490 DATA 8,42,13,25,60,0,0,99,82,-1,1600
500 DATA 3.32,2.37,1.78,1.66,2.0,0,0,0,2.43,-1,275
510 DATA 4.9,7,3.7,8.59,3,0,0,0,0,-1,250
520 DATA 2.1,5.8,8.5,25.5,3,0,0,0,0,1,700
530 DATA 1.2,6.2,8,5.3,19.1,61.4,96.4,0,4.4,1,1400
540 DATA .03,.37,.25,2.5,1.46,24,31,0,0,-1,75
550 DATA .28,.45,.9,.8,.75,11,0,0,0,-1,60
560 DATA .06,.19,.26,.15,2.9,11,0,0,0,-1,45
570 DATA .13,.48,.15,.46,1.65,0,0,99,.68,-1,26
580 DATA .27,2.45,.47,1.13,4.35,0,0,0,7.79,-1,56
590 DATA .31,1.08,.48,1.16,2.21,0,0,99,2.37,-1,49
600 DATA .08,.65,.27,.6,.8,0,0,0,1.43,-1,15
610 DATA 0,0,0,1,0,0,0,0,0,1,8
620 DATA 0,0,0,0,1,0,0,0,0,-1,2
630 DATA 0,1,0,0,0,0,0,0,0,-1,18
640 DATA 0,0,0,0,0,0,0,0,1,1,1
650 DATA .03,.37,.25,2.5,1.46,30,31,0,0,1,110
660 DATA .28,.45,.9,.8,.75,15,0,0,0,1,90
670 DATA .13,.48,.15,.46,1.65,0,0,99,.68,1,50
680 DATA .27,2.45,.47,1.13,4.35,0,0,0,7.79,1,140
690 DATA .55,1.25,.70,.65,2.8,.83,.08,17,8.5
700 LET E=.0001
710 FOR I=1 TO M
720 LET A(1,I)=-P*A(1,I)
730 NEXT I
740 IF N=1 GOTO 820
750 FOR I=2 TO N+1
760 LET A(I,N+M+1)=A(I,M+2)
770 LET A(I,M+2)=0
780 IF I=2 GOTO 810
790 LET A(I,M+I-1)=A(I,M+1)
800 LET A(I,M+1)=0
810 NEXT I
820 LET R=1
830 FOR I=2 TO N+1
840 LET L(I)=M+I-1
850 IF A(I,M+I-1)=1 GOTO 910
860 LET L(I)=N+M+1
870 FOR J=1 TO N+M
880 LET A(N+2,J)=A(N+2,J)-A(I,J)
890 NEXT J
900 LET R=N+2
910 NEXT I
920 CLS
930 LOCATE 25:pRINT " ";TIME$
940 SCREEN 1:COLOR 9,2
950 LET T=1
960 FOR I=2 TO N+M
970 IF A(R,I)-A(R,T)>E GOTO 1020
980 IF A(R,I)-A(R,T)<=-E GOTO 1010
990 IF R=1 GOTO 1020
1000 IF A(1,I)-A(1,T)>=-E GOTO 1020
1010 LET T=I
1020 NEXT I
1030 LOCATE 4,12:pRINT "优 化 配 方"
1040 LOCATE 9,15:pRINT TIME$
1050 LOCATE 2,9
1060 PRINT "计 算 机 正 在 计 算"
1070 LOCATE 7,15
1080 PRINT "请 稍 候 . . .";
1090 INK=INK+1:LOCATE 7:pRINT INK
1100 IF A(R,T)<-E GOTO 1220
1110 IF R=1 GOTO 1500
1120 FOR I=1 TO N+M
1130 IF A(R,I)>E GOTO 1170
1140 NEXT I
1150 LET R=1
1160 GOTO 950
1170 FOR I=2 TO N+1
1180 IF L(I)<=N+M GOTO 1200
1190 IF A(I,N+M+1)>E GOTO 1440
1200 NEXT I
1210 GOTO 1500
1220 LET S=1
1230 FOR I=2 TO N+1
1240 IF A(I,T)<=E GOTO 1290
1250 LET Y=A(I,N+M+1)/A(I,T)
1260 IF S=1 GOTO 1280
1270 IF Y>=A(S,N+M+1)/A(S,T)GOTO 1290
1280 LET S=I
1290 NEXT I
1300 IF S=1 GOTO 1470
1310 LET L(S)=T
1320 LET Y=A(S,T)
1330 FOR I=1 TO N+M+1
1340 LET A(S,I)=A(S,I)/Y
1350 NEXT I
1360 FOR I=1 TO N+2
1370 IF I=S GOTO 1420
1380 LET Y=A(I,T)
1390 FOR J=1 TO N+M+1
1400 LET A(I,J)=A(I,J)-Y*A(S,J)
1410 NEXT J
1420 NEXT I
1430 GOTO 950
1440 CLS
1450 LOCATE 5,30:pRINT "此题无解"
1460 GOTO 1800
1470 CLS
1480 LOCATE 5,30:pRINT "此题无约束"
1490 GOTO 1800
1500 FOR I=2 TO N+1
1510 IF L(I)>M GOTO 1540
1520 LET S=L(I)
1530 LET X(S)=A(I,N+M+1)
1540 NEXT I
1550 LET Y=P*A(1,N+M+1)
1560 GOTO 1910
1570 LOCATE 25:pRINT "准备打印, 请输入配方编号:
1580 INPUT B
1590 LOCATE 25:pRINT "正在打印 "
1600 LPRINT" ":LPRINT " "
1620 LPRINT PF$;B;":";TAB(25);TIME$
1630 LPRINT" ":LPRINT TAB(25);DATE$;" ":LPRINT " "
1640 LPRINT "优化配方最优成本=";Y/100;"元/斤"
1650 LPRINT " ":LPRINT "配方中各种原料的比例为: "
1660 FOR I=1 TO M
1670 LPRINT AC$(I);CHR$(58);TAB(12);C(I);TAB(25);X(I);"%"
1680 NEXT I
1710 LPRINT "成分含量:":LPRINT " "
1720 GOSUB 1810
1730 LOCATE 25:pRINT "还打印吗?"
1740 A$=INKEY$:IF A$="" THEN 1740
1750 IF A$="Y" THEN 1590
1760 LOCATE 25:pRINT "存盘吗? "
1770 A$=INKEY$:IF A$="" THEN 1770
1780 IF A$="Y" THEN 2210
1790 LOCATE 25:pRINT " "
1800 END
1810 REM
1820 FOR I=3 TO 14
1830 CF(I)=0
1840 FOR J=1 TO M
1850 CF(I)=CF(I)+B(I,J)*X(J)
1860 NEXT J
1870 IF I=4 THEN LPRINT CF$(2);"含量: ";CF(4)/100;"兆卡/公斤":GOTO 1890
1880 LPRINT CF$(I-2);"含量: ";CF(I)/100;"%"
1890 NEXT I
1900 RETURN
1910 REM
1920 SCREEN 2
1930 CLS
1950 PRINT "优化配方最优成本=";Y/100;"元/斤"
1960 PRINT "配方中各种原料的比例为: "
1970 FOR I=1 TO M
1980 PRINT AC$(I);CHR$(58);TAB(12);C(I);TAB(25);X(I);"%"
1990 NEXT I
2000 PRINT
2010 PRINT "按任一键继续. . . . ."
2020 INK$=INKEY$:IF INK$="" THEN 2020
2030 GOSUB 2110
2040 LOCATE 25:pRINT "打印吗?"
2050 A$=INKEY$:IF A$="" THEN 2050
2060 IF A$="Y" THEN 1570
2070 LOCATE 25:pRINT "存盘吗? "
2080 A$=INKEY$:IF A$="" THEN 1770
2090 LOCATE 25:pRINT " "
2100 END
2110 REM
2120 FOR I=3 TO 14
2130 CF(I)=0
2140 FOR J=1 TO M
2150 CF(I)=CF(I)+B(I,J)*X(J)
2160 NEXT J
2170 IF I=4 THEN PRINT CF$(2);"含量: ";CF(4)/100;"兆卡/公斤":GOTO 2190
2180 PRINT CF$(I-2);"含量: ";CF(I)/100;"%"
2190 NEXT I
2200 RETURN
2210 REM
2220 INPUT B$
2230 LOCATE 25:pRINT "正在存盘 "
2240 OPEN B$+".TXT" AS#1 LEN=37
2250 FIELD #1,35 AS DA$,2 AS LF$
2260 LSET LF$=CHR$(13)+CHR$(10)
2270 LSET DA$="学院 "
2280 PUT #1,1
2290 LSET DA$=PF$
2300 PUT #1,2
2310 LSET DA$="优化配方最优成本="+STR$(Y/100)+"元/斤"
2320 PUT #1,3
2330 LSET DA$="配方中各种原料的比例为: "
2340 PUT #1,4
2350 FOR I=1 TO M
2360 LSET DA$=AC$(I)+CHR$(58)+" "+STR$(C(I))+" "+STR$(X(I))+"%"
2370 PUT #1,I+4
2380 NEXT I
2390 LSET DA$="成分含量:"
2400 PUT #1,M+5
2410 FOR I=3 TO 14
2420 CF(I)=0
2430 FOR J=1 TO M
2440 CF(I)=CF(I)+B(I,J)*X(J)
2450 NEXT J
2460 IF I=4 THEN LSET DA$=CF$(2)+"含量: "+STR$(CF(4)/100)+"卡/公斤":pUT #1,M+7:GOTO 2490
2470 LSET DA$=CF$(I-2)+"含量: "+STR$(CF(I)/100)+"%"
2480 PUT #1,M+I+3
2490 NEXT I
2500 GOTO 1790
 
这么长,没这个耐心哦。
 
是啊,太长了,你自己先转一下,有转不通的,可帮你一下。
 
unit Pfjsfrm;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, Grids, DBGrids, DB, DBClient;

type
TfrmPfjs = class(TForm)
bbtnPfjs: TBitBtn;
DBGrid1: TDBGrid;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
DBGrid2: TDBGrid;
DBGrid3: TDBGrid;
DBGrid4: TDBGrid;
BitBtn3: TBitBtn;
BitBtn4: TBitBtn;
ClientDataSet1: TClientDataSet;
DataSource1: TDataSource;
DataSource2: TDataSource;
ClientDataSet2: TClientDataSet;
procedure FormCreate(Sender: TObject);
procedure bbtnPfjsClick(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
frmPfjs: TfrmPfjs;

//var
{ DIM A(N+3,N+M+1),X(M),L(N+1)
DIM B(N+3,N+M+1);
}
{ avary : array[1..ystj_n+3,1..ylsl_m+ystj_n+1] of Real;
xvary : array[1..ylsl_m] of Real;
lvary : array[1..ystj_n+1] of Real;
}
{
avary : array of Real;
xvary : array of Real;
lvary : array of Real;
}

avary : array[1..24,1..31] of Real;
xvary : array[1..9] of Real;
lvary : array[1..22] of Real;

implementation

uses SlqyglDm, UnitConst, UnitVar;

{$R *.dfm}

procedure TfrmPfjs.FormCreate(Sender: TObject);
begin
try
DmSlqygl.DcomSlqygl.Connected := True;
Except
end;
end;

procedure TfrmPfjs.bbtnPfjsClick(Sender: TObject);
Var
i,j,r,t,s: integer;
e : Real;
begin
Try
DmSlqygl.cdsSlpfcsb.Active := True;
except
end;
{

7 XUAN=1
10 KEY OFF:LOCATE 25:pRINT " ";TIME$
25 READ M,N,P
27 CLS
28 LOCATE 25:pRINT " ";TIME$
30 PRINT "计算机输入 "
35 PRINT "原料个数";M,"约束条件个数";N
40 DIM AC$(M),CF$(15),CF(17)
45 PRINT
}
ylsl_m := 9;
ystj_n := 21;
mb_p := -1;
r := 0;
t := 0;
s := 0;
{
47 REM 变量数目
50 FOR AB=1 TO M
60 READ AC$(AB):NEXT AB
61 REM 指标数目
62 FOR AB=1 TO 12
64 READ CF$(AB):NEXT AB
}
{
70 DIM A(N+3,N+M+1),X(M),L(N+1)
75 DIM B(N+3,N+M+1)
}

{
80 PRINT "计算机输入数学模型:"
90 FOR I=2 TO N+1
100 FOR J=1 TO M+2
110 READ A(I,J):B(I,J)=A(I,J)
120 PRINT TAB(6*J);A(I,J);
130 NEXT J
140 PRINT
150 NEXT I
}
//"计算机输入数学模型:"
FOR I := 2 TO ystj_n+1 do
begin
FOR J := 1 TO ylsl_m+2 do
avary[i,j] := acary[i,j];
end;

{
160 FOR I=2 TO N+1
170 FOR J=1 TO M+2
180 LET A(I,J)=A(I,J)*SGN(A(I,M+2))
190 NEXT J
200 NEXT I
210 PRINT
}
FOR I := 2 TO ystj_n+1 do
begin
FOR J := 1 TO ylsl_m+2 do
avary[i,j] := avary[i,j]*avary[i,ylsl_m+2];
end;
{
220 PRINT "计算机输入各原料价格: "
230 FOR I=1 TO M
240 READ A(1,I)
245 C(I)=A(1,I)
250 PRINT TAB(6*I);A(1,I);
260 NEXT I
}
// PRINT "计算机输入各原料价格: "
FOR I := 1 TO ylsl_m do
avary[1,i] := ccary;
{
262 IF XUAN=1 THEN 286
265 PRINT:pRINT " 直接计算配方"
267 FOR XA=1 TO M
270 READ X(XA)
272 NEXT XA
274 PRINT
275 PRINT
276 PRINT
280 GOSUB 4000
282 END
}
{
286 PRINT:pRINT " 正在计算配方..."
288 IF A(R,I)-A(R,T)<-E GOTO 740
290 LET X(S)=A(I,N+M+1)
}
// PRINT:pRINT " 正在计算配方..."
IF not ((avary[R,I]-avary[R,T]) < (-1)*E) then
Begin
xvary := avary[I,ystj_n+ylsl_m+1];


{
460 LET E=.0001
470 FOR I=1 TO M
480 LET A(1,I)=-P*A(1,I)
490 NEXT I
500 IF N=1 GOTO 580
510 FOR I=2 TO N+1
520 LET A(I,N+M+1)=A(I,M+2)
530 LET A(I,M+2)=0
540 IF I=2 GOTO 570
550 LET A(I,M+I-1)=A(I,M+1)
560 LET A(I,M+1)=0
570 NEXT I
580 LET R=1
590 FOR I=2 TO N+1
600 LET L(I)=M+I-1
610 IF A(I,M+I-1)=1 GOTO 670
620 LET L(I)=N+M+1
630 FOR J=1 TO N+M
640 LET A(N+2,J)=A(N+2,J)-A(I,J)
650 NEXT J
660 LET R=N+2
670 NEXT I
674 CLS
675 LOCATE 25:pRINT " ";TIME$
676 REM SCREEN 1:COLOR 9,2
}
E :=0.0001;

FOR I := 1 TO ylsl_m do
avary[1,i] :=(-1)*mb_p*avary[1,i];

IF not (ystj_n = 1) then
begin
FOR I :=2 TO ystj_n+1 do
begin
avary[I,ystj_n+ylsl_m+1] := avary[I,ylsl_m+2];
avary[I,ylsl_m+2] := 0;
IF not (I = 2) then
begin
avary[I,ylsl_m+I-1] := avary[I,ylsl_m+1];
avary[I,ylsl_m+1] := 0;
end;
end;
end;

R := 1;
FOR I := 2 TO ystj_n+1 do
begin
lvary := ylsl_m+I-1;

IF not (avary[I,ylsl_m+I-1] = 1) then
begin
lvary := ystj_n+ylsl_m+1;

FOR J :=1 TO ystj_n+ylsl_m do
avary[ystj_n+2,J] := avary[ystj_n+2,J] - avary[I,J];

R := ystj_n+2
end;
end;
end;
{
680 LET T=1
690 FOR I=2 TO N+M
700 IF A(R,I)-A(R,T)>E GOTO 750
710 IF A(R,I)-A(R,T)<=-E GOTO 740
720 IF R=1 GOTO 750
730 IF A(1,I)-A(1,T)>=-E GOTO 750
740 LET T=I
750 NEXT I
}
T := 1;
FOR I :=2 TO ystj_n+ylsl_m do
begin
IF not (avary[R,I] - avary[R,T] > E) then //GOTO 750
begin
IF (avary[R,I] - avary[R,T]) <= -E then //GOTO 740
T := I //740
else
begin
IF not (R = 1) then //GOTO 750
begin
IF avary[1,I] - avary[1,T] >= -E then //GOTO 750
T := I; //740
end;
end;
end;
end; //750
{
751 LOCATE 4,12:pRINT "优 化 配 方"
752 LOCATE 9,15:pRINT TIME$
754 LOCATE 2,9
755 PRINT "计 算 机 正 在 计 算"
756 LOCATE 7,15
757 PRINT "请 稍 候 . . .";
758 INK=INK+1:LOCATE 7:pRINT INK

760 IF A(R,T)<-E GOTO 880
770 IF R=1 GOTO 1140
780 FOR I=1 TO N+M
790 IF A(R,I)>E GOTO 830
800 NEXT I

810 LET R=1
820 GOTO 680

}
avary[R,T] < -E then //GOTO 880
IF R=1 GOTO 1140
FOR I=1 TO N+M
IF A(R,I)>E GOTO 830
NEXT I

R := 1;
GOTO 680
{
830 FOR I=2 TO N+1
840 IF L(I)<=N+M GOTO 860
850 IF A(I,N+M+1)>E GOTO 1100
860 NEXT I
870 GOTO 1140


880 LET S=1
890 FOR I=2 TO N+1
900 IF A(I,T)<=E GOTO 950
910 LET Y=A(I,N+M+1)/A(I,T)
920 IF S=1 GOTO 940
930 IF Y>=A(S,N+M+1)/A(S,T)GOTO 950
940 LET S=I
950 NEXT I
960 IF S=1 GOTO 1120
970 LET L(S)=T
980 LET Y=A(S,T)
990 FOR I=1 TO N+M+1
1000 LET A(S,I)=A(S,I)/Y
1010 NEXT I
1020 FOR I=1 TO N+2
1030 IF I=S GOTO 1080
1040 LET Y=A(I,T)
1050 FOR J=1 TO N+M+1
1060 LET A(I,J)=A(I,J)-Y*A(S,J)
1070 NEXT J
1080 NEXT I
1090 GOTO 680


1100 CLS
1103 REM SCREEN 2
1105 LOCATE 12,30:pRINT "此题无解"
1110 GOTO 1360
1120 CLS
1122 REM SCREEN 2
1125 LOCATE 12,30:pRINT "此题无约束"
1130 GOTO 1360
1140 FOR I=2 TO N+1
1150 IF L(I)>M GOTO 1180
1160 LET S=L(I)
1170 LET X(S)=A(I,N+M+1)
1180 NEXT I
1190 LET Y=P*A(1,N+M+1)
1195 GOTO 3000
1360 END
2000 REM
2050 FOR I=3 TO 14
2055 CF(I)=0
2060 FOR J=1 TO M
2070 CF(I)=CF(I)+B(I,J)*X(J)
2080 NEXT J
2085 IF I=4 THEN LPRINT CF$(2);"含量: ";CF(4)/100;"兆卡/公斤":GOTO 2100
2090 LPRINT CF$(I-2);"含量: ";CF(I)/100;"%"
2100 NEXT I
2110 RETURN
3000 REM
3020 REM SCREEN 2
3050 CLS
3285 LOCATE 25:pRINT " "
3290 END
4000 REM
4050 FOR I=3 TO 14
4055 CF(I)=0
4060 FOR J=1 TO M
4070 CF(I)=CF(I)+B(I,J)*X(J)
4080 NEXT J
4085 IF I=4 THEN PRINT CF$(2);"含量: ";CF(4)/100;"兆卡/公斤":GOTO 4100
4090 PRINT CF$(I-2);"含量: ";CF(I)/100;"%"
4100 NEXT I
4110 RETURN
5000 REM
5005 INPUT B$
5110 PUT #1,I+4
5120 NEXT I
5130 LSET DA$="成分含量:"
5140 PUT #1,M+5
5150 FOR I=3 TO 14
5155 CF(I)=0
5160 FOR J=1 TO M
5170 CF(I)=CF(I)+B(I,J)*X(J)
5180 NEXT J
5200 NEXT I
5210 GOTO 1290
}

end;


end.

先转这些吧,有的地方还有不通的!你先看看吧。
 
好的!先谢谢了,有问题我再发贴。
 
接受答案了.
 
顶部