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

QBasic

Войти
Регистрация
Восстановить пароль
 
 
Рейтинг: Рейтинг темы: голосов - 397, средняя оценка - 4.85
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
#1

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

16.08.2010, 02:10. Просмотров 51846. Ответов 57
Метки нет (Все метки)

Здравствуйте уважаемые участники форума и администрация!

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

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

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

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

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

Вообщем если найдутся энтузиасты поддержать топик, буду очень рад. Хочется чтобы в разделе было больше посетителей и чтоб форум не "сдох".
После регистрации реклама в сообщениях будет скрыта и будут доступны все возможности форума.
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.08.2010, 02:23  [ТС]     Графика на бейсике #2
В качестве стартового примера простенькая программа изображающая график функции, полученный вследствие произведённой интерполяции лагранжа. Функцию интерполяции перекатал с программы на си(нашёл в нете).

Совместимость программы: QBasic(все версии), QuickBasic(с версии 4 и выше).
Миниатюры
Графика на бейсике  
Вложения
Тип файла: zip INTERPOL.zip (756 байт, 496 просмотров)
Евгений М.
1034 / 975 / 53
Регистрация: 28.02.2010
Сообщений: 2,818
Завершенные тесты: 2
16.08.2010, 06:11     Графика на бейсике #3
Программа для изображения графика с масштабированием и указанием начала координат относительно левого верхнего угла экрана.

Совместим с FreeBASIC 0.21.1. С другими компиляторами не проверял.
PureBasic
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
' Координаты начала координат относительно экрана
dim ox as integer
dim oy as integer
 
' Координаты точек в единицах
dim x as single
dim y as single
 
' Координаты точек на экране
dim px as integer
dim py as integer
 
' Координаты предыдущих точек на экране
dim prevpx as integer
dim prevpy as integer
 
' Длина и высота экрана
dim w as integer
dim h as integer
 
' Коэфициент преобразования единицы в точки экрана
' Или просто масштаб
dim k as single
 
' Для цикла
dim i as integer
 
' Режим экрана
screen 7
 
' Длина и высота экрана
' Изменять в случае смены режима экрана
w = 320
h = 200
 
' Масштаб
k = 10
 
' Координаты начала координат относительно экрана
ox = 100
oy = 100
 
' Очистка экрана
cls
 
' Рисует оси
line (0, oy)-(w, oy), 7
line (ox, 0)-(ox, h), 7
 
 
for i = 0 to w
    ' Преобразовние из координат точек в экране в единицы
    x = (i - ox) / k
    ' Здесь можете исправить на свою функцию
    y = x * cos(x)
    
    ' Преобразовние из единиц в координаты точек в экране
    px = i
    py = -y*k + oy
    
    ' Если текущий шаг цикла является первым...
    ' то координаты предыдущих точек считать текущими
    if i = 0 then
        prevpx = px
        prevpy = py
    end if
    
    ' Рисует линию от предыдущей точки к текущей
    line (prevpx, prevpy)-(px, py), 1
    
    ' Запоминает предыдущие точки
    prevpx = px
    prevpy = py
next i
 
' Спать
sleep
Миниатюры
Графика на бейсике  
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.08.2010, 08:21  [ТС]     Графика на бейсике #4
Цитата Сообщение от Евгений М. Посмотреть сообщение
Совместим с FreeBASIC 0.21.1. С другими компиляторами не проверял.
Проверил, в QuickBasic 4 - работает, а он на 100% совместим по синтаксису с Qbasic, значит всё ок. Спасибо Евгений М.! Если есть ещё программы, то я только за!

Выкладываю ещё одну программу, простенький рейкастер с текстурами и шейдингом, можно ставить туман))). Лучше запускать в exe виде(писал фактически ради прикола).

