home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / BOWDITCH.FRM (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1996-03-28  |  5.1 KB  |  176 lines

  1. VERSION 4.00
  2. Begin VB.Form BowditchForm 
  3.    Caption         =   "Bowditch"
  4.    ClientHeight    =   5310
  5.    ClientLeft      =   2085
  6.    ClientTop       =   900
  7.    ClientWidth     =   4830
  8.    Height          =   6000
  9.    Left            =   2025
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   354
  12.    ScaleMode       =   3  'Pixel
  13.    ScaleWidth      =   322
  14.    Top             =   270
  15.    Width           =   4950
  16.    Begin VB.TextBox PText 
  17.       Height          =   285
  18.       Left            =   1320
  19.       TabIndex        =   5
  20.       Text            =   "4"
  21.       Top             =   45
  22.       Width           =   615
  23.    End
  24.    Begin VB.TextBox QText 
  25.       Height          =   285
  26.       Left            =   2400
  27.       TabIndex        =   4
  28.       Text            =   "5"
  29.       Top             =   45
  30.       Width           =   615
  31.    End
  32.    Begin VB.TextBox DtText 
  33.       Height          =   285
  34.       Left            =   240
  35.       TabIndex        =   3
  36.       Text            =   "0.025"
  37.       Top             =   45
  38.       Width           =   615
  39.    End
  40.    Begin VB.CommandButton CmdGo 
  41.       Caption         =   "Go"
  42.       Default         =   -1  'True
  43.       Height          =   375
  44.       Left            =   4200
  45.       TabIndex        =   1
  46.       Top             =   0
  47.       Width           =   615
  48.    End
  49.    Begin VB.PictureBox Canvas 
  50.       AutoRedraw      =   -1  'True
  51.       Height          =   4815
  52.       Left            =   0
  53.       ScaleHeight     =   -2.2
  54.       ScaleLeft       =   -1.1
  55.       ScaleMode       =   0  'User
  56.       ScaleTop        =   1.1
  57.       ScaleWidth      =   2.2
  58.       TabIndex        =   0
  59.       Top             =   480
  60.       Width           =   4815
  61.    End
  62.    Begin VB.Label Label1 
  63.       Caption         =   "P"
  64.       Height          =   255
  65.       Index           =   3
  66.       Left            =   1200
  67.       TabIndex        =   7
  68.       Top             =   60
  69.       Width           =   255
  70.    End
  71.    Begin VB.Label Label1 
  72.       Caption         =   "Q"
  73.       Height          =   255
  74.       Index           =   2
  75.       Left            =   2235
  76.       TabIndex        =   6
  77.       Top             =   60
  78.       Width           =   255
  79.    End
  80.    Begin VB.Label Label1 
  81.       Caption         =   "dt"
  82.       Height          =   255
  83.       Index           =   1
  84.       Left            =   0
  85.       TabIndex        =   2
  86.       Top             =   60
  87.       Width           =   255
  88.    End
  89.    Begin VB.Menu mnuFile 
  90.       Caption         =   "&File"
  91.       Begin VB.Menu mnuFileExit 
  92.          Caption         =   "E&xit"
  93.       End
  94.    End
  95. Attribute VB_Name = "BowditchForm"
  96. Attribute VB_Creatable = False
  97. Attribute VB_Exposed = False
  98. Option Explicit
  99. Const PI = 3.14159
  100. Const TWO_PI = 2 * PI
  101. Dim P As Integer
  102. Dim Q As Integer
  103. ' ************************************************
  104. ' Draw the curve on the indicated picture box.
  105. ' ************************************************
  106. Sub DrawCurve(pic As PictureBox, start_t As Single, stop_t As Single, Dt As Single)
  107. Dim t As Single
  108.     pic.Cls
  109.     pic.CurrentX = X(start_t)
  110.     pic.CurrentY = Y(start_t)
  111.     t = start_t + Dt
  112.     Do While t < stop_t
  113.         pic.Line -(X(t), Y(t))
  114.         t = t + Dt
  115.     Loop
  116.     pic.Line -(X(stop_t), Y(stop_t))
  117. End Sub
  118. ' ************************************************
  119. ' Non-recursively compute the greatest common
  120. ' divisor of to integers.
  121. ' ************************************************
  122. Private Function GCD(ByVal a As Integer, ByVal b As Integer) As Integer
  123. Dim B_Mod_A As Integer
  124.     B_Mod_A = b Mod a
  125.     Do While B_Mod_A <> 0
  126.         ' Prepare the arguments for the "recursion."
  127.         b = a
  128.         a = B_Mod_A
  129.         B_Mod_A = b Mod a
  130.     Loop
  131.     GCD = a
  132. End Function
  133. ' ************************************************
  134. ' Calculate the values t must cross to draw a
  135. ' Bowditch Curve.
  136. ' ************************************************
  137. Sub SetTBounds(tmin As Single, tmax As Single)
  138.     tmin = 0
  139.     tmax = LCM(P, Q) / P / Q * TWO_PI
  140.     If P Mod 2 = 1 And Q Mod 2 = 1 Then
  141.         tmin = -tmax / 4
  142.         tmax = tmax / 4
  143.     End If
  144. End Sub
  145. ' ************************************************
  146. ' Find the least common multiple of two integers.
  147. ' ************************************************
  148. Function LCM(a As Integer, b As Integer) As Integer
  149.     LCM = a * b / GCD(a, b)
  150. End Function
  151. ' ************************************************
  152. ' The parametric function Y(t).
  153. ' ************************************************
  154. Function Y(t As Single) As Single
  155.     Y = Sin(Q * t)
  156. End Function
  157. ' ************************************************
  158. ' The parametric function X(t).
  159. ' ************************************************
  160. Function X(t As Single) As Single
  161.     X = Sin(P * t)
  162. End Function
  163. Private Sub CmdGo_Click()
  164. Dim tmin As Single
  165. Dim tmax As Single
  166. Dim Dt As Single
  167.     P = CInt(PText.Text)
  168.     Q = CInt(QText.Text)
  169.     SetTBounds tmin, tmax
  170.     Dt = CSng(DtText.Text)
  171.     DrawCurve Canvas, tmin, tmax, Dt
  172. End Sub
  173. Private Sub mnuFileExit_Click()
  174.     Unload Me
  175. End Sub
  176.