Форум программистов, компьютерный форум CyberForum.ru

Графика на бейсике - QBasic

Восстановить пароль Регистрация
 
 
Рейтинг: Рейтинг темы: голосов - 397, средняя оценка - 4.85
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
16.08.2010, 02:10     Графика на бейсике #1
Здравствуйте уважаемые участники форума и администрация!

Уже давно заметил, что "скудновато" в данном разделе по прикреплённым темам, есть предложение закрепить топик, освещая следующие вопросы:

1) Обсуждаем графические приложения, написанные на бейсике(любые MS-DOS компиляторы)
2) Выкладываем разные "поучительные" примеры

Понимаете, область далеко не самая простая, хочется развеить предрассудки о том что бейсик мол "игрушка", отсталый язык, есть же "сильные" программы, использующие разные ухищрения. Короче хочется чтобы было больше дискуссий на эту тему. В рамках форума можно решать самые разнообразные вопросы, от вопросов алгоритмизации до выбора стратегии оптимизации, от простых до сложных.

Что подразумевается под графическими приложениями:
- В первую очередь программы работающие в графическом режиме, с упором на вывод графики.
- Разные рисунки, анимация, эффекты, воспроизводящиеся непосредственно в программе.
- Мультимедиа приложения и игры.
- Обычные программы использующие средства для вывода графики.

Также можно обсуждать и выкладывать какие-либо вспомогательные программы(будь то конвертер или редактор), идеологические аспекты, т.е. допустим один человек предлагает идею - другой реализовывает.

Вообщем если найдутся энтузиасты поддержать топик, буду очень рад. Хочется чтобы в разделе было больше посетителей и чтоб форум не "сдох".
После регистрации реклама в сообщениях будет скрыта и будут доступны все возможности форума.
Good-Morning
14.07.2013, 20:37     Графика на бейсике
  #41

Не по теме:

Я тут повнимательней почитал форум - оказывается почти все, что я написал, уже было написано и трижды хорошо... ( )

После регистрации реклама в сообщениях будет скрыта и будут доступны все возможности форума.
gehh
Заблокирован
15.06.2014, 09:06     Графика на бейсике #42
Мне ваша тема понравилась. Тут я подумал.
Вот я на форуме тоже писал графику на QBasic.
А что если снять копию с лучших программ и
перекинуть сюда. Там ими мало кто интересуется.
Как вы думаете?
P.S.
Как бы не съели М-ы

Добавлено через 17 часов 2 минуты
Эта программа рисует колесо и оно крутится
QBasic мой друг. Чтобы жить надо крутиться!!
(программа проверена)
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
DEFSNG F-G, X-Y
DEFLNG I-K
CLS
 
SCREEN 12
WINDOW (-2.8, 2.1)-(2.8, -2.1)
 
f = .5236
j = 800000
k = 8000
g = 0
DO WHILE INKEY$ = ""
   g = g + .1
   CIRCLE (0, 0), 1, 11
   FOR i = 1 TO 12
      x = COS(f * i + g)
      y = SIN(f * i + g)
      LINE (x, y)-(0, 0), 11
   NEXT i
   FOR i = 1 TO j: NEXT i
   FOR i = 1 TO 12
      x = COS(f * i + g)
      y = SIN(f * i + g)
      LINE (x, y)-(0, 0), 0
   NEXT i
   IF j > k THEN j = j - k ELSE k = -k / 8
   IF j > 0 THEN j = j - k
   IF j > 400000 AND k < 0 THEN EXIT DO
LOOP
 
FOR i = 1 TO 12
   x = COS(f * i)
   y = SIN(f * i)
   LINE (x, y)-(0, 0), 11
NEXT i
 
END
Удачи вам!
gehh
Заблокирован
17.06.2014, 14:18     Графика на бейсике #43
Эта программа рисует цифру 4, а потом делает ее толще
(программа проверена)
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
DEFINT I-N
SCREEN 12
WINDOW (0, 479)-(639, 0)
 
LINE (270, 350)-(250, 250), 11
LINE (250, 250)-(300, 250), 11
LINE (300, 300)-(280, 150), 11
 
FOR i = 250 TO 300
   FOR j = 150 TO 350
      k = POINT(i, j)
      IF k = 11 THEN
         IF POINT(i - 8, j - 8) <> 11 THEN PSET (i - 8, j - 8), 11
      END IF
   NEXT j
NEXT i
END
Удачи вам!
gehh
Заблокирован
18.06.2014, 16:46     Графика на бейсике #44
Эта программа рисует квадратики и не один
а целую кучу. Это оператор Line один, но он
расположен в двойном цикле.
(программа проверена)
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
DIM i AS INTEGER
DIM j AS INTEGER
DIM c AS INTEGER
CLS
SCREEN 12
WINDOW (0, 300)-(400, 0)
 
FOR i = 1 TO 19
   FOR j = 1 TO 14
      c = 16 * RND
      LINE (20 * i, 20 * j)-(20 * i + 10, 20 * j + 10), c, B
   NEXT j
NEXT i
END
Удачи вам!
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
20.06.2014, 00:46  [ТС]     Графика на бейсике #45
Мне ваша тема понравилась.
И вы решили её изгадить своими детскими поделками... маааладец. Продолжайте в том же духе.
Через n-лет осознаете какой бред вы сейчас пишете.
Pro_grammer
Модератор
 Аватар для Pro_grammer
5790 / 1950 / 370
Регистрация: 24.04.2011
Сообщений: 3,329
Записей в блоге: 9
29.01.2015, 11:27     Графика на бейсике #46
Цитата Сообщение от Quiet Snow Посмотреть сообщение
Через n-лет осознаете какой бред вы сейчас пишете.

