home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / atrans1a / sphere.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-09-08  |  2.6 KB  |  102 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Create by Fabiana S. Palacios"
  5.    ClientHeight    =   6900
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6840
  9.    DrawStyle       =   5  'Transparent
  10.    FillStyle       =   0  'Solid
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   6900
  15.    ScaleWidth      =   6840
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.CommandButton Command3 
  19.       Caption         =   "Texture Sphere"
  20.       Height          =   555
  21.       Left            =   2460
  22.       TabIndex        =   2
  23.       Top             =   6300
  24.       Width           =   1995
  25.    End
  26.    Begin VB.CommandButton Command2 
  27.       Caption         =   "Exit"
  28.       Height          =   555
  29.       Left            =   4560
  30.       TabIndex        =   1
  31.       Top             =   6300
  32.       Width           =   2235
  33.    End
  34.    Begin VB.CommandButton Command1 
  35.       Caption         =   "Empty Sphere"
  36.       Height          =   555
  37.       Left            =   120
  38.       TabIndex        =   0
  39.       Top             =   6300
  40.       Width           =   2115
  41.    End
  42. Attribute VB_Name = "Form1"
  43. Attribute VB_GlobalNameSpace = False
  44. Attribute VB_Creatable = False
  45. Attribute VB_PredeclaredId = True
  46. Attribute VB_Exposed = False
  47. Dim cX, cY, cR, o
  48. Private Sub Command1_Click()
  49.   Call drawEmptySphere
  50. End Sub
  51. Private Sub Command2_Click()
  52.   End
  53. End Sub
  54. Private Sub Command3_Click()
  55.   Call drawTextureSphere
  56. End Sub
  57. Private Sub Form_Load()
  58.   Call cValue
  59. End Sub
  60. Public Sub cValue()
  61.   cX = Form1.Width / 2
  62.   cY = Form1.Height / 2
  63.     If cX < cY Then
  64.       cR = cY / 2
  65.     Else
  66.       cR = cX / 2
  67.     End If
  68. End Sub
  69. Public Sub drawEmptySphere()
  70.   Form1.Refresh
  71.   Form1.DrawStyle = 0
  72.   Form1.FillStyle = 1
  73.   o = 1.1
  74.   Form1.Line (cX - cR, cY)-(cX + cR, cY)
  75.   For i = 0.1 To 1 Step 0.1
  76.     Form1.Circle (cX, cY), cR, , , , i
  77.   Next i
  78.   Form1.Line (cX, cY - cR)-(cX, cY + cR)
  79.   For i = 1 To 3 Step o
  80.      Form1.Circle (cX, cY), cR, , , , o
  81.      o = o * 1.3
  82.      Next i
  83.    For i = 1 To 6 Step o
  84.      Form1.Circle (cX, cY), cR, , , , o
  85.      o = o * 1.8
  86.    Next i
  87. End Sub
  88. Public Sub drawTextureSphere()
  89. Dim b%, r%
  90. b = 255
  91. r = 255
  92. Form1.Refresh
  93. Form1.DrawStyle = 5
  94. Form1.FillStyle = 0
  95.   For i = 1 To 0.1 Step -0.01
  96.     b = b - 2
  97.     r = r - 2
  98.     Form1.Circle (cX, cY), cR, , , , i
  99.     Form1.FillColor = RGB(r, 0, b)
  100.   Next i
  101. End Sub
  102.