Совместимость программы: QBasic(все версии), QuickBasic(с версии 4 и выше).
Миниатюры
Графика на бейсике  
Вложения
Тип файла: zip RAYCAST.zip (33.2 Кб, 376 просмотров)
Евгений М.
1034 / 975 / 53
Регистрация: 28.02.2010
Сообщений: 2,818
Завершенные тесты: 2
16.08.2010, 08:36     Графика на бейсике #5
Цитата Сообщение от >Quiet Snow< Посмотреть сообщение
простенький рейкастер с текстурами и шейдингом
Вещь интересная. Если не трудно поделитесь с теоретическим материалом про создание таких вещей без графических библиотек.
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.08.2010, 09:01  [ТС]     Графика на бейсике #6
Цитата Сообщение от Евгений М. Посмотреть сообщение
Если не трудно поделитесь с теоретическим материалом про создание таких вещей без графических библиотек
Конечно не трудно, в принципе это один из самых простых способов создания "псевдо 3D". Суть состоит в том, что программа сканируя массив препятствий(точечных стен) проходит от КАМЕРЫ до препятствия в определённом направлении и чем дальше утыкается в препятствие(расстояние можно померить по кол-ву пройденных шагов) тем меньше вертикальная полоска рисуемая от центра экрана. Я рисовал слева направо вертикальными полосками шириной в 1 пиксель. Шейдинг очень прост. т.к. я использую палитру серых цветов. Чем дальше препятствие тем темнее должна быть полоска. По текстурам сейчас уже алгоритм отрисовки не припомню (помню только что по высоте полоски в процентном отношении можно определить координату Y на текстуре, однако приходится учитывать что стенка может быть в 2-х направлениях и текстуру должно быть видно на обеих, т.е. координата Y текстуры зависит от высоты полоски, а координата X текстуры - от положения полоски). Шейдинг+текстуры получается перемножением яркостей, ну плюс кое-какие коеф-ты без них никуда при отладке. Вообщем если будешь ориентироваться на эти рекомендации - легко напишешь такую же и даже круче, я над ней особо не парился, настроил только все параметры чтоб более менее рисовала.
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.08.2010, 12:37  [ТС]     Графика на бейсике #7
Добавлю ещё одну программу, с помощью эллипса рисуется окружение, после чего крутим палитру по кругу.
Напоминаю что операции с палитрой VGA производятся через порты 3C7h, 3C8h и 3C9h.
Запись палитры для конкретного цветового индекса:
PureBasic
1
2
3
4
OUT &H3C8, NumColor%
OUT &H3C9, R%  ' Красный
OUT &H3C9, G%  ' Зелёный
OUT &H3C9, B%  ' Синий
Чтение палитры для конкретного цв. индекса:
PureBasic
1
2
3
4
OUT &H3C7, NumColor%
R% = INP(&H3C9) ' Красный
G% = INP(&H3C9)  ' Зелёный
B% = INP(&H3C9)  ' Синий
Если кому понадобится корректная установка палитры для SCREEN 9 спрашивайте, отыщу и выложу...
Миниатюры
Графика на бейсике  
Вложения
Тип файла: zip ABSTRACT.zip (34.2 Кб, 329 просмотров)
Евгений М.
1034 / 975 / 53
Регистрация: 28.02.2010
Сообщений: 2,818
Завершенные тесты: 2
17.08.2010, 08:35     Графика на бейсике #8
Программа для изображения графика в полярной системе координат с масштабированием и указанием начала координат относительно левого верхнего угла экрана.

Совместим с FreeBASIC 0.21.1, Microsoft QuickBASIC 4.0 и выше
PureBasic
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
' Координаты начала координат относительно экрана
DIM ox AS INTEGER
DIM oy AS INTEGER
 
' Координаты точек в единицах
DIM x AS SINGLE
DIM y AS SINGLE
 
' Координаты точек на экране
DIM px AS INTEGER
DIM py AS INTEGER
 
' Координаты точек в полярной системе координат
DIM fi AS SINGLE
DIM ro AS SINGLE
 
' Координаты предыдущих точек на экране
DIM prevpx AS INTEGER
DIM prevpy AS INTEGER
 
' Длина и высота экрана
DIM w AS INTEGER
DIM h AS INTEGER
 
' Коэфициент преобразования единицы в точки экрана
' Или просто масштаб
DIM k AS SINGLE
 
' Режим экрана
SCREEN 7
 
' Длина и высота экрана
' Изменять в случае смены режима экрана
w = 320
h = 200
 
' Масштаб
k = 20
 
' Координаты начала координат относительно экрана
ox = 100
oy = 100
 
' Очистка экрана
CLS
 