А что писал сам Билл Гейтс много лет назад? Я тут встретил одну старую игру, к созданию которой он непосредственно руку приложил - DONKEY.BAS
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
940 REM The IBM Personal Computer Donkey
950 REM Version 1.10 (C)Copyright IBM Corp 1981, 1982
960 REM Licensed Material - Program Property of IBM
975 DEF SEG : POKE 106, 0
980 SAMPLES$ = "NO"
990 GOTO 1010
1000 SAMPLES$ = "YES"
1010 KEY OFF: SCREEN 0, 1: COLOR 15, 0, 0: WIDTH 40: CLS : LOCATE 5, 19: PRINT "IBM"
1020 LOCATE 7, 12, 0: PRINT "Personal Computer"
1030 COLOR 10, 0: LOCATE 10, 9, 0: PRINT CHR$(213) + STRING$(21, 205) + CHR$(184)
1040 LOCATE 11, 9, 0: PRINT CHR$(179) + "       DONKEY        " + CHR$(179)
1050 LOCATE 12, 9, 0: PRINT CHR$(179) + STRING$(21, 32) + CHR$(179)
1060 LOCATE 13, 9, 0: PRINT CHR$(179) + "    Version 1.1O     " + CHR$(179)
1070 LOCATE 14, 9, 0: PRINT CHR$(212) + STRING$(21, 205) + CHR$(190)
1080 COLOR 15, 0: LOCATE 17, 4, 0: PRINT "(C) Copyright IBM Corp 1981, 1982"
1090 COLOR 14, 0: LOCATE 23, 7, 0: PRINT "Press space bar to continue"
1100 IF INKEY$ <> "" THEN GOTO 1100
1110 CMD$ = INKEY$
1120 IF CMD$ = "" THEN GOTO 1110
1130 IF CMD$ = CHR$(27) THEN GOTO 1298
1140 IF CMD$ = " " THEN GOTO 1160
1150 GOTO 1110
1160 DEF SEG = 0
1170 IF (PEEK(&H410) AND &H30) <> &H30 THEN DEF SEG : GOTO 1291
1180 WIDTH 80: CLS : LOCATE 3, 1
1190 PRINT "HOLD IT!"
1200 PRINT "YOU'RE NOT USING THE COLOR/GRAPHICS MONITOR ADAPTER!"
1210 PRINT "THIS PROGRAM USES GRAPHICS AND REQUIRES THAT ADAPTER."
1220 PRINT "PRESS THE SPACE BAR TO CONTINUE."
1230 DEF SEG
1240 IF INKEY$ <> "" THEN GOTO 1240
1250 CMD$ = INKEY$
1260 IF CMD$ = "" THEN GOTO 1250
1270 IF CMD$ = CHR$(27) THEN GOTO 1298
1280 IF CMD$ = " " THEN GOTO 1298
1290 GOTO 1250
1291 KEY OFF
1292 ON ERROR GOTO 1295
1293 PLAY "p16"
1294 GOTO 1300
1295 COLOR 31, 0, 0
1296 PRINT "THIS PROGRAM REQUIRES ADVANCED BASIC -- USE COMMAND 'BASICA'": COLOR 15, 0, 0: FOR I = 1 TO 9000: NEXT: RESUME 1298
1298 ON ERROR GOTO 0
1299 SCREEN 0, 1: 'IF SAMPLES$ = "YES" THEN CHAIN "samples",1000 ELSE COLOR 7,0,0:CLS:END
1300 REM
1410 COLOR 0
1420 DEFINT A-Y
1440 SCREEN 1, 0: COLOR 8, 1
1450 DIM Q%(500)
1460 DIM D1%(150), D2%(150), C1%(200), C2%(200)
1470 DIM DNK%(300)
1480 GOSUB 1940
1490 GOSUB 1780
1500 CLS
1510 DIM B%(300): DIM CAR%(900)
1520 FOR I = 2 TO 300: B%(I) = -16384 + 192: NEXT
1530 B%(0) = 2: B%(1) = 193
1540 REM
1550 CX = 110: CLS
1590 LINE (0, 0)-(305, 199), , B
1600 LINE (6, 6)-(97, 195), 1, BF
1610 LINE (183, 6)-(305, 195), 1, BF
1620 LOCATE 3, 5: PRINT "Donkey"
1630 LOCATE 3, 29: PRINT "Driver"
1631 LOCATE 19, 25: PRINT "Press Space  ";
1632 LOCATE 20, 25: PRINT "Bar to switch";
1633 LOCATE 21, 25: PRINT "lanes        ";
1635 LOCATE 23, 25: PRINT "Press ESC    ";
1636 LOCATE 24, 25: PRINT "to exit      ";
1640 FOR Y = 4 TO 199 STEP 20: LINE (140, Y)-(140, Y + 10): NEXT
1650 CY = 105: CX = 105
1660 LINE (100, 0)-(100, 199): LINE (180, 0)-(180, 199)
1670 LOCATE 5, 6: PRINT SD: LOCATE 5, 31: PRINT SM
1680 CY = CY - 4: IF CY < 60 THEN 2230
1690 PUT (CX, CY), CAR%, PRESET
1700 DX = 105 + 42 * INT(RND * 2)
1710 FOR Y = (RND * -4) * 8 TO 124 STEP 6
1720 SOUND 20000, 1
1730 A$ = INKEY$: IF A$ = CHR$(27) THEN 1298 ELSE POKE 106, 0: IF LEN(A$) > 0 THEN LINE (CX, CY)-(CX + 28, CY + 44), 0, BF: CX = 252 - CX: PUT (CX, CY), CAR%, PRESET: SOUND 200, 1
1740 IF Y >= 3 THEN PUT (DX, Y), DNK%, PSET
1750 IF CX = DX AND Y + 25 >= CY THEN 2060
1760 IF Y AND 3 THEN PUT (140, 6), B%
1770 NEXT: LINE (DX, 124)-(DX + 32, 149), 0, BF: GOTO 1670
1780 CLS
1790 DRAW "S8C3"
1800 DRAW "BM12,1r3m+1,3d2R1ND2u1r2d4l2u1l1"
1810 DRAW "d7R1nd2u2r3d6l3u2l1d3m-1,1l3"
1820 DRAW "m-1,-1u3l1d2l3u6r3d2nd2r1u7l1d1l2"
1830 DRAW "u4r2d1nd2R1U2"
1840 DRAW "M+1,-3"
1850 DRAW "BD10D2R3U2M-1,-1L1M-1,1"
1860 DRAW "BD3D1R1U1L1BR2R1D1L1U1"
1870 DRAW "BD2BL2D1R1U1L1BR2R1D1L1U1"
1880 DRAW "BD2BL2D1R1U1L1BR2R1D1L1U1"
1890 LINE (0, 0)-(40, 60), , B
1900 PAINT (1, 1)
'1910 DIM CAR%(900)
1920 GET (1, 1)-(29, 45), CAR%
1930 RETURN
1940 CLS
1950 DRAW "S08"
1960 DRAW "BM14,18"
1970 DRAW "M+2,-4R8M+1,-1U1M+1,+1M+2,-1"
1980 DRAW "M-1,1M+1,3M-1,1M-1,-2M-1,2"
1990 DRAW "D3L1U3M-1,1D2L1U2L3D2L1U2M-1,-1"
2000 DRAW "D3L1U5M-2,3U1"
2010 PAINT (21, 14), 3
2020 PRESET (37, 10): PRESET (40, 10)
2030 PRESET (37, 11): PRESET (40, 11)
2040 GET (13, 0)-(45, 25), DNK%
2050 RETURN
2060 SD = SD + 1: LOCATE 14, 6: PRINT "BOOM!"
2070 GET (DX, Y)-(DX + 16, Y + 25), D1%
2080 D1X = DX: D1Y = Y: D2X = DX + 17
2090 GET (DX + 17, Y)-(DX + 31, Y + 25), D2%
2100 GET (CX, CY)-(CX + 14, CY + 44), C1%
2110 GET (CX + 15, CY)-(CX + 28, CY + 44), C2%
2120 C1X = CX: C1Y = CY: C2X = CX + 15
2130 FOR P = 6 TO 0 STEP -1: Z = 1 / (2 ^ P): Z1 = 1 - Z
2140 PUT (C1X, C1Y), C1%: PUT (C2X, C1Y), C2%
2150 PUT (D1X, D1Y), D1%: PUT (D2X, D1Y), D2%
2160 C1X = CX * Z1: D1Y = Y * Z1: C2X = C2X + (291 - C2X) * Z
2170 D1X = DX * Z1: C1Y = C1Y + (155 - C1Y) * Z: D2X = D2X + (294 - D2X) * Z
2180 PUT (C1X, C1Y), C1%: PUT (C2X, C1Y), C2%
2190 PUT (D1X, D1Y), D1%: PUT (D2X, D1Y), D2%
2200 SOUND 37 + RND * 200, 4: NEXT
2210 FOR Y = 1 TO 2000: NEXT
2220 CLS : GOTO 1540
2230 SM = SM + 1: LOCATE 7, 25: PRINT "Donkey loses!"
2240 FOR Y = 1 TO 1000: NEXT
2250 CLS : GOTO 1540
Написано для 'BASICA', но можно запустить на QBasic, работает под DOS эмулятором. Не работает выход по клавише Esc, остальное вполне играбельно.


