home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH8 / SRC / JULIA.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-05-06  |  23.2 KB  |  758 lines

  1. VERSION 4.00
  2. Begin VB.Form JuliaForm 
  3.    Caption         =   "Mandelbrot"
  4.    ClientHeight    =   3810
  5.    ClientLeft      =   2460
  6.    ClientTop       =   1320
  7.    ClientWidth     =   3810
  8.    Height          =   4500
  9.    Left            =   2400
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   254
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   254
  14.    Top             =   690
  15.    Width           =   3930
  16.    Begin VB.PictureBox Canvas 
  17.       AutoRedraw      =   -1  'True
  18.       BackColor       =   &H00000000&
  19.       DrawMode        =   6  'Mask Pen Not
  20.       Height          =   3810
  21.       Left            =   0
  22.       MousePointer    =   2  'Cross
  23.       Picture         =   "JULIA.frx":0000
  24.       ScaleHeight     =   250
  25.       ScaleMode       =   3  'Pixel
  26.       ScaleWidth      =   250
  27.       TabIndex        =   0
  28.       Top             =   0
  29.       Width           =   3810
  30.    End
  31.    Begin MSComDlg.CommonDialog FileDialog 
  32.       Left            =   2880
  33.       Top             =   3600
  34.       _Version        =   65536
  35.       _ExtentX        =   847
  36.       _ExtentY        =   847
  37.       _StockProps     =   0
  38.       CancelError     =   -1  'True
  39.    End
  40.    Begin VB.Menu mnuFile 
  41.       Caption         =   "&File"
  42.       Begin VB.Menu mnuFileSaveAs 
  43.          Caption         =   "&Save As..."
  44.          Shortcut        =   ^A
  45.       End
  46.       Begin VB.Menu mnuFileSep 
  47.          Caption         =   "-"
  48.       End
  49.       Begin VB.Menu mnuFileExit 
  50.          Caption         =   "E&xit"
  51.       End
  52.    End
  53.    Begin VB.Menu mnuScaleMnu 
  54.       Caption         =   "&Scale"
  55.       Begin VB.Menu mnuScale 
  56.          Caption         =   "x&2"
  57.          Index           =   2
  58.       End
  59.       Begin VB.Menu mnuScale 
  60.          Caption         =   "x&4"
  61.          Index           =   4
  62.       End
  63.       Begin VB.Menu mnuScale 
  64.          Caption         =   "x&8"
  65.          Index           =   8
  66.       End
  67.       Begin VB.Menu mnuScaleFull 
  68.          Caption         =   "&Full Scale"
  69.       End
  70.    End
  71.    Begin VB.Menu mnuOpt 
  72.       Caption         =   "&Options"
  73.       Begin VB.Menu mnuOptJulia 
  74.          Caption         =   "&Julia"
  75.       End
  76.       Begin VB.Menu mnuOptMandelbrot 
  77.          Caption         =   "&Mandelbrot"
  78.          Checked         =   -1  'True
  79.       End
  80.       Begin VB.Menu mnuOptIter 
  81.          Caption         =   "&Iterations..."
  82.       End
  83.       Begin VB.Menu mnuOptColors 
  84.          Caption         =   "&Colors..."
  85.       End
  86.    End
  87.    Begin VB.Menu mnuMovie 
  88.       Caption         =   "&Movie"
  89.       Begin VB.Menu mnuMovieCreate 
  90.          Caption         =   "&Create Movie..."
  91.       End
  92.    End
  93. Attribute VB_Name = "JuliaForm"
  94. Attribute VB_Creatable = False
  95. Attribute VB_Exposed = False
  96. Option Explicit
  97. Dim DrawingBox As Boolean
  98. Dim StartX As Single
  99. Dim StartY As Single
  100. Dim CurX As Single
  101. Dim CurY As Single
  102. Dim Xmin As Single
  103. Dim Xmax As Single
  104. Dim Ymin As Single
  105. Dim Ymax As Single
  106. Dim MaxWid As Single
  107. Dim MaxHgt As Single
  108. Dim DrawingJulia As Boolean
  109. Dim ReaC As Double
  110. Dim ImaC As Double
  111. Dim MaxIter As Integer
  112. Dim NumClrs As Integer
  113. Dim ok_clr() As Integer
  114. ' ************************************************
  115. ' Draw the appropriate curve.
  116. ' ************************************************
  117. Sub DrawCurve()
  118.     If DrawingJulia Then
  119.         DrawJulia
  120.     Else
  121.         DrawMandelbrot
  122.     End If
  123. End Sub
  124. ' ************************************************
  125. ' Return the number of colors in use.
  126. ' ************************************************
  127. Property Get NumColors() As Integer
  128.     NumColors = NumClrs
  129. End Property
  130. ' ************************************************
  131. ' Return the value of the indicated color.
  132. ' ************************************************
  133. Property Get OkClr(index As Integer) As Integer
  134.     OkClr = ok_clr(index)
  135. End Property
  136. ' ***********************************************
  137. ' Make Canvas's palette contain the system static
  138. ' colors so the colors are saved to files with
  139. ' the image.
  140. ' ***********************************************
  141. Sub PreparePalette(pic As Control)
  142. Dim SysPalSize As Integer
  143. Dim NumStaticColors As Integer
  144. Dim StaticColor1 As Integer
  145. Dim StaticColor2 As Integer
  146. Dim offset As Integer
  147. Dim LogPal As Integer
  148. Dim palentry(0 To 255) As PALETTEENTRY
  149. Dim sys(0 To 255) As PALETTEENTRY
  150. Dim i As Integer
  151.     ' Make sure the screen supports palettes.
  152.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  153.         Beep
  154.         MsgBox "This monitor does not support palettes.", _
  155.             vbCritical
  156.         End
  157.     End If
  158.     ' Get system palette size and # static colors.
  159.     SysPalSize = GetDeviceCaps(hdc, SIZEPALETTE)
  160.     NumStaticColors = GetDeviceCaps(hdc, NUMRESERVED)
  161.     StaticColor1 = NumStaticColors \ 2 - 1
  162.     StaticColor2 = SysPalSize - NumStaticColors \ 2
  163.     ' Make sure pic has the foreground palette.
  164.     pic.ZOrder
  165.     i = RealizePalette(pic.hdc)
  166.     DoEvents
  167.     ' Get the system palette entries.
  168.     i = GetSystemPaletteEntries(pic.hdc, 0, SysPalSize, sys(0))
  169.             
  170.     ' Make the logical palette as big as possible.
  171.     LogPal = pic.Picture.hPal
  172.     If ResizePalette(LogPal, NumStaticColors) = 0 Then
  173.         Beep
  174.         MsgBox "Error resizing logical palette.", _
  175.             vbExclamation
  176.         Exit Sub
  177.     End If
  178.     ' Insert the system static colors.
  179.     For i = 0 To StaticColor1
  180.         palentry(i) = sys(i)
  181.     Next i
  182.     offset = StaticColor2 - StaticColor1 - 1
  183.     For i = StaticColor2 To 255
  184.         palentry(i - offset) = sys(i)
  185.     Next i
  186.     i = SetPaletteEntries(LogPal, 0, NumStaticColors, palentry(0))
  187.     ' Realize the new palette.
  188.     i = RealizePalette(pic.hdc)
  189. End Sub
  190. ' ************************************************
  191. ' Adjust the aspect ratio of the selected
  192. ' coordinates so they fit the window properly.
  193. ' ************************************************
  194. Sub AdjustAspect()
  195. Dim want_aspect As Single
  196. Dim canvas_aspect As Single
  197. Dim hgt As Single
  198. Dim wid As Single
  199. Dim mid As Single
  200.     want_aspect = (Ymax - Ymin) / (Xmax - Xmin)
  201.     canvas_aspect = Canvas.ScaleHeight / Canvas.ScaleWidth
  202.     If want_aspect > canvas_aspect Then
  203.         ' The selected area is too tall and thin.
  204.         ' Make it wider.
  205.         wid = (Ymax - Ymin) / canvas_aspect
  206.         mid = (Xmin + Xmax) / 2
  207.         Xmin = mid - wid / 2
  208.         Xmax = mid + wid / 2
  209.     Else
  210.         ' The selected area is too short and wide.
  211.         ' Make it taller.
  212.         hgt = (Xmax - Xmin) * canvas_aspect
  213.         mid = (Ymin + Ymax) / 2
  214.         Ymin = mid - hgt / 2
  215.         Ymax = mid + hgt / 2
  216.     End If
  217. End Sub
  218. ' ************************************************
  219. ' Draw the Mandelbrot set.
  220. ' ************************************************
  221. Sub DrawMandelbrot()
  222. Const MAX_MAG_SQUARED = 4  ' Work until the magnitude squared > 4.
  223. Dim bm As BITMAP
  224. Dim hbm As Integer
  225. Dim status As Long
  226. Dim bytes() As Byte
  227. Dim wid As Long
  228. Dim hgt As Long
  229. Dim clr As Long
  230. Dim i As Integer
  231. Dim j As Integer
  232. Dim ReaC As Double
  233. Dim ImaC As Double
  234. Dim dReaC As Double
  235. Dim dImaC As Double
  236. Dim ReaZ As Double
  237. Dim ImaZ As Double
  238. Dim ReaZ2 As Double
  239. Dim ImaZ2 As Double
  240.     WaitStart
  241.     AdjustAspect
  242.     ' Get the image pixels.
  243.     hbm = Canvas.Image
  244.     status = GetObject(hbm, 14, bm)
  245.     wid = bm.bmWidthBytes
  246.     hgt = bm.bmHeight
  247.     ReDim bytes(1 To wid, 1 To hgt)
  248.     ' dReaC is the change in the real part
  249.     ' (X value) for C. dImaC is the change in the
  250.     ' imaginary part (Y value).
  251.     dReaC = (Xmax - Xmin) / (wid - 1)
  252.     dImaC = (Ymax - Ymin) / (hgt - 1)
  253.     ' Calculate the values.
  254.     ReaC = Xmin
  255.     For i = 1 To wid
  256.         ImaC = Ymin
  257.         For j = 1 To hgt
  258.             ReaZ = 0
  259.             ImaZ = 0
  260.             ReaZ2 = 0
  261.             ImaZ2 = 0
  262.             clr = 1
  263.             Do While clr < MaxIter And _
  264.                     ReaZ2 + ImaZ2 < MAX_MAG_SQUARED
  265.                 ' Calculate Z(clr).
  266.                 ReaZ2 = ReaZ * ReaZ
  267.                 ImaZ2 = ImaZ * ImaZ
  268.                 ImaZ = 2 * ImaZ * ReaZ + ImaC
  269.                 ReaZ = ReaZ2 - ImaZ2 + ReaC
  270.                 clr = clr + 1
  271.             Loop
  272.             bytes(i, j) = ok_clr(clr Mod NumClrs)
  273.             ImaC = ImaC + dImaC
  274.         Next j
  275.         ReaC = ReaC + dReaC
  276.     Next i
  277.     ' Update the image.
  278.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  279.     Canvas.Refresh
  280.     Caption = "Mandelbrot (" & Format$(Xmin) & ", " & Format$(Ymin) & ")-(" & Format$(Xmax) & ", " & Format$(Ymax) & ")"
  281.     WaitEnd
  282. End Sub
  283. ' ************************************************
  284. ' Draw the Julia set.
  285. ' ************************************************
  286. Sub DrawJulia()
  287. Const MAX_MAG_SQUARED = 4  ' Work until the magnitude squared > 4.
  288. Dim bm As BITMAP
  289. Dim hbm As Integer
  290. Dim status As Long
  291. Dim bytes() As Byte
  292. Dim wid As Long
  293. Dim hgt As Long
  294. Dim clr As Long
  295. Dim i As Integer
  296. Dim j As Integer
  297. Dim dReaZ0 As Double
  298. Dim dImaZ0 As Double
  299. Dim ReaZ0 As Double
  300. Dim ImaZ0 As Double
  301. Dim ReaZ As Double
  302. Dim ImaZ As Double
  303. Dim ReaZ2 As Double
  304. Dim ImaZ2 As Double
  305.     WaitStart
  306.     AdjustAspect
  307.     ' Get the image pixels.
  308.     hbm = Canvas.Image
  309.     status = GetObject(hbm, 14, bm)
  310.     wid = bm.bmWidthBytes
  311.     hgt = bm.bmHeight
  312.     ReDim bytes(1 To wid, 1 To hgt)
  313.     ' dReaZ0 is the change in the real part
  314.     ' (X value) for Z(0). dImaZ0 is the change in
  315.     ' the imaginary part (Y value).
  316.     dReaZ0 = (Xmax - Xmin) / (wid - 1)
  317.     dImaZ0 = (Ymax - Ymin) / (hgt - 1)
  318.     ' Calculate the values.
  319.     ReaZ0 = Xmin
  320.     For i = 1 To wid
  321.         ImaZ0 = Ymin
  322.         For j = 1 To hgt
  323.             ReaZ = ReaZ0
  324.             ImaZ = ImaZ0
  325.             ReaZ2 = ReaZ * ReaZ
  326.             ImaZ2 = ImaZ * ImaZ
  327.             clr = 1
  328.             Do While clr < MaxIter And _
  329.                     ReaZ2 + ImaZ2 < MAX_MAG_SQUARED
  330.                 ' Calculate Z(clr).
  331.                 ReaZ2 = ReaZ * ReaZ
  332.                 ImaZ2 = ImaZ * ImaZ
  333.                 ImaZ = 2 * ImaZ * ReaZ + ImaC
  334.                 ReaZ = ReaZ2 - ImaZ2 + ReaC
  335.                 clr = clr + 1
  336.             Loop
  337.             
  338.             If clr >= MaxIter Then
  339.                 ' Use a non-background color.
  340.                 bytes(i, j) = _
  341.                     ok_clr(((ReaZ2 + ImaZ2) * (NumClrs - 1)) Mod _
  342.                         (NumClrs - 1) + 1)
  343.             Else
  344.                 ' Use the background color.
  345.                 bytes(i, j) = ok_clr(0)
  346.             End If
  347.             
  348.             ImaZ0 = ImaZ0 + dImaZ0
  349.         Next j
  350.         ReaZ0 = ReaZ0 + dReaZ0
  351.         
  352.         ' Let the user know we're not dead.
  353. '@        If i Mod 10 = 0 Then
  354. '@            status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  355. '@            Canvas.Refresh
  356. '@        End If
  357.     Next i
  358.     ' Update the image.
  359.     status = SetBitmapBits(hbm, wid * hgt, bytes(1, 1))
  360.     Canvas.Refresh
  361.     Caption = "Julia (" & Format$(Xmin) & ", " & Format$(Ymin) & ")-(" & Format$(Xmax) & ", " & Format$(Ymax) & ")"
  362.     WaitEnd
  363. End Sub
  364. ' ************************************************
  365. ' Fill in an array with the indexes of the static
  366. ' colors we want to use.
  367. ' ************************************************
  368. Sub InitColors()
  369.     NumClrs = 16
  370.     ReDim ok_clr(0 To NumClrs - 1)
  371.     ok_clr(0) = 0       ' Black
  372.     ok_clr(1) = 1       ' Dark red
  373.     ok_clr(2) = 2       ' Dark green
  374.     ok_clr(3) = 3       ' Dark yellow
  375.     ok_clr(4) = 4       ' Dark blue
  376.     ok_clr(5) = 5       ' Dark magenta
  377.     ok_clr(6) = 6       ' Dark cyan
  378. '   ok_clr( ) = 7       ' Light gray
  379. '   ok_clr( ) = 8       ' Money green
  380.     ok_clr(7) = 9       ' Sky blue
  381.     ok_clr(8) = 246     ' Cream
  382. '   ok_clr( ) = 247     ' Light gray
  383. '   ok_clr( ) = 248     ' Medium gray
  384.     ok_clr(9) = 249     ' Red
  385.     ok_clr(10) = 250    ' Green
  386.     ok_clr(11) = 251    ' Yellow
  387.     ok_clr(12) = 252    ' Blue
  388.     ok_clr(13) = 253    ' Magenta
  389.     ok_clr(14) = 254    ' Cyan
  390.     ok_clr(15) = 255    ' White
  391. End Sub
  392. ' ************************************************
  393. ' Start a rubberband box to select a zoom area.
  394. ' ************************************************
  395. Private Sub Canvas_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
  396.     DrawingBox = True
  397.     StartX = X
  398.     StartY = Y
  399.     CurX = X
  400.     CurY = Y
  401.     Canvas.Line (StartX, StartY)-(CurX, CurY), , B
  402. End Sub
  403. ' ************************************************
  404. ' Continue the zoom area rubberband box.
  405. ' ************************************************
  406. Private Sub Canvas_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
  407.     If Not DrawingBox Then Exit Sub
  408.     Canvas.Line (StartX, StartY)-(CurX, CurY), , B
  409.     CurX = X
  410.     CurY = Y
  411.     Canvas.Line (StartX, StartY)-(CurX, CurY), , B
  412. End Sub
  413. ' ************************************************
  414. ' Zoom in on the selected area.
  415. ' ************************************************
  416. Private Sub Canvas_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
  417. Dim x1 As Single
  418. Dim x2 As Single
  419. Dim y1 As Single
  420. Dim y2 As Single
  421. Dim factor As Single
  422.     If Not DrawingBox Then Exit Sub
  423.     DrawingBox = False
  424.     Canvas.Line (StartX, StartY)-(CurX, CurY), , B
  425.     CurX = X
  426.     CurY = Y
  427.     ' Put the coordinates in proper order.
  428.     If CurX < StartX Then
  429.         x1 = CurX
  430.         x2 = StartX
  431.     Else
  432.         x1 = StartX
  433.         x2 = CurX
  434.     End If
  435.     If x1 = x2 Then x2 = x1 + 1
  436.     If CurY < StartY Then
  437.         y1 = CurY
  438.         y2 = StartY
  439.     Else
  440.         y1 = StartY
  441.         y2 = CurY
  442.     End If
  443.     If y1 = y2 Then y2 = y1 + 1
  444.     ' Convert screen coords into drawing coords.
  445.     factor = (Xmax - Xmin) / Canvas.ScaleWidth
  446.     Xmax = Xmin + x2 * factor
  447.     Xmin = Xmin + x1 * factor
  448.     factor = (Ymax - Ymin) / Canvas.ScaleHeight
  449.     Ymax = Ymin + y2 * factor
  450.     Ymin = Ymin + y1 * factor
  451.     DrawCurve
  452. End Sub
  453. ' ************************************************
  454. ' Force Visual Basic to resize the bitmap.
  455. ' ************************************************
  456. Private Sub Canvas_Resize()
  457.     Canvas.Cls
  458. End Sub
  459. Private Sub Form_Unload(Cancel As Integer)
  460.     End
  461. End Sub
  462. ' ************************************************
  463. ' Allow the user to pick the colors in use.
  464. ' ************************************************
  465. Private Sub mnuOptColors_Click()
  466. Dim frm As New ColorForm
  467. Dim i As Integer
  468.     frm.Show vbModal
  469.     If frm.Canceled Then Exit Sub
  470.     ' See which colors were selected.
  471.     NumClrs = 0
  472.     For i = 0 To 9
  473.         If frm.ColorCheck(i).value = vbChecked Then _
  474.             NumClrs = NumClrs + 1
  475.     Next i
  476.     For i = 246 To 255
  477.         If frm.ColorCheck(i).value = vbChecked Then _
  478.             NumClrs = NumClrs + 1
  479.     Next i
  480.     ' If the user didn't pick at least 2 colors,
  481.     ' use black and white.
  482.     If NumClrs < 2 Then
  483.         NumClrs = 2
  484.         frm.ColorCheck(0).value = vbChecked
  485.         frm.ColorCheck(255).value = vbChecked
  486.     End If
  487.     ' Create the ok_clr array.
  488.     ReDim ok_clr(0 To NumClrs - 1)
  489.     NumClrs = 0
  490.     For i = 0 To 9
  491.         If frm.ColorCheck(i).value = vbChecked Then
  492.             ok_clr(NumClrs) = i
  493.             NumClrs = NumClrs + 1
  494.         End If
  495.     Next i
  496.     For i = 246 To 255
  497.         If frm.ColorCheck(i).value = vbChecked Then
  498.             ok_clr(NumClrs) = i
  499.             NumClrs = NumClrs + 1
  500.         End If
  501.     Next i
  502.     Unload frm
  503. End Sub
  504. ' ***********************************************
  505. ' Load a new data file.
  506. ' ***********************************************
  507. Private Sub mnuFileSaveAs_Click()
  508. Dim fname As String
  509.     ' Allow the user to pick a file.
  510.     On Error Resume Next
  511.     FileDialog.filename = "*.BMP"
  512.     FileDialog.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  513.     FileDialog.ShowSave
  514.     If Err.Number = cdlCancel Then
  515.         Exit Sub
  516.     ElseIf Err.Number <> 0 Then
  517.         Beep
  518.         MsgBox "Error selecting file.", , vbExclamation
  519.         Exit Sub
  520.     End If
  521.     On Error GoTo 0
  522.     fname = Trim$(FileDialog.filename)
  523.     FileDialog.InitDir = Left$(fname, Len(fname) _
  524.         - Len(FileDialog.FileTitle) - 1)
  525.     ' Save the picture.
  526.     SavePicture Canvas.Image, fname
  527. End Sub
  528. ' ***********************************************
  529. ' Give the form and all the picture boxes an
  530. ' hourglass cursor.
  531. ' ***********************************************
  532. Sub WaitStart()
  533.     MousePointer = vbHourglass
  534.     Canvas.MousePointer = vbHourglass
  535.     DoEvents
  536. End Sub
  537. ' ***********************************************
  538. ' Restore the mouse pointers for the form and all
  539. ' the picture boxes.
  540. ' ***********************************************
  541. Sub WaitEnd()
  542.     MousePointer = vbDefault
  543.     Canvas.MousePointer = vbCrosshair
  544. End Sub
  545. ' ************************************************
  546. ' Draw the initial Julia set.
  547. ' ************************************************
  548. Private Sub Form_Load()
  549.     Me.Show
  550.     DoEvents
  551.     MaxIter = 64
  552.     ' Put the system static colors in the palette.
  553.     PreparePalette Canvas
  554.     ' Display the first Julia set.
  555.     InitColors
  556.     mnuScaleFull_Click
  557. End Sub
  558. Private Sub Form_Resize()
  559.     Canvas.Move 0, 0, ScaleWidth, ScaleHeight
  560.     'Canvas.Refresh
  561. End Sub
  562. Private Sub mnuFileExit_Click()
  563.     Unload Me
  564. End Sub
  565. ' ************************************************
  566. ' Let the user set the maximum number of
  567. ' iterations.
  568. ' ************************************************
  569. Private Sub mnuOptIter_Click()
  570. Dim txt As String
  571. Dim value As Integer
  572.     txt = InputBox("Maximum number of iterations:", _
  573.         "Iterations", Format$(MaxIter))
  574.     If txt = "" Then Exit Sub
  575.     If IsNumeric(txt) Then value = CInt(txt)
  576.     If value > 0 Then
  577.         MaxIter = value
  578.     Else
  579.         Beep
  580.     End If
  581. End Sub
  582. ' ************************************************
  583. ' Display the Julia set.
  584. ' ************************************************
  585. Private Sub mnuOptJulia_Click()
  586.     ' If we are displaying a Mandelbrot set,
  587.     ' use the center as C for the Julia set.
  588.     If Not DrawingJulia Then
  589.         ReaC = (Xmin + Xmax) / 2
  590.         ImaC = (Ymin + Ymax) / 2
  591.     End If
  592.     mnuOptJulia.Checked = True
  593.     mnuOptMandelbrot.Checked = False
  594.     DrawingJulia = True
  595.     mnuScaleFull_Click
  596. End Sub
  597. ' ************************************************
  598. ' Display the Mandelbrot set.
  599. ' ************************************************
  600. Private Sub mnuOptMandelbrot_Click()
  601.     mnuOptJulia.Checked = False
  602.     mnuOptMandelbrot.Checked = True
  603.     DrawingJulia = False
  604.     mnuScaleFull_Click
  605. End Sub
  606. ' ************************************************
  607. ' Zoom out to full scale.
  608. ' ************************************************
  609. Private Sub mnuScaleFull_Click()
  610.     If DrawingJulia Then
  611.         Xmin = -1.5
  612.         Xmax = 1.5
  613.         Ymin = -1.5
  614.         Ymax = 1.5
  615.     Else
  616.         Xmin = -2
  617.         Xmax = 1.2
  618.         Ymin = -1.2
  619.         Ymax = 1.2
  620.     End If
  621.     DrawCurve
  622. End Sub
  623. ' ************************************************
  624. ' Make a series of images.
  625. ' ************************************************
  626. Private Sub MakeMovie(fname As String)
  627. Dim num_frames As Integer
  628. Dim frame As Integer
  629. Dim fraction As Single  ' Amount to reduce image.
  630. Dim xmid As Single      ' Center of image.
  631. Dim ymid As Single
  632. Dim wid1 As Single      ' Starting dimensions.
  633. Dim hgt1 As Single
  634. Dim wid2 As Single      ' Finishing dimensions.
  635. Dim hgt2 As Single
  636. Dim wid As Single       ' Current dimensions.
  637. Dim hgt As Single
  638. Dim start_time As Single
  639. Dim stop_time As Single
  640. Dim max_time As Single
  641. Dim min_time As Single
  642. Dim txt As String
  643. Dim value As Integer
  644.     ' See how may frames the user wants.
  645.     txt = InputBox("Number of frames:", _
  646.         "Frames", "20")
  647.     If txt = "" Then Exit Sub
  648.     If IsNumeric(txt) Then num_frames = CInt(txt)
  649.     If num_frames < 1 Then num_frames = 20
  650.     WaitStart
  651.     max_time = 0
  652.     min_time = 100000
  653.         
  654.     ' Set the center of focus and dimensions.
  655.     xmid = (Xmin + Xmax) / 2
  656.     ymid = (Ymin + Ymax) / 2
  657.     wid1 = 3
  658.     wid2 = 0.1
  659.     ' Compute start and finish heights.
  660.     hgt1 = wid1 * Canvas.ScaleHeight / Canvas.ScaleWidth
  661.     hgt2 = wid2 * Canvas.ScaleHeight / Canvas.ScaleWidth
  662.     ' Compute the amount to reduce the image for
  663.     ' each frame.
  664.     fraction = Exp(Log(wid2 / wid1) / num_frames)
  665.     ' Start cranking out frames.
  666.     wid = wid1
  667.     hgt = hgt1
  668.     For frame = 0 To num_frames - 1
  669.         Caption = "Julia" & Str$(frame) & _
  670.             "/" & Format$(num_frames - 1)
  671.         
  672.         Xmin = xmid - wid / 2
  673.         Xmax = xmid + wid / 2
  674.         Ymin = ymid - hgt / 2
  675.         Ymax = ymid + hgt / 2
  676.                 
  677.         start_time = Timer
  678.         DrawJulia
  679.         stop_time = Timer
  680.         
  681.         If min_time > stop_time - start_time Then min_time = stop_time - start_time
  682.         If max_time < stop_time - start_time Then max_time = stop_time - start_time
  683.             
  684.         SavePicture Canvas.Image, _
  685.             fname & Format$(frame) & ".bmp"
  686.         Beep
  687.         DoEvents
  688.                 
  689.         wid = wid * fraction
  690.         hgt = hgt * fraction
  691.     Next frame
  692.     WaitEnd
  693.     MsgBox _
  694.         "Longest:  " & Format$(max_time, "0.00") & _
  695.             " seconds." & vbCrLf & _
  696.         "Shortest: " & Format$(min_time, "0.00") & _
  697.             " seconds." & vbCrLf
  698. End Sub
  699. ' ************************************************
  700. ' Make a series of images.
  701. ' ************************************************
  702. Private Sub mnuMovieCreate_Click()
  703. Dim oldtitle As String
  704. Dim fname As String
  705. Dim pos As Integer
  706.     ' Allow the user to pick a file.
  707.     On Error Resume Next
  708.     oldtitle = FileDialog.DialogTitle
  709.     FileDialog.DialogTitle = "Select base file name (no number)"
  710.     FileDialog.filename = "*.BMP"
  711.     FileDialog.Flags = cdlOFNOverwritePrompt + cdlOFNHideReadOnly
  712.     FileDialog.ShowSave
  713.     FileDialog.DialogTitle = oldtitle
  714.     If Err.Number = cdlCancel Then
  715.         Exit Sub
  716.     ElseIf Err.Number <> 0 Then
  717.         Beep
  718.         MsgBox "Error selecting file.", , vbExclamation
  719.         Exit Sub
  720.     End If
  721.     On Error GoTo 0
  722.     fname = Trim$(FileDialog.filename)
  723.     FileDialog.InitDir = Left$(fname, Len(fname) _
  724.         - Len(FileDialog.FileTitle) - 1)
  725.     ' Trim off the extension if any.
  726.     pos = InStr(fname, ".")
  727.     If pos > 0 Then fname = Left$(fname, pos - 1)
  728.     ' Add a trailing underscore if needed.
  729.     If Right$(fname, 1) <> "_" Then _
  730.         fname = fname & "_"
  731.     ' Make the movie.
  732.     MakeMovie fname
  733. End Sub
  734. ' ************************************************
  735. ' Increase the area shown by a factor of Index.
  736. ' ************************************************
  737. Private Sub mnuScale_Click(index As Integer)
  738. Dim size As Single
  739. Dim mid As Single
  740.     size = index * (Xmax - Xmin)
  741.     If size > 3.2 Then
  742.         mnuScaleFull_Click
  743.         Exit Sub
  744.     End If
  745.     mid = (Xmin + Xmax) / 2
  746.     Xmin = mid - size / 2
  747.     Xmax = mid + size / 2
  748.     size = index * (Ymax - Ymin)
  749.     If size > 2.4 Then
  750.         mnuScaleFull_Click
  751.         Exit Sub
  752.     End If
  753.     mid = (Ymin + Ymax) / 2
  754.     Ymin = mid - size / 2
  755.     Ymax = mid + size / 2
  756.     DrawCurve
  757. End Sub
  758.