' Рисует оси
LINE (0, oy)-(w, oy), 7
LINE (ox, 0)-(ox, h), 7
 
 
FOR fi = 0 TO 6.28 STEP 0.01
    DO
    
    ' Здесь можете исправить на свою функцию
    ro = 4 * COS (4 * fi)
    
    ' Если Вы НЕ допускаете отрицательное значение ro то раскомментируйте следующие 3 строки
    'IF ro < 0 THEN
    '   EXIT DO
    'END IF
    
    ' Преобразование в декартову систему координат
    x = ro * cos ( fi )
    y = ro * sin ( fi )
    
    ' Преобразовние из единиц в координаты точек в экране
    px = x*k + ox
    py = -y*k + oy
    
    ' Если текущий шаг цикла является первым...
    ' то координаты предыдущих точек считать текущими
    IF fi = 0 THEN
            prevpx = px
            prevpy = py
    END IF
    
    ' Рисует линию от предыдущей точки к текущей
    LINE (prevpx, prevpy)-(px, py), 2
    
    ' Запоминает предыдущие точки
    prevpx = px
    prevpy = py
    
    EXIT DO
    
    LOOP
NEXT fi
 
' Спать
SLEEP
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
18.08.2010, 07:19  [ТС]     Графика на бейсике #9
Евгений М., хорошая программа, а самое главное понятная. А то в моих перлах чёрт ногу сломит, даже коменты не спасут.

Добавлено через 21 час 2 минуты
Выкладываю мизерную программу для снятия скриншота с экрана в режиме SCREEN 13, удобно подключается как "модуль" через INCLUDE, учитывает системную палитру.

Совместимость программы: QuickBasic(с версии 4 и выше).

PureBasic
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
DEF FNMakeBmp (NameBmp$)
'    Заголовок *.BMP*
bgdt: DATA 66,77,54,254,0,0,0,0,0,0,54,4,0,0,40,0,0
DATA 0,64,1,0,0,200,0,0,0,1,0,8,0,0,0,0,0,0
DATA 250,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,1,0,0
'    Создаём *.BMP*
 OPEN NameBmp$ + ".Bmp" FOR BINARY AS #3
    RESTORE bgdt
    FOR byte& = 1 TO 54
     READ Zglv%: PUT #3, byte&, Zglv%
    NEXT byte&: byte& = 55
    FOR ii% = 0 TO 255
      OUT &H3C7, ii%: R% = INP(&H3C9) * 4: G% = INP(&H3C9) * 4: B% = INP(&H3C9) * 4
      bt1% = CVI(CHR$(B%) + CHR$(G%)): bt2% = CVI(CHR$(R%) + "№")
      PUT #3, byte&, bt1%: PUT #3, byte& + 2, bt2%
      byte& = byte& + 4
    NEXT ii%
      FOR y% = 199 TO 0 STEP -1
       FOR x% = 0 TO 319
        cve% = POINT(x%, y%)
        PUT #3, byte&, cve%: byte& = byte& + 1
       NEXT x%
      NEXT y%
 CLOSE #3
END DEF
т.е. сохраняете к примеру в файл SCRNSHOT.UNT(имя и расширение любое) и кодите так:
PureBasic
1
2
3
4
'$INCLUDE : 'SCRNSHOT.UNT'
SCREEN 13
LINE (0,0)-(319, 199), 42   ' Оранжевая линия поперёк экрана
  i = FNMakeBmp ("Line")    ' Снимаем скриншот
В директории появится файл LINE.BMP .
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
24.08.2010, 23:30  [ТС]     Графика на бейсике #10
К слову о возможностях:
Вот такую программу писал на Quick Basic когда учился, это был курсовик 1-го курса.
К сожалению исходник сдох вместе со старым Quantum Fireball))), остался тока экзешник для защиты. Но вы спрашивайте если чё, что смогу поясню. Запускать лучше без эмуляторов.
Управление в программе: Стрелки: газ и рулёжка, TAB: смена вида, пробел: тормоз, Home/End: расстояние до машины, PgUp/PgDn: поворот камеры.
Миниатюры
Графика на бейсике  
Вложения
Тип файла: rar Kursovay.rar (79.0 Кб, 783 просмотров)
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
24.12.2010, 09:58  [ТС]     Графика на бейсике #11
Решил поднять старую тему и побаловать кодеров интересной программкой.

Программа строит фрактал Лейс, взял я её отсюда(это не форум, так что ссылку опубликовать могу):