Кликните здесь для просмотра всего текста

ARI BIXHORN: Well, I am thrilled to be here today, because this week we are celebrating the ten-year birthday of the world's most powerful, productive and popular developer tool. And of course I'm talking about Visual Basic.

Now, to help set the context for just how far Visual Basic has come and really how far the Basic language has come, I'd like to take a step back just a few years and look at an application that was written in Basic. This application, called Donkey.bas was actually written by none other than the gentleman standing to the left of me. Bill, how long ago was it that you wrote Donkey.bas?

BILL GATES: Actually, it was myself and Neil Konzen at four in the morning with this prototype IBM PC sitting in this small room. IBM insisted that we had to have a lock on the door and we only had this closet that had a lock on it, so we had to do all our development in there and it was always over 100 degrees, but we wrote late at night a little application to show what the Basic built into the IBM PC could do. And so that was Donkey.bas. It was at the time very thrilling. So go ahead and show them what that looks like.
Миниатюры
Графика на бейсике  
echs
702 / 897 / 345
Регистрация: 23.10.2013
Сообщений: 4,105
Записей в блоге: 3
01.08.2015, 08:44     Графика на бейсике #47
Эта программа рисует узор из окружностей.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
DECLARE SUB f(x, y, r, p)
 
CLS
CLEAR, , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 4)
 
END
 
SUB f(x, y, r, p)
   IF p>0 THEN
      CIRCLE (x, y), r
      FOR i=1 TO 50000: NEXT i
      CALL f(x + r, y, r/2, p - 1)
      CALL f(x, y - r, r/2, p - 1)
      CALL f(x - r, y, r/2, p - 1)
      CALL f(x, y + r, r/2, p - 1)
   END IF
END SUB
echs
702 / 897 / 345
Регистрация: 23.10.2013
Сообщений: 4,105
Записей в блоге: 3
02.08.2015, 11:04     Графика на бейсике #48
Эта программа рисует узор из треугольников.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
DECLARE SUB DRE(x!, y!, r!, n!)
 
CLS
DIM SHARED S, C
C = .866
S = .5
x0 = 0: y0 = 0
 
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL DRE(0, 0, 100, 4)
END
 
SUB DRE(x0, y0, r, n)
   IF n > 0 THEN
      x1 = x0 - r*C
      y1 = y0 - r*S
      x2 = x0 + r*C
      y2 = y0 - r*S
      x3 = x0
      y3 = y0 + r
 
      LINE (x1, y1)-(x2, y2)
      LINE (x2, y2)-(x3, y3)
      LINE (x3, y3)-(x1, y1)
 
      FOR I = 1 TO 100000: NEXT I
 
      CALL DRE(x1, y1, r/2, n - 1)
      CALL DRE(x2, y2, r/2, n - 1)
      CALL DRE(x3, y3, r/2, n - 1)
   END IF
END SUB
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
02.08.2015, 22:25  [ТС]     Графика на бейсике #49
Уважаемые модераторы, будьте добры, переместите сообщения пользователя geh и его клона
gehh в одноимённые темы(название темы - то, что написано перед программой).
echs
702 / 897 / 345
Регистрация: 23.10.2013
Сообщений: 4,105
Записей в блоге: 3
03.08.2015, 13:15     Графика на бейсике #50
Графическая программа-анимация. Называется
Ханойские башни. (Вы вероятно о них слышали)
Программа запросит ввести число.
Для начала можете вести число 3. Если число
не вводить, а сразу нажать Enter, то будет по
умолчанию введено число 4. Число большее чем
7 вводить не стоит.

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
DECLARE SUB PYR(SD AS STRING, ND%)
DECLARE SUB REC(N%, o1%, o2%, o3%)
DECLARE SUB GRF(p1%, p2%)
 
