您所在位置：主题：原创]QB转植为VB（水泥配比）[求助]2（续）
jx355101
[专家分：0] 发布于 2006-12-17 12:45:00
1300 P2(I, I) = 1 + P2(I, I)
NEXT I
1310 FOR I = 1 TO 8
FOR J = 1 TO 8
FOR K = 1 TO 8
1320 P3(I, J) = P3(I, J) + P2(I, K) * P1(K ,J)
NEXT K, J, I
1330 FOR I = 1 TO 8
FOR J = 1 TO 8
P1(I, J) = P3(I, J)
NEXT J, I
1340 C= 0
FOR I = 1 TO 8
C = C + H(L, I) * D2(I)
NEXT I
1350 C = ZL(L) - C
FOR I = 1 TO 8
K(I) = K(I) * C
D2(I) = D2(I) + K(I)
NEXT I
NEXT L
FOR L = 1 TO 9
AA = 0
FOR I = 1 TO 8
AA = AA - H(L, I) * D2(I)
NEXT I
J(L) = ZL(L) + AA
J(L) = J(L) * J(L)
J(A) = J(A) + J(L)
NEXT L
A = A + 1
GOTO 1352
1354 FOR I = 1 TO 8
FOR J = 1 TO 8
CODE% = 10 * (I - 1) + J
LSET DAT$ = MKS$(P1(I, J))
PUT #3, CODE%
NEXT J,I
1355 FOR I=1 TO 8
CODE% = 90 +I
LSET DAT$=MKS$(D2(I))
PUT #3,CODE%
NEXT
CLOSE #3:RETURN
1352 M = M-1:IF M<>0 THEN GOSUB 1354:GOTO 40
GOTO 1470
IF MN=1 THEN 1353
FOR I=1 TO 8
FOR J=1 TO 8
G(I,J)=P1(I,J)
NEXT J,I
GOSUB 1720
MN=1
FOR I=1 TO 8
FOR J=1 TO 8
P22(I,J)=G(I,J+8)
NEXT J,I
1405 FOR I=1 TO 8
D1(I)=D2(I)
NEXT
GOSUB 1354:GOTO 40
1353 FOR I=1 TO 8
FOR J=1 TO 8
G(I,J)=P1(I,J)
NEXT J,I
GOSUB 1720
FOR I=1 TO 8
FOR J=1 TO 8
P1(I,J)=G(I,J+8)
P4(I,J)=P1(I,J)-P22(I,J)
G(I,J)=P4(I,J)
NEXT J,I
GOSUB 1720
FOR I=1 TO 8
K(I)=0
FOR J=1 TO 8
P5(I,J)=G(I,J+8)
K(I)=K(I)+P1(I,J)*D2(J)-P22(I,J)*D1(J)
NEXT J,I
FOR I=1 TO 8
D1(I)=0
FOR J=1 TO 8
D1(I)=D1(I)+P5(I,J)*K(J)
NEXT J,I
1440 FOR I=1 TO 8
FOR J=1 TO 8
P1(I,J)=P5(I,J)
P22(I,J)=P4(I,J)
NEXT J,I
1460 FOR I=1 TO 8
D2(I)=D1(I)
NEXT
D2(1)=116.81
D2(2)=28.15
D2(3)=3.91
D2(4)=24.72
D2(5)=64.07
D2(6)=21.02
D2(7)=5.94
D2(8)=4.62
1470 GOSUB 1354:GOTO 1820
1700 CLS:PRINT "wrong with the data"
GOTO 1820
1720 FOR I=1 TO 8
FOR J=1 TO 8
G(I,J+8)=0
NEXT J
G(I,I+8)=1
NEXT I
1730 FOR I=1 TO 8
FOR J=1 TO 8
1740 IF ABS(G(I,I))>=ABS(G(J,I)) THEN 1760
1750 FOR J1=1 TO 16
G1(J1)=G(I,J1)
G(I,J1)=G(J,J1)
G(J,J1)=G1(J1)
NEXT J1
1760 NEXT J
GO=G(I,I):IF GO=0 THEN GOTO 1700
1770 FOR J=1 TO 16
G(I,J)=G(I,J)/GO
NEXT J
1790 FOR J=1 TO 8
GO=G(J,I):IF J=I THEN 1810
1800 FOR J1=1 TO 16
G(J,J1)=G(J,J1)-GO*G(I,J1)
NEXT J1
1810 NEXT J,I
RETURN
1820 'CALCULATION
FOR L=1 TO 9
AA=0
FOR I=1 TO 8
AA=AA-H(L,I)*D2(I)
NEXT I
J(L)=ZL(L)+AA
J(L)=J(L)*J(L)
J(10)=J(10)+J(L)
NEXT L
W=D2(1)+D2(2)+D2(3)+D2(4)
1520 FOR I=1 TO 3
X(I,1)=(100-E(I,1))*D2(I)/100
W(I,1)=D2(I)*100/W
NEXT
X(4,1)=D2(4)*B(1,1)/100
1530 W(4,1)=D2(4)*100/W
FOR I=1 TO 4
FOR J=1 TO 6
A(I,J)=100*E(I,J+1)/(100-E(I,1))
NEXT J
NEXT I
IF X(1,1)<=0 GOTO 1380
IF X(2,1)<=0 GOTO 1390
IF X(3,1)<=0 GOTO 1400
temp=X(1,1)*A(1,5)+X(2,1)*A(2,5)
O=(temp+X(3,1)*A(3,5)+Q(1,1)*A(4,5))/100
IF O>=4.5 GOTO 1420
FOR I=1 TO 4
F(1,I)=D2(I+4)
NEXT
FOR I=5 TO 6
temp=X(1,1)*A(1,I)+X(2,1)*A(2,I)
F(1,I)=(temp+X(3,1)*A(3,I)+X(4,1)*A(4,I))/100
NEXT
K=(F(1,1)-1.65*F(1,3)- .35*F(1,4))/(2.8*F(1,2))
N=F(1,2)/(F(1,3)+F(1,4))
P=F(1,3)/F(1,4):O(2)=O(6)=0
FOR I=1 TO 3
G(I,2)=E(I,2)*W(I,1)/100
G(I,6)=E(I,6)*W(I,1)/100
NEXT
O(2)=G(1,2)+G(2,2)+G(3,2)
O(6)=G(1,6)+G(2,6)+G(3,6)
T=1.785*O(2)+2.48*O(6)
X(5,1)=X(1,1)+X(2,1)+X(3,1)+X(4,1)
W(5,1)=W(1,1)+W(2,1)+W(3,1)+W(4,1)
F(1,7)=F(1,1)+F(1,2)+F(1,3)+F(1,4)+F(1,5)+F(1,6)
US(0)=W(1,1)*B(1,4)/100
US(1)=W(2,1)*B(1,4)/100
US(2)=W(3,1)*B(1,4)/100
US(3)=W(4,1)*B(1,4)/100
US(4)=US(0)+US(1)+US(2)+US(3)
FOR I=0 TO 4
E(I,8)=0
FOR J=1 TO 7
E(I,8)=E(I,8)+E(I,J)
NEXT J
NEXT I
LOCATE 9,29
PRINT TAB(29);FNLEND$(K);TAB(35);FNLEND$(N);TAB(41);FNLEND$(P)
lcpr 5,49,"Tc":lcpr 9,47,FNLEND$(T)
LINE (371,43)-(419,59),,B
PUT (372,28),xx
FOR I=0 TO 3
PUT (228+48*I,60),xx
NEXT I
LINE (227,27)-(419,75),,B
LOCATE 13,54
PRINT "Total";TAB(63);"BR";TAB(69);"NBR";TAB(75);"SETUP"
FOR I=1 TO 4
LOCATE 13+2*I,53
PRINT USING "###.##";E(I,8);X(I,1);W(I,1)
NEXT
LOCATE 15,75:PRINT USING "##.##";US(0)
LOCATE 17,75:PRINT USING "##.##";US(1)
LOCATE 19,75:PRINT USING "##.##";US(2)
LOCATE 21,75:PRINT USING "##.##";US(3)
LOCATE 23,53:PRINT USING " ###.##";F(1,7);X(5,1);W(5,1)
LOCATE 23,75:PRINT USING "##.##";US(4)
J(15)=100*(B(1,5)-K)^2+(B(1,6)-N)^2+(B(1,7)-P)^2
LOCATE 9,2:PRINT SPACE$(27)
LOCATE 9,54:PRINT SPACE$(27)
LOCATE 11,54:PRINT SPACE$(27)
LOCATE 9,2:PRINT J(11)
LOCATE 9,15:PRINT J(12)
LOCATE 9,54:PRINT J(13)
LOCATE 9,67:PRINT J(14)
LOCATE 11,54:PRINT J(10)
LOCATE 11,67:PRINT J(15)
LOCATE 23,17
FOR I=1 TO 6
PRINT USING " ##.##";F(1,I);
NEXT I
FOR I=0 TO 2
FOR J=1 TO 6
X=420+56*I:y=92+(J-1)*16
PUT(X,y),xxx
NEXT J
NEXT I
FOR J=1 TO 6
X=420+56*3:y=92+(J-1)*16
PUT(X,y),xx
NEXT J
FOR I=1 TO 6
PUT (84+48*I,172),xx
NEXT I
LINE (419,91)-(635,187),,B
LINE (131,171)-(419-187),,B
LINE (419,91)-(419,187),0
lcpr 6,57,SPACE$(22)
lcpr 6,57,"SATISFIED(Y/N)?"
1290 lcpr 5,57,SPACE$(22)
lcpr 5,57,"SETUP AND CALCULATION"
waitin I$
SELECT CASE I$
CASE "Y"
I$="": GOTO 1360
CASE "N"
I$="": lcpr 3,20,"RECALCULATE"
CASE ELSE
I$="": BEEP: GOTO 1290
END SELECT
CLOSE #2
waitin P$:CLS
GOTO 30
1360 FOR I=0 TO 3
LSET FILY=FNLEND$(US(I))
PUT #2,I+1
NEXT I
CLOSE #2
END
1380 CLS:PRINT "X<=0": GOTO 1430
1390 CLS:PRINT "Y<=0": GOTO 1430
1400 CLS:PRINT "Z<=0": GOTO 1430
1410 CLS:PRINT "N=0": GOTO 1430
1420 CLS:PRINT "M>4.5"
1430 PRINT "SOMETHING WRONG WITH THE DATA":FOR I=0 TO 1000:NEXT
CLOSE #2
waitin I$
GOTO 30
SUB del
END SUB
SUB lcpr(I,J,I$)
LOCATE I,J:PRINT I$;
END SUB
SUB waitin(I$)
wsx: I$=INKEY$: IF I$ = "" GOTO wsx
I$ = UCASE$(I$)
END SUB
NEXT I
1310 FOR I = 1 TO 8
FOR J = 1 TO 8
FOR K = 1 TO 8
1320 P3(I, J) = P3(I, J) + P2(I, K) * P1(K ,J)
NEXT K, J, I
1330 FOR I = 1 TO 8
FOR J = 1 TO 8
P1(I, J) = P3(I, J)
NEXT J, I
1340 C= 0
FOR I = 1 TO 8
C = C + H(L, I) * D2(I)
NEXT I
1350 C = ZL(L) - C
FOR I = 1 TO 8
K(I) = K(I) * C
D2(I) = D2(I) + K(I)
NEXT I
NEXT L
FOR L = 1 TO 9
AA = 0
FOR I = 1 TO 8
AA = AA - H(L, I) * D2(I)
NEXT I
J(L) = ZL(L) + AA
J(L) = J(L) * J(L)
J(A) = J(A) + J(L)
NEXT L
A = A + 1
GOTO 1352
1354 FOR I = 1 TO 8
FOR J = 1 TO 8
CODE% = 10 * (I - 1) + J
LSET DAT$ = MKS$(P1(I, J))
PUT #3, CODE%
NEXT J,I
1355 FOR I=1 TO 8
CODE% = 90 +I
LSET DAT$=MKS$(D2(I))
PUT #3,CODE%
NEXT
CLOSE #3:RETURN
1352 M = M-1:IF M<>0 THEN GOSUB 1354:GOTO 40
GOTO 1470
IF MN=1 THEN 1353
FOR I=1 TO 8
FOR J=1 TO 8
G(I,J)=P1(I,J)
NEXT J,I
GOSUB 1720
MN=1
FOR I=1 TO 8
FOR J=1 TO 8
P22(I,J)=G(I,J+8)
NEXT J,I
1405 FOR I=1 TO 8
D1(I)=D2(I)
NEXT
GOSUB 1354:GOTO 40
1353 FOR I=1 TO 8
FOR J=1 TO 8
G(I,J)=P1(I,J)
NEXT J,I
GOSUB 1720
FOR I=1 TO 8
FOR J=1 TO 8
P1(I,J)=G(I,J+8)
P4(I,J)=P1(I,J)-P22(I,J)
G(I,J)=P4(I,J)
NEXT J,I
GOSUB 1720
FOR I=1 TO 8
K(I)=0
FOR J=1 TO 8
P5(I,J)=G(I,J+8)
K(I)=K(I)+P1(I,J)*D2(J)-P22(I,J)*D1(J)
NEXT J,I
FOR I=1 TO 8
D1(I)=0
FOR J=1 TO 8
D1(I)=D1(I)+P5(I,J)*K(J)
NEXT J,I
1440 FOR I=1 TO 8
FOR J=1 TO 8
P1(I,J)=P5(I,J)
P22(I,J)=P4(I,J)
NEXT J,I
1460 FOR I=1 TO 8
D2(I)=D1(I)
NEXT
D2(1)=116.81
D2(2)=28.15
D2(3)=3.91
D2(4)=24.72
D2(5)=64.07
D2(6)=21.02
D2(7)=5.94
D2(8)=4.62
1470 GOSUB 1354:GOTO 1820
1700 CLS:PRINT "wrong with the data"
GOTO 1820
1720 FOR I=1 TO 8
FOR J=1 TO 8
G(I,J+8)=0
NEXT J
G(I,I+8)=1
NEXT I
1730 FOR I=1 TO 8
FOR J=1 TO 8
1740 IF ABS(G(I,I))>=ABS(G(J,I)) THEN 1760
1750 FOR J1=1 TO 16
G1(J1)=G(I,J1)
G(I,J1)=G(J,J1)
G(J,J1)=G1(J1)
NEXT J1
1760 NEXT J
GO=G(I,I):IF GO=0 THEN GOTO 1700
1770 FOR J=1 TO 16
G(I,J)=G(I,J)/GO
NEXT J
1790 FOR J=1 TO 8
GO=G(J,I):IF J=I THEN 1810
1800 FOR J1=1 TO 16
G(J,J1)=G(J,J1)-GO*G(I,J1)
NEXT J1
1810 NEXT J,I
RETURN
1820 'CALCULATION
FOR L=1 TO 9
AA=0
FOR I=1 TO 8
AA=AA-H(L,I)*D2(I)
NEXT I
J(L)=ZL(L)+AA
J(L)=J(L)*J(L)
J(10)=J(10)+J(L)
NEXT L
W=D2(1)+D2(2)+D2(3)+D2(4)
1520 FOR I=1 TO 3
X(I,1)=(100-E(I,1))*D2(I)/100
W(I,1)=D2(I)*100/W
NEXT
X(4,1)=D2(4)*B(1,1)/100
1530 W(4,1)=D2(4)*100/W
FOR I=1 TO 4
FOR J=1 TO 6
A(I,J)=100*E(I,J+1)/(100-E(I,1))
NEXT J
NEXT I
IF X(1,1)<=0 GOTO 1380
IF X(2,1)<=0 GOTO 1390
IF X(3,1)<=0 GOTO 1400
temp=X(1,1)*A(1,5)+X(2,1)*A(2,5)
O=(temp+X(3,1)*A(3,5)+Q(1,1)*A(4,5))/100
IF O>=4.5 GOTO 1420
FOR I=1 TO 4
F(1,I)=D2(I+4)
NEXT
FOR I=5 TO 6
temp=X(1,1)*A(1,I)+X(2,1)*A(2,I)
F(1,I)=(temp+X(3,1)*A(3,I)+X(4,1)*A(4,I))/100
NEXT
K=(F(1,1)-1.65*F(1,3)- .35*F(1,4))/(2.8*F(1,2))
N=F(1,2)/(F(1,3)+F(1,4))
P=F(1,3)/F(1,4):O(2)=O(6)=0
FOR I=1 TO 3
G(I,2)=E(I,2)*W(I,1)/100
G(I,6)=E(I,6)*W(I,1)/100
NEXT
O(2)=G(1,2)+G(2,2)+G(3,2)
O(6)=G(1,6)+G(2,6)+G(3,6)
T=1.785*O(2)+2.48*O(6)
X(5,1)=X(1,1)+X(2,1)+X(3,1)+X(4,1)
W(5,1)=W(1,1)+W(2,1)+W(3,1)+W(4,1)
F(1,7)=F(1,1)+F(1,2)+F(1,3)+F(1,4)+F(1,5)+F(1,6)
US(0)=W(1,1)*B(1,4)/100
US(1)=W(2,1)*B(1,4)/100
US(2)=W(3,1)*B(1,4)/100
US(3)=W(4,1)*B(1,4)/100
US(4)=US(0)+US(1)+US(2)+US(3)
FOR I=0 TO 4
E(I,8)=0
FOR J=1 TO 7
E(I,8)=E(I,8)+E(I,J)
NEXT J
NEXT I
LOCATE 9,29
PRINT TAB(29);FNLEND$(K);TAB(35);FNLEND$(N);TAB(41);FNLEND$(P)
lcpr 5,49,"Tc":lcpr 9,47,FNLEND$(T)
LINE (371,43)-(419,59),,B
PUT (372,28),xx
FOR I=0 TO 3
PUT (228+48*I,60),xx
NEXT I
LINE (227,27)-(419,75),,B
LOCATE 13,54
PRINT "Total";TAB(63);"BR";TAB(69);"NBR";TAB(75);"SETUP"
FOR I=1 TO 4
LOCATE 13+2*I,53
PRINT USING "###.##";E(I,8);X(I,1);W(I,1)
NEXT
LOCATE 15,75:PRINT USING "##.##";US(0)
LOCATE 17,75:PRINT USING "##.##";US(1)
LOCATE 19,75:PRINT USING "##.##";US(2)
LOCATE 21,75:PRINT USING "##.##";US(3)
LOCATE 23,53:PRINT USING " ###.##";F(1,7);X(5,1);W(5,1)
LOCATE 23,75:PRINT USING "##.##";US(4)
J(15)=100*(B(1,5)-K)^2+(B(1,6)-N)^2+(B(1,7)-P)^2
LOCATE 9,2:PRINT SPACE$(27)
LOCATE 9,54:PRINT SPACE$(27)
LOCATE 11,54:PRINT SPACE$(27)
LOCATE 9,2:PRINT J(11)
LOCATE 9,15:PRINT J(12)
LOCATE 9,54:PRINT J(13)
LOCATE 9,67:PRINT J(14)
LOCATE 11,54:PRINT J(10)
LOCATE 11,67:PRINT J(15)
LOCATE 23,17
FOR I=1 TO 6
PRINT USING " ##.##";F(1,I);
NEXT I
FOR I=0 TO 2
FOR J=1 TO 6
X=420+56*I:y=92+(J-1)*16
PUT(X,y),xxx
NEXT J
NEXT I
FOR J=1 TO 6
X=420+56*3:y=92+(J-1)*16
PUT(X,y),xx
NEXT J
FOR I=1 TO 6
PUT (84+48*I,172),xx
NEXT I
LINE (419,91)-(635,187),,B
LINE (131,171)-(419-187),,B
LINE (419,91)-(419,187),0
lcpr 6,57,SPACE$(22)
lcpr 6,57,"SATISFIED(Y/N)?"
1290 lcpr 5,57,SPACE$(22)
lcpr 5,57,"SETUP AND CALCULATION"
waitin I$
SELECT CASE I$
CASE "Y"
I$="": GOTO 1360
CASE "N"
I$="": lcpr 3,20,"RECALCULATE"
CASE ELSE
I$="": BEEP: GOTO 1290
END SELECT
CLOSE #2
waitin P$:CLS
GOTO 30
1360 FOR I=0 TO 3
LSET FILY=FNLEND$(US(I))
PUT #2,I+1
NEXT I
CLOSE #2
END
1380 CLS:PRINT "X<=0": GOTO 1430
1390 CLS:PRINT "Y<=0": GOTO 1430
1400 CLS:PRINT "Z<=0": GOTO 1430
1410 CLS:PRINT "N=0": GOTO 1430
1420 CLS:PRINT "M>4.5"
1430 PRINT "SOMETHING WRONG WITH THE DATA":FOR I=0 TO 1000:NEXT
CLOSE #2
waitin I$
GOTO 30
SUB del
END SUB
SUB lcpr(I,J,I$)
LOCATE I,J:PRINT I$;
END SUB
SUB waitin(I$)
wsx: I$=INKEY$: IF I$ = "" GOTO wsx
I$ = UCASE$(I$)
END SUB