Ручками ручками переделал в бейсик и добавил пару эффектов.
PureBasic
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
DECLARE FUNCTION Arctg# (xf AS DOUBLE, yf AS DOUBLE)
CONST Pi = 3.14159265358#
CONST Foton = 0
  DIM x AS DOUBLE, y AS DOUBLE, A AS DOUBLE
  DIM X1 AS DOUBLE, Y1 AS DOUBLE
  DIM n AS INTEGER
  DIM r0 AS DOUBLE, w AS DOUBLE
 
  SCREEN 12
  PRINT "Please wait a minute..."
  FOR i = 1 TO 15
  OUT &H3C8, i: OUT &H3C9, 0: OUT &H3C9, i * 3: OUT &H3C9, i * 4 + 3
  NEXT
  x = .1
  y = .1
  WHILE INKEY$ = ""      ' {Нажатие для выхода из проги}
    A = RND              ' {Случайное значение а}
    r0 = (x * x + y * y) ^ .5
    w = Arctg#(x - 1, y)
    IF A <= 1 / 4 THEN
       w = Arctg#(x - 1, y)
       Y1 = -r0 * COS(w) / 2 + 1
       X1 = -r0 * SIN(w) / 2
    ELSE
       IF (A <= 2 / 4) THEN
          w = Arctg#(x + 1 / 2, y - 3 ^ .5 / 2)
          Y1 = -r0 * COS(w) / 2 - 1 / 2
          X1 = -r0 * SIN(w) / 2 + 3 ^ .5 / 2
       ELSE
          IF (A <= 3 / 4) THEN
              w = Arctg#(x + 1 / 2, y + 3 ^ .5 / 2)
              Y1 = -r0 * COS(w) / 2 - 1 / 2
              X1 = -r0 * SIN(w) / 2 - 3 ^ .5 / 2
          ELSE
              w = Arctg#(x, y)
              Y1 = -r0 * COS(w) / 2
              X1 = -r0 * SIN(w) / 2
          END IF
       END IF
    END IF
      '{End while}
    x = X1
    y = Y1
    'PoX = 160 + 65 * x
    'PoY = 100 + 65 * y
     PoX = 320 + 130 * x
     PoY = 200 + 130 * y
     M = POINT(PoX, PoY): IF M > 62 THEN M = 62
     PSET (PoX, PoY), M + 9
   FOR Qu = 1 TO Foton
    PoX = 320 + 129 * x + RND * 2
    PoY = 200 + 129 * y + RND * 2
     M = POINT(PoX, PoY): IF M > 62 THEN M = 62
     PSET (PoX, PoY), M + 1
   NEXT
    PoX = 320 + 130 * x
    PoY = 200 + 130 * y
   t1 = POINT(PoX - 1, PoY - 1)
   t2 = POINT(PoX, PoY - 1)
   t3 = POINT(PoX + 1, PoY - 1)
   t4 = POINT(PoX - 1, PoY)
   t5 = POINT(PoX, PoY)
   t6 = POINT(PoX + 1, PoY)
   t7 = POINT(PoX - 1, PoY + 1)
   t8 = POINT(PoX, PoY + 1)
   t9 = POINT(PoX + 1, PoY + 1)
   tt = (t1 + t2 + t3 + t4 + t5 + t6 + t7 + t8 + t9) / 9
   PSET (PoX, PoY), tt
  WEND
 
DIM Ek%(64, 48)
  FOR y = 0 TO 479 STEP 48
   FOR x = 0 TO 639 STEP 64
    IF INKEY$ <> "" THEN END
     FOR scY = 0 TO 47
      FOR scX = 0 TO 63
      'PSET (scX + x, scY + y), 8
      Ek%(scX, scY) = POINT(scX + x, scY + y)
      NEXT
     NEXT
    
     FOR scY = 1 TO 47
      FOR scX = 1 TO 63
   tt% = Ek%(scX - 1, scY - 1) + Ek%(scX, scY - 1) + Ek%(scX + 1, scY - 1)
   tt% = tt% + Ek%(scX - 1, scY) + Ek%(scX, scY) + Ek%(scX + 1, scY)
   tt% = (tt% + Ek%(scX - 1, scY + 1) + Ek%(scX, scY + 1) + Ek%(scX + 1, scY + 1)) / 9
      PSET (scX + x, scY + y), tt% + Ek%(scX, scY)
      NEXT
     NEXT
     
   NEXT
  NEXT
 