DIM SHARED N AS INTEGER
DIM SHARED S(1 TO 3) AS STRING
 
CLS
CLEAR, , 26000
INPUT "N = "; NS$
IF NS$ = "" THEN N = 4 ELSE N = VAL(NS$)
 
FOR i = 1 TO N
   S(1) = S(1) + LTRIM$(STR$(i))
NEXT i
 
SCREEN 12
WINDOW (0, 480)-(640, 0)
 
CALL PYR(S(1), 160)
CALL PYR(S(2), 320)
CALL PYR(S(3), 480)
SLEEP 2
CLS
CALL REC(N, 1, 2, 3)
END
 
SUB GRF(p1 AS INTEGER, p2 AS INTEGER)
DIM t1 AS STRING
   t1 = LEFT$(S(p1), 1)
   S(p1) = RIGHT$(S(p1), LEN(S(p1)) - 1)
   S(p2) = t1 + S(p2)
 
   CALL PYR(S(1), 160)
   CALL PYR(S(2), 320)
   CALL PYR(S(3), 480)
   SLEEP 1
   IF LEN(S(3)) < N THEN CLS
END SUB
 
SUB PYR(SD AS STRING, ND AS INTEGER)
DIM S1 AS STRING
DIM S2 AS STRING
   H = 20
   S2 = SD
   LINE (ND, 240)-(ND, 400)
   IF LEN(SD) = 0 THEN EXIT SUB
   
   FOR i = 1 TO LEN(S2)
      S1 = RIGHT$(S2, 1)
      S2 = LEFT$(S2, LEN(S2) - 1)
      n1 = VAL(S1)
      X1 = ND - 10*n1
      X2 = ND + 10*n1
      Y1 = 240 + 20*i
      Y2 = Y1 - 20
      LINE (X1, Y1)-(X2, Y2), , B
   NEXT i
END SUB
 
SUB REC(N AS INTEGER, o1 AS INTEGER, o2 AS INTEGER, o3 AS INTEGER)
   IF N > 0 THEN
      CALL REC(N - 1, o1, o3, o2)
      CALL GRF(o1, o3)
      CALL REC(N - 1, o2, o1, o3)
   END IF
END SUB
Добавлено через 4 часа 8 минут

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
REM      Curve of Gilbert
 
DECLARE SUB ABC (x2!, y2!)
DECLARE SUB A (i!)
DECLARE SUB B (i!)
DECLARE SUB C (i!)
DECLARE SUB D (i!)
 
DIM SHARED p
DIM SHARED n
CLS
CLEAR , , 2900
 
p = 5
n = 10
SCREEN 12
DRAW "BM 450,50"
CALL A(p)
INPUT "Enter"; z$
SCREEN 0
END
 
SUB A (i)
   IF i > 0 THEN
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
   END IF
END SUB
 
SUB ABC (x2, y2)
   x1 = POINT(0)
   y1 = POINT(1)
   IF x1 <> x2 THEN
      LINE (x1, y1)-(x2, y2)
      FOR j = 1 TO 10000: NEXT
   ELSE
      LINE (x1, y1)-(x2, y2)
      FOR j = 1 TO 10000: NEXT
   END IF
END SUB
 
SUB B (i)
   IF i > 0 THEN
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL B(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL A(i - 1)
   END IF
END SUB
 
SUB C (i)
   IF i > 0 THEN
      CALL B(i - 1)
      CALL ABC(POINT(0) + n, POINT(1))
      CALL C(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
   END IF
END SUB
 
SUB D (i)
   IF i > 0 THEN
      CALL A(i - 1)
      CALL ABC(POINT(0), POINT(1) + n)
      CALL D(i - 1)
      CALL ABC(POINT(0) - n, POINT(1))
      CALL D(i - 1)
      CALL ABC(POINT(0), POINT(1) - n)
      CALL C(i - 1)
   END IF
END SUB
=========

Программа рисует узор из квадратов

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
DECLARE SUB f (x!, y!, r!, p!)
 
CLS
CLEAR , , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
 
END
 
SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 100000: NEXT
      CALL f(x + r, y, r / 3, p - 1)
      CALL f(x, y - r, r / 3, p - 1)
      CALL f(x - r, y, r / 3, p - 1)
      CALL f(x, y + r, r / 3, p - 1)
   END IF
END SUB
==========

Рекурсия. Узор из квадратов.
(Вариант 2)
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
DECLARE SUB f (x!, y!, r!, p!)
DIM SHARED c
 
CLS
CLEAR , , 20000
c = 2.4
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 4)
 
END
 
SUB f (x, y, r, p)
 
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y - r)-(x + r, y + r), , B
      LINE (x - s, y - s)-(x + s, y + s), 0, BF
      FOR i = 1 TO 50000: NEXT
      CALL f(x + r, y - r, r / c, p - 1)
      CALL f(x - r, y - r, r / c, p - 1)
      CALL f(x - r, y + r, r / c, p - 1)
      CALL f(x + r, y + r, r / c, p - 1)
   END IF
END SUB
========

Программа рисует узор из квадратов
(Вариант 3)
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
DECLARE SUB f (x!, y!, r!, p!)
 
CLS
CLEAR , , 20000
SCREEN 12
WINDOW (-320, 240)-(320, -240)
CALL f(0, 0, 100, 3)
 
END
 
SUB f (x, y, r, p)
   IF p > 0 THEN
      s = r - 1
      LINE (x - r, y + r)-(x + r, y - r), , B
      LINE (x - s, y + s)-(x + s, y - s), 0, BF
      FOR i = 1 TO 30000: NEXT
      CALL f(x, y, r / 4, p - 1)
      CALL f(x + r, y, r / 4, p - 1)
      CALL f(x + r, y + r, r / 4, p - 1)
      CALL f(x, y + r, r / 4, p - 1)
      CALL f(x - r, y + r, r / 4, p - 1)
      CALL f(x - r, y, r / 4, p - 1)
      CALL f(x - r, y - r, r / 4, p - 1)
      CALL f(x, y - r, r / 4, p - 1)
      CALL f(x + r, y - r, r / 4, p - 1)
   END IF
