# Дан набор стройматериалов, каждый из которых характеризуется типом(перекрытие, балка, панель, опора), материалом (бетон, дерево, кирпич, камень) и ценой в рублях. Найти общую стоимость изделий одного типа. Для каждого типа построить столбиковую гистограмму распределения цен по материалам.- QBasic(Бейсик)

```CLS
SCREEN 12
INPUT "kolichestvo stroimeterialov-"; k
DIM iz\$(k)
DIM t(k)
DIM m(k)
DIM s(k)
FOR i = 1 TO k
1 CLS
PRINT "material -"; i; "/"; k
PRINT
PRINT "tipi materialov(v skobke index, ykazivat pri vvode materialov):"
PRINT "perekrytie(1), balka(2), panel(3), opora(4)"
PRINT
PRINT "material(v skobke index, ykazivat pri vvode materialov):"
PRINT "beton(1), derevo(2), kirpich(3), kamen (4)"
PRINT
INPUT "(izdelie)"; iz\$(i)
21 INPUT "tip"; t(i)
IF t(i) <> 1 AND t(i) <> 2 AND t(i) <> 3 AND t(i) <> 4 THEN GOTO 21
22 INPUT "material"; m(i)
IF m(i) <> 1 AND m(i) <> 2 AND m(i) <> 3 AND m(i) <> 4 THEN GOTO 22
23 INPUT "stoimost"; s(i)
IF s(i) < 0 THEN GOTO 23
PRINT "izdelie -"; iz\$(i); "; tip -"; t(i); "; material -"; m(i); "; stoimost -"; s(i)
3 INPUT "dannie verni ?(Y/N)"; yn\$
IF yn\$ = "Y" OR yn\$ = "y" THEN GOTO 2
IF yn\$ = "N" OR yn\$ = "n" THEN GOTO 1
IF (yn\$ <> "Y" AND yn\$ <> "N") OR (yn\$ <> "y" AND yn\$ <> "n") THEN GOTO 3
2 PRINT
NEXT i
FOR i = 1 TO k
IF t(i) = 1 THEN stoim1 = stoim1 + s(i)
IF t(i) = 2 THEN stoim2 = stoim2 + s(i)
IF t(i) = 3 THEN stoim3 = stoim3 + s(i)
IF t(i) = 4 THEN stoim4 = stoim4 + s(i)
NEXT i
sredstoim = (stoim1 + stoim2 + stoim3 + stoim4) / 4
IF sredstoim <= 330 THEN kof = 0.5
IF sredstoim > 330 AND sredstoim <= 660 THEN kof = .25
IF sredstoim > 660 AND sredstoim <= 1320 THEN kof = .12
IF sredstoim > 1320 AND sredstoim <= 2640 THEN kof = .06
IF sredstoim > 2640 AND sredstoim <= 5000 THEN kof = .03
IF sredstoim > 5000 AND sredstoim <= 10000 THEN kof = .015
IF sredstoim > 10000 THEN kof = .07
FOR i = 1 TO k
IF t(i) = 1 AND m(i) = 1 THEN s11 = (s11 + s(i)) * kof
IF t(i) = 1 AND m(i) = 2 THEN s12 = (s12 + s(i)) * kof
IF t(i) = 1 AND m(i) = 3 THEN s13 = (s13 + s(i)) * kof
IF t(i) = 1 AND m(i) = 4 THEN s14 = (s14 + s(i)) * kof
IF t(i) = 2 AND m(i) = 1 THEN s21 = (s21 + s(i)) * kof
IF t(i) = 2 AND m(i) = 2 THEN s22 = (s22 + s(i)) * kof
IF t(i) = 2 AND m(i) = 3 THEN s23 = (s23 + s(i)) * kof
IF t(i) = 2 AND m(i) = 4 THEN s24 = (s24 + s(i)) * kof
IF t(i) = 3 AND m(i) = 1 THEN s31 = (s31 + s(i)) * kof
IF t(i) = 3 AND m(i) = 2 THEN s32 = (s32 + s(i)) * kof
IF t(i) = 3 AND m(i) = 3 THEN s33 = (s33 + s(i)) * kof
IF t(i) = 3 AND m(i) = 4 THEN s34 = (s34 + s(i)) * kof
IF t(i) = 4 AND m(i) = 1 THEN s41 = (s41 + s(i)) * kof
IF t(i) = 4 AND m(i) = 2 THEN s42 = (s42 + s(i)) * kof
IF t(i) = 4 AND m(i) = 3 THEN s43 = (s43 + s(i)) * kof
IF t(i) = 4 AND m(i) = 4 THEN s44 = (s44 + s(i)) * kof
NEXT i
CLS
PRINT "tipi materialov(stolbec):"
PRINT "perekrytie(1), balka(2)"
PRINT "panel(3), opora(4)"
PRINT
PRINT "material:"
PRINT "beton(beliy), derevo(jeltiy)"
PRINT "kirpich(krasniy), kamen (golub)"
PRINT
FOR i = 1 TO k
PRINT i; ":"; iz\$(i); "-"; t(i); "-"; m(i); "-"; s(i);
NEXT i
LOCATE 1, 54: PRINT "gistogramma"
LINE (335, 25)-(335, 350), 4
LINE (335, 350)-(625, 350), 4
LINE (340, 349)-(390, 349 - s11), 15, BF
LINE (340, 349 - s11)-(390, 349 - s11 - s12), 14, BF
LINE (340, 349 - s11 - s12)-(390, 349 - s11 - s12 - s13), 4, BF
LINE (340, 349 - s11 - s12 - s13)-(390, 349 - s11 - s12 - s13 - s14), 3, BF
LINE (395, 349)-(445, 349 - s21), 15, BF
LINE (395, 349 - s21)-(445, 349 - s21 - s22), 14, BF
LINE (395, 349 - s21 - s22)-(445, 349 - s21 - s22 - s23), 4, BF
LINE (395, 349 - s21 - s22 - s23)-(445, 349 - s21 - s22 - s23 - s24), 3, BF
LINE (450, 349)-(500, 349 - s31), 15, BF
LINE (450, 349 - s31)-(500, 349 - s31 - s32), 14, BF
LINE (450, 349 - s31 - 32)-(500, 349 - s31 - s32 - s33), 4, BF
LINE (450, 349 - s31 - s32 - s33)-(500, 349 - s31 - s32 - s33 - s34), 3, BF
LINE (555, 349)-(505, 349 - s41), 15, BF
LINE (555, 349 - s41)-(505, 349 - s41 - s42), 14, BF
LINE (555, 349 - s41 - s42)-(505, 349 - s41 - s42 - s43), 4, BF
LINE (555, 349 - s41 - s42 - s43)-(505, 349 - s41 - s42 - s43 - s44), 3, BF
```

Тестирование выполнено в программе QB64 ( Скачать )