FUNCTION Arctg# (xf AS DOUBLE, yf AS DOUBLE)
DIM w AS DOUBLE
  w = ATN(ABS(yf / xf))
  IF (yf > 0) AND (xf < 0) THEN w = Pi - w
  IF (yf < 0) AND (xf < 0) THEN w = w + Pi
  IF (yf < 0) AND (xf > 0) THEN w = -w
  Arctg# = w
END FUNCTION
Скрин прилагается.
Миниатюры
Графика на бейсике  
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
15.03.2011, 13:36     Графика на бейсике #12
попробовал переделать эту прогу в qbasic
не особо получилось, но все же
PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
SCREEN 12 
RANDOMIZE TIMER
CONST Pi = 3.14159265358#
WHILE INKEY$ = ""
 a = 2 * (0.5 - RND): b = 2 * (0.5 - RND)
 c = 2 * (0.5 - RND): d = 2 * (0.5 - RND)
 x = RND: y = RND
  WHILE INKEY$ = ""
  sx = Pi * 2 * x: sy = Pi * 2 * y
  sx4 = Pi * 4 * x: sy4 = Pi * 4 * y
  X1 = a * SIN(sx) + b * SIN(sx) * COS(sy) + c * SIN(sx4) + d * SIN(Pi * 6 * x) * COS(sy4)
  Y1 = a * SIN(sy) + b * SIN(sy) * COS(sx) + c * SIN(sy4) + d * SIN(Pi * 6 * y) * COS(sx4)
  nx = FIX(100 * X1 + 320): ny = FIX(100 * Y1 + 240)
  PSET (nx, ny), 4.4
  x = X1: y = Y1
  WEND
 CLS
WEND
Миниатюры
Графика на бейсике  
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
15.03.2011, 14:41     Графика на бейсике #13
разные графические рисунки на qb
Вложения
Тип файла: rar Qb.rar (6.5 Кб, 276 просмотров)
Тип файла: rar kkk.rar (24.7 Кб, 216 просмотров)
PB
Просто прогер
1278 / 1065 / 11
Регистрация: 13.03.2009
Сообщений: 2,502
15.03.2011, 14:52     Графика на бейсике #14
Цитата Сообщение от softmob Посмотреть сообщение
не особо получилось
Немного подправил код.
PureBasic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
SCREEN 12 
RANDOMIZE TIMER
CONST Pi = 3.14159265358#
WHILE INKEY$ = ""
 a = 2 * (0.5 - RND): b = 2 * (0.5 - RND)
 c = 2 * (0.5 - RND): d = 2 * (0.5 - RND)
 x = RND: y = RND
  WHILE INKEY$ = ""
  sx = Pi * 2 * x: sy = Pi * 2 * y
  sx4 = Pi * 4 * x: sy4 = Pi * 4 * y
  X1 = a * SIN(sx) + b * SIN(sx) * COS(sy) + c * SIN(sx4) + d * SIN(Pi * 6 * x) * COS(sy4)
  Y1 = a * SIN(sy) + b * SIN(sy) * COS(sx) + c * SIN(sy4) + d * SIN(Pi * 6 * y) * COS(sx4)
  nx = FIX(100 * X1 + 320): ny = FIX(100 * Y1 + 240)
  PSET (nx, ny), POINT(nx, ny)+1 
  x = X1: y = Y1
  WEND
 CLS
Wend
Исполняемый файл в архиве.
Миниатюры
Графика на бейсике  
Вложения
Тип файла: rar (Untitled).rar (47.3 Кб, 139 просмотров)
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
15.03.2011, 17:07     Графика на бейсике #15
Программа строит график функции z=f(x,y) в виде прозрачной сетки сетки.
[ ссылка удалена модератором П3.7. запрещено публиковать ссылки на другие форумы]
PureBasic
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
Phucker Copyright
'from science.clanbb.ru with love
DECLARE FUNCTION f! (x!, y!)
SCREEN 12
pi = 3.141592
x0 = 320: y0 = 240 'Экранное положение проекции начала координат
m = 20 'Масштабный коэффициент для осей X, Y, Z. Показывает
'  скольким пикселам равен единичный отрезок.
alpha = -.3 * pi: beta = .1 * pi 'Углы поворота пространства XYZ вокруг
'  осей X и Y. Указываются в радианах.
minx = -10: maxx = 10 'Ограничения прямоугольной области
miny = -10: maxy = 10 '  по осям X и Y.
kolx = 32: koly = 32 'Количество разбиений сетки по осям X и Y.
kolx2 = 1024: koly2 = 1024 'Количество точек для построения
'  "прутьев" сетки по осям X и Y.
 