END SUB
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
03.08.2015, 23:48  [ТС]     Графика на бейсике #51
Не знаю, кому n лет назад создавал данную тему, но развеивание предрассудков, очевидно,
превратилось в их полнейшее доказательство - основного целевого контингента.
Больно, конечно, всё это видеть, столько сил было положено в своё время, Раптор, softmob,
мои прожки по мелочи, и тут нате вам... просто на дно... мерси коллеги программеры
echs
702 / 897 / 345
Регистрация: 23.10.2013
Сообщений: 4,105
Записей в блоге: 3
04.08.2015, 06:47     Графика на бейсике #52
Спасибо!
Хотя бы за то, что я знаю, что это ваша тема
и я должен был создать свою ...
Спасибо!
MiXa42
 Аватар для MiXa42
2 / 2 / 0
Регистрация: 26.11.2015
Сообщений: 39
26.11.2015, 23:23     Графика на бейсике #53
У меня собственная игра
Вот код:
QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
CHDIR ".\game"
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'
'        ±±    ±± ±±±±±± ±±±±±± ±± ±±±±±  ±±±±±± ±±±   ±±  ±±±±±±±±±±
'        ±±    ±± ±±  ±± ±±  ±± ±±    ±±  ±±  ±± ±± ±± ±±      ±±
'        ±±±±±±±± ±±  ±± ±±±±±± ±±   ±±   ±±  ±± ±±  ±±±±      ±±
'        ±±    ±± ±±  ±± ±± ±±  ±±  ±±    ±±  ±± ±±   ±±±      ±±
'        ±±    ±± ±±±±±± ±±  ±± ±± ±±±±±± ±±±±±± ±±    ±±      ±±
'
'         M I R I D I N    E N T E R T A I N M E N T  -  2 0 1 5
'
'
'               Game Name:  Miridin TANK COMMANDER Horizont version 1.3 ALPHA
'                   Programmer:  Petrov Mihail Denisovech
'                     Completed:  Sentember 22, 2015
'
'
'                               * * * *
'
'Are as follows:
'
'BLUE TANK  - up:  8
'             down:  2
'             left:  4
'             right:  6
'             brakes:  5
'             shoot:  0
'
'GREEN TANK - up:  W
'             down:  S
'             left:  A
'             right:  D
'             brakes:  Q
'             shoot:  SPACE BAR
'File list for Qbasic TANK COMMANDER v2:
'
'*  TCV2.BAS....................Game code file.
'*  ARENA.BSV...................BSAVEd graphics file for game arena.
'*  SPRITES.BSV.................BSAVEd graphics file for sprites.
'
'**************************** PRESS <ENTER> TO PLAY!! *************************
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-==-=-=-=-=-=-=-=-=-=-=-=-=-=-=
 
'Define variables A-Z as integers.
DEFINT A-Z
 
'Define the data TYPE, PaletteType.
TYPE PaletteType
    Red AS INTEGER
    Green AS INTEGER
    Blue AS INTEGER
END TYPE
 
'SHAREing of certain variables.
DIM SHARED Pal AS PaletteType
DIM SHARED pData(0 TO 255, 1 TO 3)
 
'Declaration of various SUBs.
DECLARE SUB PALETTE.Set (nColor%, pInfo AS PaletteType)
DECLARE SUB PALETTE.GET (nColor%, pInfo AS PaletteType)
DECLARE SUB PALETTE.FadeOut ()
DECLARE SUB PALETTE.FadeIn ()
 
'Change the default directory to the one being used for TANK COMMANDER. When
'setting this, remember to uncomment it.
'CHDIR ""
 
'Initial values of various variables.
D1 = 2: D2 = 4: T1H = 6: T1V = 87: T2H = 300: T2V = 102: Speed = 550
 
'Customise the VGA color palette for the introductory text.
SCREEN 13
C = 16: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * 0) + 0: C = C + 1: NEXT
C = 32: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * A) + 0: C = C + 1: NEXT
C = 48: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * 0) + A: C = C + 1: NEXT
C = 64: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * A) + 0: C = C + 1: NEXT
C = 80: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * 0) + A: C = C + 1: NEXT
C = 96: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * 0) + (256 * A) + A: C = C + 1: NEXT
C = 112: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * B) + 0: B = B + 3: C = C + 1: NEXT
C = 128: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * 0) + A: B = B + 3: C = C + 1: NEXT
C = 144: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * A) + 0: B = B + 3: C = C + 1: NEXT
C = 160: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * B) + (256 * A) + A: B = B + 3: C = C + 1: NEXT
C = 176: B = 0: FOR A = 16 TO 61 STEP 3: PALETTE C, (256 ^ 2 * A) + (256 * A) + A: C = C + 1: NEXT
C = 192: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * B) + (256 * AA) + A: B = B + 2: C = C + 1: NEXT
C = 208: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * B) + (256 * B) + A: B = B + 2: C = C + 1: NEXT
C = 224: B = 12: AA = 0: FOR A = 30 TO 62 STEP 2: PALETTE C, (256 ^ 2 * AA) + (256 * B) + A: B = B + 2: C = C + 1: NEXT
 
'Do presentation text.
PALETTE.FadeOut
COLOR 1
LOCATE 11, 14: PRINT  "M I R I D I N"
LOCATE 13, 13: PRINT "P R E S E N T S"
COLOR 9
LOCATE 20, 16: PRINT "*********"
LOCATE 17, 16: PRINT "*********"
LOCATE 18, 16: PRINT "*"
LOCATE 19, 16: PRINT "*"
LOCATE 19, 24: PRINT "*"
LOCATE 18, 24: PRINT "*"
COLOR 2
LOCATE 18, 18: PRINT "ALPHA "
COLOR 6
LOCATE 19, 17: PRINT " v 1.3 "
COLOR 1
'Color in "M I R I D I N" with various shades of blue.
Y = 72: C = 32
DO
    FOR X = 1 TO 300
        IF POINT(X, Y) > 0 THEN PSET (X, Y), C + RND * 17
    NEXT
    Y = Y + 1
LOOP UNTIL Y = 79
 
