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

' Координаты начала координат относительно экрана
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

OUT &H3C8, NumColor%
OUT &H3C9, R%  ' Красный
OUT &H3C9, G%  ' Зелёный
OUT &H3C9, B%  ' Синий

OUT &H3C7, NumColor%
R% = INP(&H3C9) ' Красный
G% = INP(&H3C9)  ' Зелёный
B% = INP(&H3C9)  ' Синий

' Координаты начала координат относительно экрана
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

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

'$INCLUDE : 'SCRNSHOT.UNT'
SCREEN 13
LINE (0,0)-(319, 199), 42   ' Оранжевая линия поперёк экрана
  i = FNMakeBmp ("Line")    ' Снимаем скриншот

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

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

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

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

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)"

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

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