'Синусы и косинусы углов alpha и beta.
cosa = COS(alpha): sina = SIN(alpha)
cosb = COS(beta): sinb = SIN(beta)
 
'Шаги между "прутьями" сетки по осям X и Y.
dx = (maxx - minx) / kolx: dy = (maxy - miny) / koly
 
'Шаги между точками построения "прутьев".
dx2 = (maxx - minx) / kolx2: dy2 = (maxy - miny) / koly2
 
'Двухуровневый цикл построения "прутьев" сетки,
'  параллельных XZ.
FOR y = miny TO maxy * 1.001 STEP dy
  FOR x = minx TO maxx * 1.001 STEP dx2
    z = f(x, y)
 
    'Блок преобразования координат пространства.
    'Считаем, что произошли повороты точек пространства
    'вокруг осей X и Y на углы alpha и beta соответственно.
    y2 = y * cosa - z * sina
    z2 = y * sina + z * cosa
    x2 = x
    'z3 = z2 * cosb - x2 * sinb
    x3 = z2 * sinb + x2 * cosb
    y3 = y2
 
    PSET (x0 + x3 * m, y0 - y3 * m)
  NEXT x
NEXT y
 
'Двухуровневый цикл построения "прутьев" сетки,
'  параллельных YZ.
FOR x = minx TO maxx * 1.001 STEP dx
  FOR y = miny TO maxy * 1.001 STEP dy2
    z = f(x, y)
 
    'Блок преобразования координат пространства.
    'Считаем, что произошли повороты точек пространства
    'вокруг осей X и Y на углы alpha и beta соответственно.
    y2 = y * cosa - z * sina
    z2 = y * sina + z * cosa
    x2 = x
    'z3 = z2 * cosb - x2 * sinb
    x3 = z2 * sinb + x2 * cosb
    y3 = y2
 
 
    PSET (x0 + x3 * m, y0 - y3 * m)
  NEXT y
NEXT x
 
'Уравнение поверхности z=f(x,y).
FUNCTION f (x, y)
  f = COS(SQR(x ^ 2 + y ^ 2))
END FUNCTION
Миниатюры
Графика на бейсике  
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
16.03.2011, 15:40     Графика на бейсике #16
графики cos(x), sin(x)
PureBasic
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
SCREEN 12
VIEW (20, 150)-(620, 250)
WINDOW (-6.28, 1)-(6.28, -1)
LINE (-6.28, 0)-(6.28, 0), 14
LINE (0, -1)-(0, 1), 14
LOCATE 14, 60
PRINT "pi"
LOCATE 14, 40
PRINT "0"
LOCATE 14, 20
PRINT "-pi"
LOCATE 14, 30
PRINT "-pi/2"
LOCATE 14, 50
PRINT "pi/2"
FOR x = -6.28 TO 6.28 STEP .005
    PSET (x, SIN(x)), 10
    PSET (x, COS(x)), 3
NEXT x
LOCATE 15, 4
COLOR 3
PRINT "y = cos (x)"
LOCATE 17, 26
COLOR 10
PRINT "y = sin (x)"
Миниатюры
Графика на бейсике  
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
16.03.2011, 16:16     Графика на бейсике #17
аналоговые часы
PureBasic
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
SCREEN 12
CONST Pi = 3.14159265358#
x0 = 320: y0 = 240: r = 220: rs = 200: rm = 180: rh = 175: DIM c$(12)
DATA XII,I,II,III,IV,V,VI,VII,VIII,IX,X,XI
FOR i = 1 TO 12: READ c$(i): NEXT
CIRCLE (x0, y0), r, 4
FOR s = 0 TO 59
    ax = CINT(x0 - r * COS((Pi / 180) * (6 * s + 90)))
    ay = CINT(y0 - r * SIN((Pi / 180) * (6 * s + 90)))
    ax1 = CINT(x0 - (r - 15) * COS((Pi / 180) * (6 * s + 90)))
    ay1 = CINT(y0 - (r - 15) * SIN((Pi / 180) * (6 * s + 90)))
    ax2 = CINT(x0 - (r - 5) * COS((Pi / 180) * (6 * s + 90)))
    ay2 = CINT(y0 - (r - 5) * SIN((Pi / 180) * (6 * s + 90)))
    IF s MOD 5 = 0 THEN
        LINE (ax, ay)-(ax1, ay1), 5
        LOCATE ay1 / 16, ax1 / 8: PRINT c$((s / 5) + 1)
    ELSE
        LINE (ax, ay)-(ax2, ay2), 5
    END IF