'Color in "PRESENTS" with various shades of red. Once this has been done,
'fade in the screen, melt it, and then fade out.
Y = 96: C = 49
DO
    FOR X = 1 TO 300
        IF POINT(X, Y) > 0 THEN PSET (X, Y), C + RND * 17
    NEXT
    Y = Y + 1
LOOP UNTIL Y = 103
PALETTE.FadeIn
NOW! = TIMER: WHILE (TIMER - 3) < NOW!: WEND
DIM Melt%(1700)
FOR R = 1 TO 1700
    RANDOMIZE TIMER
    X = INT(RND * 271)
    RANDOMIZE TIMER
    Y = INT(RND * 170)
    GET (X, Y)-(X + 48, Y + 18), Melt%
    PUT (X, Y + 1), Melt%, PSET
    IF INKEY$ = CHR$(27) THEN END
NEXT
PALETTE.FadeOut
CLS : PALETTE: PALETTE.FadeOut
 
'GET the sprite data.
DEF SEG = 40960: BLOAD "sprites.bsv"
DIM Tank1(150): GET (1, 1)-(15, 10), Tank1
DIM Tank2(150): GET (1, 14)-(15, 23), Tank2
DIM Tank3(150): GET (1, 27)-(15, 36), Tank3
DIM Tank4(150): GET (1, 40)-(15, 49), Tank4
DIM Tank5(150): GET (20, 1)-(34, 10), Tank5
DIM Tank6(150): GET (20, 14)-(34, 23), Tank6
DIM Tank7(150): GET (20, 27)-(34, 36), Tank7
DIM Tank8(150): GET (20, 40)-(34, 49), Tank8
 
'Load the file ARENA.BSV, which is the graphics data for the arena, into the
'video memory segment (segment 40960).
BLOAD "arena.bsv"
 
'Place both tanks in their initial positions and fade in the completed arena.
PUT (T1H, T1V), Tank1, PSET
PUT (T2H, T2V), Tank6, PSET
PALETTE.FadeIn
 
'Main program loop.
DO
 
    'IF Count < Speed THEN Count = Count + 1 ELSE Count = 0
    WAIT &H3DA, 8: WAIT &H3DA, 8, 8
 
    IF Go1 = 1 AND Count = 0 THEN
        IF D1 = 1 AND T1V > 26 THEN T1V = T1V - 1: PUT (T1H, T1V), Tank3, PSET
        IF D1 = 2 AND T1H < 305 THEN T1H = T1H + 1: PUT (T1H, T1V), Tank1, PSET
        IF D1 = 3 AND T1V < 190 THEN T1V = T1V + 1: PUT (T1H, T1V), Tank4, PSET
        IF D1 = 4 AND T1H > 0 THEN T1H = T1H - 1: PUT (T1H, T1V), Tank2, PSET
    END IF
    IF Go2 = 1 AND Count = 0 THEN
        IF D2 = 1 AND T2V > 26 THEN T2V = T2V - 1: PUT (T2H, T2V), Tank7, PSET
        IF D2 = 2 AND T2H < 305 THEN T2H = T2H + 1: PUT (T2H, T2V), Tank5, PSET
        IF D2 = 3 AND T2V < 190 THEN T2V = T2V + 1: PUT (T2H, T2V), Tank8, PSET
        IF D2 = 4 AND T2H > 0 THEN T2H = T2H - 1: PUT (T2H, T2V), Tank6, PSET
    END IF
    IF St1 = 30 THEN St1 = 0: Fire1 = 0: PSET (B1H, B1V), Col
    IF St2 = 30 THEN St2 = 0: Fire2 = 0: PSET (B2H, B2V), Col2
    IF Fire1 = 1 AND St1 < 30 AND Count = 0 THEN
        PSET (B1H, B1V), Col
        IF BD1 = 1 THEN B1V = B1V - 2
        IF BD1 = 2 THEN B1H = B1H + 2
        IF BD1 = 3 THEN B1V = B1V + 2
        IF BD1 = 4 THEN B1H = B1H - 2
        Col = POINT(B1H, B1V)
        PSET (B1H, B1V), 14
        St1 = St1 + 1
        GOSUB CheckBullet1
    END IF
    IF Fire2 = 1 AND St2 < 30 AND Count = 0 THEN
        PSET (B2H, B2V), Col2
        IF BD2 = 1 THEN B2V = B2V - 2
        IF BD2 = 2 THEN B2H = B2H + 2
        IF BD2 = 3 THEN B2V = B2V + 2
        IF BD2 = 4 THEN B2H = B2H - 2
        Col2 = POINT(B2H, B2V)
        PSET (B2H, B2V), 14
        St2 = St2 + 1
        GOSUB CheckBullet2
    END IF
    KEY$ = INKEY$
    IF KEY$ = CHR$(27) THEN PALETTE.FadeOut: GOTO Results
    IF KEY$ = "4" THEN Go1 = 1: D1 = 4
    IF KEY$ = "6" THEN Go1 = 1: D1 = 2
    IF KEY$ = "8" THEN Go1 = 1: D1 = 1
    IF KEY$ = "2" THEN Go1 = 1: D1 = 3
    IF KEY$ = "0" THEN IF Fire1 = 0 THEN GOSUB Shoot1
    IF KEY$ = "5" THEN Go1 = 0
    IF KEY$ = "A" OR KEY$ = "a" THEN Go2 = 1: D2 = 4
    IF KEY$ = "D" OR KEY$ = "d" THEN Go2 = 1: D2 = 2
    IF KEY$ = "W" OR KEY$ = "w" THEN Go2 = 1: D2 = 1
    IF KEY$ = "S" OR KEY$ = "s" THEN Go2 = 1: D2 = 3
    IF KEY$ = "Q" OR KEY$ = "q" THEN Go2 = 0
    IF KEY$ = CHR$(32) THEN IF Fire2 = 0 THEN GOSUB Shoot2
LOOP
 
Shoot1:  'Initiates the shooting from Tank 1.
BD1 = D1
IF BD1 = 0 THEN RETURN
IF BD1 = 1 THEN B1H = (T1H + 7): B1V = (T1V - 1)
IF BD1 = 2 THEN B1H = (T1H + 14): B1V = (T1V + 5)
IF BD1 = 3 THEN B1H = (T1H + 7): B1V = (T1V + 11)
IF BD1 = 4 THEN B1H = (T1H - 1): B1V = (T1V + 5)
St1 = 1: Fire1 = 1: Col = POINT(B1H, B1V)
RETURN
 
