Guidance
指路人
g.yi.org
software / rapidq / Examples / Graphics & Animation / fractal / fractal.bas

Register 
注册
Search 搜索
首页 
Home Home
Software
Upload

  
'***  Written by Duanne McMahon 15 July 2002
'
'*** Idea came from Acorn User May 1988 (Magazine)
'*** Listing 4, Page 116, Fractals
'
'*** Updated and completed on 16 August 2002
'*** Email me at nzthordm@icqmail.com if you like this
'
'Actual program lists as follows...
'
's=20*SINRAD(45) = 0.850903524534118424862379677618041
'c=20*COSRAD(45) = 0.525321988817729696047464404823563
'MODE 15 = Graphics mode, 1280x1024, 16Million colours?
'OFF = Turn off mouse cursor, so doesn't overlay graphics
'ORIGIN 640,512 = Centers graphics cursor in center of screen
'i.e. so graphics window is (-640,-512)-(640,512)
'INPUT j,k,l
'CLS = clear screen
'x=0
'y=0
'REPEAT = start drawing loop
'GCOL RND(64)-1 TINT (RND(3)-1)<<6 = selects graphics colour randomly
'FOR i=1 TO 500
'xx=y-SGN(x)*SQR(ABS(k*x-1))
'y=j-x
'x=xx
'POINT x*s+y*c-48,y*s-x*c-16 = plots point in selected colour
'NEXT
'UNTIL 0 = repeats drawing loop infinitly
'
'Actual program as listed was designed for Basic V (5) on Archimedes
'

     $RESOURCE ICO_TEST AS "C:\ICONS\55.ico"

     DECLARE SUB CanvasPaint (Sender AS QCANVAS)
     DECLARE SUB ButtonClick (Sender AS QBUTTON)
     DECLARE FUNCTION RAD (numDegree AS DOUBLE) AS DOUBLE

     $ESCAPECHARS ON

     DIM BitHeight AS SHORT
     DIM BitWidth AS SHORT

     BitHeight = 320
     BitWidth = 512

' Create bitmap for off-screen use
     CREATE BitMap AS QBITMAP
      Height = BitHeight
      Width = BitWidth
      Paint(0,0,0,0)
     END CREATE

     CREATE t AS QTIMER
      interval = 1
      enabled = 1
      ontimer = CanvasPaint
     END CREATE


     CREATE Form AS QFORM
      IcoHandle = ICO_TEST
      CAPTION = "Graphic Demo : Created 15 July, 2002 : Duanne McMahon"
      Width = 680
      Height = 480
      Center
      BorderStyle = 3
'        Color = 0

      CREATE Label1 AS QLABEL
       CAPTION = "Written by Duanne McMahon (c) 2002\r\nEmail : nzthordm@icqmail.com"
       Left = 10
       Top = 10
       Width = 200
       Height = 30
       Transparent = 0
      END CREATE
      CREATE Label2 AS QLABEL
       CAPTION = "Enter three numbers, each between 2\r\nand 12 and then hit the Start button"
       Left = 220
       Top = 10
       Width = 220
       Height = 30
       Transparent = 0
      END CREATE
      CREATE Canvas1 AS QCANVAS
       Left = 20
       Top = 100
       Height = BitHeight
       Width = BitWidth
       COLOR = 0
       OnPaint = CanvasPaint
      END CREATE
      CREATE StartB AS QBUTTON
       CAPTION = "Start"
       OnClick = ButtonClick
       Hint = "Starts drawing"
       ShowHint = 1
       Left = 24
       Top = 60
      END CREATE
      CREATE StopB AS QBUTTON
       CAPTION = "Stop"
       OnClick = ButtonClick
       Hint = "Stops drawing"
       ShowHint = 1
       Left = 121
       Top = 60
       TabOrder = 1
      END CREATE
      CREATE EndB AS QBUTTON
       CAPTION = "Exit"
       OnClick = ButtonClick
       Hint = "Exits program"
       ShowHint = 1
       Left = 400
       Top = 60
      END CREATE
      CREATE Input1 AS QEDIT
       Hint = "Number between 2 and 12"
       Left = 270
       Top = 60
       Width = 25
       ShowHint = 1
      END CREATE
      CREATE Input2 AS QEDIT
       Hint = "Number between 2 and 12"
       Left = 300
       Top = 60
       Width = 25
       ShowHint = 1
      END CREATE
      CREATE Input3 AS QEDIT
       Hint = "Number between 2 and 12"
       Left = 330
       Top = 60
       Width = 25
       ShowHint = 1
      END CREATE

     END CREATE