NEXT
WHILE INKEY$ = ""
    a$ = TIME$
    h = VAL(MID$(a$, 1, 2))
    m = VAL(MID$(a$, 4, 2))
    s1 = s: s = VAL(MID$(a$, 7, 2))
    IF s1 <> s THEN
        LINE (x0, y0)-(xs, ys), 0
        LINE (x0, y0)-(xm, ym), 0
        LINE (x0, y0)-(xh, yh), 0
        xs = CINT(x0 - rs * COS((Pi / 180) * (6 * s + 90)))
        ys = CINT(y0 - rs * SIN((Pi / 180) * (6 * s + 90)))
        LINE (x0, y0)-(xs, ys), 4
        xm = CINT(x0 - rm * COS((Pi / 180) * (90 + 6 * m)))
        ym = CINT(y0 - rm * SIN((Pi / 180) * (90 + 6 * m)))
        LINE (x0, y0)-(xm, ym), 15
        xh = CINT(x0 - rh * COS((Pi / 180) * (90 + 6 * ((h MOD 12) * 5 + m \ 12))))
        yh = CINT(y0 - rh * SIN((Pi / 180) * (90 + 6 * ((h MOD 12) * 5 + m \ 12))))
        LINE (x0, y0)-(xh, yh), 1
    END IF
WEND
что здесь надо заменить, добавить?
Миниатюры
Графика на бейсике  
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.03.2011, 17:11  [ТС]     Графика на бейсике #18
Ссылка на старую FAQ статью по трёхмерной графике на QuickBasic:
QuickBasic 3D FAQ
Quiet Snow
4368 / 1230 / 206
Регистрация: 25.04.2010
Сообщений: 2,992
16.03.2011, 17:13  [ТС]     Графика на бейсике #19
что здесь надо заменить, добавить?
Программа работает, значит всё гуд, а из недочётов - секундная стрелка проходит по цифрам, укоротить её на 10 пикселей или чуть больше.
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
16.03.2011, 17:47     Графика на бейсике
Еще ссылки по теме:

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

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

Или воспользуйтесь поиском по форуму:
softmob
1248 / 698 / 155
Регистрация: 20.02.2010
Сообщений: 1,035
16.03.2011, 17:47     Графика на бейсике #20
построение различных графиков
PureBasic
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
SCREEN 12: c = 2
LINE (0, 240)-(640, 240), c: LINE (320, 0)-(320, 480), c
LINE (320, 0)-(318, 20), c: LINE (320, 0)-(322, 20), c
LINE (640, 240)-(620, 238), c: LINE (640, 240)-(620, 242), c
LOCATE 1, 42: PRINT "Y"
LOCATE 16, 80: PRINT "X"
mx = 40: my = 40: c = 4
FOR x = mx TO 640 STEP mx
    LINE (x, 238)-(x, 242)
NEXT
FOR y = mx TO 480 STEP mx
    LINE (318, y)-(322, y)
NEXT
FOR x = -8 TO 8 STEP 0.01
    y = x ^ 2
    PSET (320 + x * mx, 240 - y * mx), c
NEXT
FOR x = 0 TO 8 STEP 0.01
    y = SQR(x)
    PSET (320 + x * mx, 240 - y * mx), c + 2
NEXT
FOR x = -8 TO 8 STEP 0.001
    y = 1 / x
    PSET (320 + x * mx, 240 - y * mx), c - 1
NEXT
FOR x = -8 TO 8 STEP 0.001
    y = x
    PSET (320 + x * mx, 240 - y * mx), c + 5
NEXT
Миниатюры
Графика на бейсике  
Yandex
Объявления
16.03.2011, 17:47     Графика на бейсике
Ответ Создать тему
Опции темы

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