DaniWeb IT Discussion Community

Code Snippets (http://www.daniweb.com/code/)
-   qbasic (http://www.daniweb.com/code/qbasic.html)
-   -   Mandelbrot Fractal Graphics (BCX basic) (http://www.daniweb.com/code/snippet343.html)

vegaseat qbasic syntax
Jul 31st, 2005
A simple experiment with the ever so popular Mandelbrot fractal graphics, call it mathematical art, nice to look at. This set of experiments loops through a number of colors to make the whole thing more exciting.

  1. ' experiments with Mandelbrot sets (math induced graphics)
  2. ' needs BCX basic, download free package from:
  3. ' http://www.rjpcomputing.com/programming/bcx/devsuite.html
  4. ' tested with BCX basic and Pelles C vegaseat 01aug2005
  5.  
  6. ' generates WinMain() and sets the Classname
  7. GUI "mandelbrot2"
  8.  
  9. CONST Yellow = RGB(255,255,0)
  10. CONST SeaGreen = RGB(60,179,113)
  11. CONST Aqua = RGB(0,255,255)
  12. CONST Blue = RGB(0,0,255)
  13. CONST Orange = RGB(255,165,0)
  14. CONST Red = RGB(255,0,0)
  15. CONST Green = RGB(0,255,0)
  16.  
  17. GLOBAL Form1 AS CONTROL
  18. GLOBAL Farbe AS INTEGER
  19.  
  20. Farbe = Yellow ' start with this color
  21.  
  22. ' create the form, center it, show it
  23. SUB FORMLOAD
  24. Form1 = BCX_FORM("Mandelbrot Sets")
  25. BCX_SET_FORM_COLOR(Form1, 0)
  26.  
  27. CENTER(Form1)
  28. SHOW(Form1)
  29. END SUB
  30.  
  31. ' code between BEGIN EVENTS/END EVENTS takes care of the event messages
  32. BEGIN EVENTS
  33. SELECT CASE CBMSG
  34. CASE WM_CREATE
  35. ' 3500 miliseconds for each color
  36. IF NOT SetTimer(hWnd, 1, 3500, 0) THEN
  37. MessageBox (hWnd, "timer error", "error", MB_OK)
  38. PostQuitMessage (0)
  39. END IF
  40. CASE WM_PAINT
  41. DIM RAW ps AS PAINTSTRUCT
  42. DIM RAW hdc AS HDC
  43. hdc = BeginPaint (hWnd, &ps)
  44. DrawMandelbrot(hdc)
  45. DeleteDC (hdc)
  46. EndPaint (hWnd, &ps)
  47. CASE WM_TIMER
  48. SELECT CASE Farbe
  49. CASE Yellow
  50. Farbe = SeaGreen ' go from yellow to seagreen
  51. CASE SeaGreen
  52. Farbe = Aqua ' from seagreen to aqua
  53. CASE Aqua
  54. Farbe = Orange ' etc
  55. CASE Orange
  56. Farbe = Green ' etc
  57. CASE Green
  58. Farbe = Blue
  59. CASE Blue
  60. Farbe = Red
  61. CASE Red
  62. Farbe = Yellow ' back to yellow again
  63. CASE ELSE
  64. Farbe = Yellow ' default Farbe
  65. END SELECT
  66. InvalidateRect(Form1,0,1)
  67. END SELECT
  68. END EVENTS
  69.  
  70.  
  71. SUB DrawMandelbrot (hdc AS HDC)
  72. DIM RAW Count AS INTEGER
  73. DIM RAW A AS SINGLE, B AS SINGLE, C AS SINGLE
  74. DIM RAW I AS SINGLE, R AS SINGLE
  75.  
  76. FOR I = -1.3 TO 1.3 STEP .01
  77. DOEVENTS ' process external events
  78. FOR R = -2.0 TO 1 STEP .01
  79. A = B = C = Count = 0
  80. WHILE ABS(A) <= 2 AND ABS(B) <= 2 AND Count < 128
  81. C = A*A - B*B + R
  82. B = 2*A*B + I
  83. A = C
  84. INCR Count
  85. WEND
  86. SetPixel (hdc, 280 + R*100, 140 + I*100, Count*Farbe)
  87. NEXT
  88. NEXT
  89. UpdateWindow(Form1)
  90. END SUB