Shoot2:  'Initiates the shooting from Tank 2.
BD2 = D2
IF BD2 = 0 THEN RETURN
IF BD2 = 1 THEN B2H = (T2H + 7): B2V = (T2V - 1)
IF BD2 = 2 THEN B2H = (T2H + 14): B2V = (T2V + 5)
IF BD2 = 3 THEN B2H = (T2H + 7): B2V = (T2V + 11)
IF BD2 = 4 THEN B2H = (T2H - 1): B2V = (T2V + 5)
St2 = 1: Fire2 = 1: Col2 = POINT(B2H, B2V)
RETURN
 
CheckBullet1:  'Hit detection from Tank 1 bullet.
T2V = T2V + 2: T2H = T2H + 3
FOR ScanTank2 = 1 TO 7
    FOR Scan = 1 TO 9
        IF B1H = T2H AND B1V = T2V THEN Crash = 2: GOTO Explode
        T2H = T2H + 1
    NEXT
    T2H = T2H - 9: T2V = T2V + 1
NEXT
T2V = T2V - 9: T2H = T2H - 3
RETURN
 
CheckBullet2:  'Hit detection from Tank 2 bullet.
T1V = T1V + 2: T1H = T1H + 3
FOR ScanTank1 = 1 TO 7
    FOR Scan = 1 TO 9
        IF B2H = T1H AND B2V = T1V THEN Crash = 1: GOTO Explode
        T1H = T1H + 1
    NEXT
    T1H = T1H - 9: T1V = T1V + 1
NEXT
T1V = T1V - 9: T1H = T1H - 3
RETURN
 
Explode:  'Create very cheap graphic explosion.
IF Crash = 1 THEN ExplodeH = T1H: ExplodeV = T1V: T2Wins = 1
IF Crash = 2 THEN ExplodeH = T2H: ExplodeV = T2V: T1Wins = 1
FOR Explode = 1 TO 9
    IF Explode = 1 THEN Col = 14
    IF Explode = 5 THEN Col = 12
    IF Explode = 7 THEN Col = 4
    CIRCLE (ExplodeH, ExplodeV), Explode, Col
    NOW! = TIMER: WHILE (TIMER - .02) < NOW!: WEND
NEXT
NOW! = TIMER: WHILE (TIMER - 1.2) < NOW!: WEND
PALETTE.FadeOut
 
Results:  'Announce the winning tank and display credits.
SCREEN 0: WIDTH 66, 27
COLOR 12, 4
PRINT " G A M E   R E S U L T S "
PRINT
COLOR 9, 0
PRINT "Blue tank wins:"
COLOR 4
LOCATE 3, 17: PRINT T1Wins
COLOR 2
PRINT "Green tank wins:"
COLOR 4
LOCATE 4, 18: PRINT T2Wins
PRINT
COLOR 12, 4
PRINT " C R E D I T S "
PRINT
COLOR 3, 0
PRINT "Concept:"
PRINT "Programming:"
PRINT "Game art:"
PRINT "Fade effect:"
PRINT "Testing:"
PRINT "Debugging:"
COLOR 2
LOCATE 8, 11: PRINT "Miridin"
LOCATE 9, 15: PRINT "Misha Petrov"
LOCATE 10, 12: PRINT "Misha Petrov"
LOCATE 11, 15: PRINT "Misha Petrov"
COLOR 12
LOCATE 12, 11: PRINT "ALPHA"
COLOR 2
LOCATE 13, 13: PRINT "MIsha Petrov"
PRINT
COLOR 9
PRINT "All programmed by Mihail Petrov."
PRINT
COLOR 4,9
PRINT "Thank you for playing TANK COMMANDER Horizont v1.3 ALPHA !!!"
PRINT "Everything is made in QBASIC"
COLOR 2,0
PRINT ""
PRINT ""
LOCATE 25, 15 :PRINT "Made in POCTOB-HA-DOHY!"
COLOR 9,0
 
 
SUB PALETTE.FadeIn
DIM tT(1 TO 3)
FOR I = 1 TO 64
    WAIT &H3DA, 8, 8
    FOR O = 0 TO 255
        PALETTE.GET O, Pal
        tT(1) = Pal.Red
        tT(2) = Pal.Green
        tT(3) = Pal.Blue
        IF tT(1) < pData(O, 1) THEN tT(1) = tT(1) + 1
        IF tT(2) < pData(O, 2) THEN tT(2) = tT(2) + 1
        IF tT(3) < pData(O, 3) THEN tT(3) = tT(3) + 1
        Pal.Red = tT(1)
        Pal.Green = tT(2)
        Pal.Blue = tT(3)
        PALETTE.Set O, Pal
    NEXT
NEXT
END SUB
 
SUB PALETTE.FadeOut
DIM tT(1 TO 3)
FOR I = 0 TO 255
    PALETTE.GET I, Pal
    pData(I, 1) = Pal.Red
    pData(I, 2) = Pal.Green
    pData(I, 3) = Pal.Blue
NEXT
FOR I = 1 TO 64
    WAIT &H3DA, 8, 8
    FOR O = 0 TO 255
        PALETTE.GET O, Pal
        tT(1) = Pal.Red
        tT(2) = Pal.Green
        tT(3) = Pal.Blue
        IF tT(1) > 0 THEN tT(1) = tT(1) - 1
        IF tT(2) > 0 THEN tT(2) = tT(2) - 1
        IF tT(3) > 0 THEN tT(3) = tT(3) - 1
        Pal.Red = tT(1)
        Pal.Green = tT(2)
        Pal.Blue = tT(3)
        PALETTE.Set O, Pal
    NEXT
NEXT
END SUB
 