'** Setup varibles
     DIM s AS DOUBLE
     DIM c AS DOUBLE
     DIM j AS INTEGER
     DIM k AS INTEGER
     DIM l AS INTEGER
     DIM x AS DOUBLE
     DIM y AS DOUBLE
     DIM xx AS DOUBLE
     DIM yy AS DOUBLE
     DIM xxx AS DOUBLE
     DIM yyy AS DOUBLE
     DIM cR AS SHORT
     DIM cG AS SHORT
     DIM cB AS SHORT

's=20*SINRAD(45)
'c=20*COSRAD(45)
'The 20 above, is only a multiplier to make it larger/visible
     s = 4 * SIN(RAD(45))
     c = 4 * COS(RAD(45))
'Only need to make it 4 for windows, may need other values on
'different screen sizes

'Show form and wait for input (i.e. StartButton)
     Form.SHOWMODAL

     SUB CanvasPaint (Sender AS QCANVAS)
      Sender.Draw(0,0,Bitmap.BMP)
     END SUB

     SUB ButtonClick (Sender AS QBUTTON)
      SELECT CASE Sender.CAPTION
      CASE "Start"
       RANDOMIZE TIMER
'
'INPUT j,k,l
'CLS = clear screen
       j$ = Input1.Text
       k$ = Input2.Text
       l$ = Input3.Text
       j = VAL(j$)
       k = VAL(k$)
       l = VAL(l$)
       IF j < 2 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 1",0)
        DO
         DOEVENTS
        LOOP
       END IF
       IF k < 2 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 2",0)
        DO
         DOEVENTS
        LOOP
       END IF
       IF l < 2 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 3",0)
        DO
         DOEVENTS
        LOOP
       END IF
       IF j > 12 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 1",0)
        DO
         DOEVENTS
        LOOP
       END IF
       IF k > 12 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 2",0)
        DO
         DOEVENTS
        LOOP
       END IF
       IF l > 12 THEN
        MESSAGEBOX("Must enter values between 2 and 12.","Error in input 3",0)
        DO
         DOEVENTS
        LOOP
       END IF

'BitMap.Paint(0,0,0,0)
       BitMap.FillRect(0,0,BitWidth,BitHeight,0)
       Canvas1.Repaint
'
'x=0
'y=0
'REPEAT = start drawing loop
       x = 0
       y = 0
       DO
'
'GCOL RND(64)-1 TINT (RND(3)-1)<<6 = selects graphics colour randomly
        cR = RND(256)
        cG = RND(256)
        cB = RND(256)
        cR = cR * 256 * 256
        cG = cG * 256
        colour% = cR + cG + cB
'colour% = RND(16777216) be warned, might have to be in 16M colour mode
'
        FOR i=1 TO 500
         xx = y - SGN(x) * SQR(ABS(k * x - 1))
         y = j - x
         x = xx
'
'POINT x*s+y*c-48,y*s-x*c-16 = plots point in selected colour
         xxx = ((x * s) + (y * c) - 48) + (0.5 * BitWidth)
         yyy = ((y * s) - (x * c) - 16) + (0.5 * BitHeight)
'
'ORIGIN 640,512 = Centers graphics cursor in center of screen
'i.e. so graphics window is (-640,-512)-(640,512)
'
         Bitmap.Pset(xxx,yyy,colour%)
         IF i = 500 THEN
          DOEVENTS ' Uses alot of CPU, so need this to make sure other programs get a share
         END IF
        NEXT
       LOOP
      CASE "Stop"
'
'        while debug, stop button closes program
        'END
       DO
        DOEVENTS
       LOOP

      CASE "Exit"
       END

      END SELECT
'    Canvas.Repaint       '-- Tell Canvas to repaint itself.
     END SUB

     FUNCTION RAD (numDegree AS DOUBLE) AS DOUBLE
      result = numDegree * (3.1415926535897932384626433832795 / 180)
     END FUNCTION
掌柜推荐
 
 
 
 
 
 
 
 
 
 
 
 
© Fri 2024-4-26  Guidance Laboratory Inc.
Email:webmaster1g.yi.org Hits:0 Last modified:2002-08-19 17:37:54