SUB PALETTE.GET (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C7, nColor%
pInfo.Red = INP(&H3C9)
pInfo.Green = INP(&H3C9)
pInfo.Blue = INP(&H3C9)
END SUB
 
SUB PALETTE.Set (nColor%, pInfo AS PaletteType)
OUT &H3C6, &HFF
OUT &H3C8, nColor%
OUT &H3C9, pInfo.Red
OUT &H3C9, pInfo.Green
OUT &H3C9, pInfo.Blue
END SUB
Комплектующие в фале.
Как вы думаете меню можно пристроить?
И вот сам файл:
Вложения
Тип файла: zip Cmmand.zip (429.9 Кб, 17 просмотров)
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
06.12.2015, 17:25  [ТС]     Графика на бейсике #54
Как вы думаете меню можно пристроить?
Думать не нужно, нужно знать, меню - ну а в чём сложность? Вот меню, одеваем его
в спрайты и очень даже нормально получится:

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
CONST Punkts = 2
DIM PuName(Punkts) AS STRING
DIM i AS INTEGER, RDr AS INTEGER
Vib = 0: RDr = -1
PuName(0) = "Variant 1"
PuName(1) = "Variant 2"
PuName(2) = "Exit"
 
DO: Kb$ = INKEY$
  IF Kb$ = CHR$(0) + "H" AND Vib > 0 THEN Vib = Vib - 1: RDr = -1
  IF Kb$ = CHR$(0) + "P" AND Vib < Punkts THEN Vib = Vib + 1: RDr = -1
  IF RDr THEN
    CLS 2
    FOR i = 0 TO Punkts
       IF Vib = i THEN COLOR 11 ELSE COLOR 8
       PRINT PuName(i)
    NEXT
    RDr = 0
  END IF
  IF Kb$ = CHR$(13) THEN
    SELECT CASE Vib
      CASE 0:  '  Делаем первое, например, вызов процедуры
               '  В процедуре может быть точно такое же ещё одно меню,
               '  либо толстый движок, вызывающий десятки других процедур
               '  и всё, что вам только в голову взбредёт.
      CASE 1:  '  Делаем второе, например, вызов процедуры  --||--
      CASE 2:  EXIT DO
      CASE ELSE
    END SELECT
  END IF
LOOP UNTIL Kb$ = CHR$(27)
Фейды - это конечно здорово, но вот INKEY$ для подвижных игр - ужасно.
На вашем месте переписал бы эту прогу заново. Рисовка нужна нормальная это раз, учитывая
то что QB64 позволяет это делать, нужна озвучка, 13 VGA экран под виндой - просто зло, делаем
хотя бы 640x480 в 32 бита конечно же, хотя эра данного разрешения прошла в конце 90-х, но я бы
не обломался, если бы всё было сделано качественно, лучше конечно 800x600 или 1024x768.
Сейчас посмотрю, что там по клавиатуре есть в QB64, судя по всему status% = _KEYDOWN(code&)
Читаем тут:
http://www.qb64.net/wiki/index.php?t...oard_scancodes
Но на QBasic оно работать не будет, почему _KEYDOWN? Потому, что через порты даже в DOS
был западающий костыль, через ON KEY Events не костыль, но тоже западающий, а через сообщения
винды - вам пока это не нужно, короче описание данной функции больше похоже на правду.
Выходит так что в данном плане лучше не иметь совместимости с DOS'ом вообще, чем пихать в прогу
кривые обработчики.

Звук курим тут:
http://www.qb64.net/wiki/index.php/SNDOPEN

Работу с графикой тут:
http://www.qb64.net/wiki/index.php?t...hics_with_QB64

Режимы бленда тут, но скудновато, после FB, скажу прямо:
http://www.qb64.net/wiki/index.php/P...hics_statement)

От рудимента BLOAD отказываемся сразу т.к. есть средства загрузки изображений.

Если важна кроссплатформа DOS\WINDOWS, ставим DOSBox + QBasic.

P.S: Поднимайте скилуху Михаил, а то так и будете на форумах всякую фигню писать.
У меня в ваши годы не то, что интернета не было, компа не было и прежде чем что-то
написать на форумах, сидел несколько месяцев вникал во всё это форумное комьюнити.
Серьёзно говорю, без всяких там пальцев веером и т.д. так что агриться не надо, спокойно
сидим изучаем, качаем мозг, шахматы там, логич. задачи и т.п., и да прежде чем, что-то
написать проверяем информацию в нормальных источниках, это как минимум убережёт
вашу репутацию и предостережёт от ошибок. А что не понятно, лучше лишний раз спросить.
Грамотного народа тут полно.
vlisp
297 / 266 / 43
Регистрация: 10.08.2015
Сообщений: 647
Завершенные тесты: 1
20.05.2016, 02:57     Графика на бейсике #55
Complex - интересная 3D программа на qbasic
Quiet Snow
 Аватар для Quiet Snow
4350 / 1212 / 199
Регистрация: 25.04.2010
Сообщений: 2,907
06.09.2016, 17:31  [ТС]     Графика на бейсике #56
Цитата Сообщение от vlisp Посмотреть сообщение
Complex - интересная 3D программа на qbasic
А можно перезалить куда-нибудь? Сайт сдох (Ошибка: "Не удается получить доступ к сайту").
vlisp
297 / 266 / 43
Регистрация: 10.08.2015
Сообщений: 647
Завершенные тесты: 1
06.09.2016, 19:49     Графика на бейсике #57
Цитата Сообщение от Quiet Snow Посмотреть сообщение
Сайт сдох
Похоже он переехал сюда...
http://home.scarlet.be/wugi/qbComplex.html
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
28.11.2016, 10:47     Графика на бейсике
Еще ссылки по теме:

Построение графика функции с заданным шагом QBasic
Динамическая графика QBasic
QBasic Динамическая графика созвездия
Динамическая графика молекулы ДНК QBasic
QBasic Динамическая графика

Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
starcraft
0 / 0 / 0
Регистрация: 25.11.2016
Сообщений: 1
28.11.2016, 10:47     Графика на бейсике #58
То что я посмотрел - это выше моего понимания! Как ты вообще это спроектировал? Я архитектуру замысла не то что саму программу не могу представить...Браво...
Yandex
Объявления
28.11.2016, 10:47     Графика на бейсике
Ответ Создать тему
Опции темы

Текущее время: 23:40. Часовой пояс GMT +3.
КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2017, vBulletin Solutions, Inc.
Рейтинг@Mail.ru