home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / biobears / bears.frm (.txt) next >
Encoding:
Visual Basic Form  |  1995-09-06  |  7.4 KB  |  229 lines
  1. VERSION 2.00
  2. Begin Form FBear 
  3.    BackColor       =   &H00000000&
  4.    Caption         =   "BioBears"
  5.    ClientHeight    =   2955
  6.    ClientLeft      =   120
  7.    ClientTop       =   1545
  8.    ClientWidth     =   9360
  9.    Height          =   3360
  10.    Icon            =   BEARS.FRX:0000
  11.    Left            =   60
  12.    LinkMode        =   1  'Source
  13.    LinkTopic       =   "Form1"
  14.    ScaleHeight     =   2955
  15.    ScaleWidth      =   9360
  16.    Top             =   1200
  17.    Width           =   9480
  18.    Begin CommandButton QuitButt 
  19.       Caption         =   "Quit"
  20.       Height          =   735
  21.       Left            =   8040
  22.       TabIndex        =   1
  23.       Top             =   2160
  24.       Width           =   1215
  25.    End
  26.    Begin CommandButton CAbout 
  27.       Caption         =   "Calvin And Bears"
  28.       Height          =   735
  29.       Left            =   6000
  30.       TabIndex        =   11
  31.       Top             =   2160
  32.       Width           =   1935
  33.    End
  34.    Begin CommandButton CRythm 
  35.       Caption         =   "BioRythm"
  36.       Height          =   735
  37.       Left            =   4440
  38.       TabIndex        =   10
  39.       Top             =   2160
  40.       Width           =   1455
  41.    End
  42.    Begin Frame FBorn 
  43.       BackColor       =   &H00000000&
  44.       Height          =   855
  45.       Left            =   1920
  46.       TabIndex        =   6
  47.       Top             =   2040
  48.       Width           =   2415
  49.       Begin TextBox TBorn 
  50.          BackColor       =   &H00000000&
  51.          BorderStyle     =   0  'None
  52.          ForeColor       =   &H00FFFFFF&
  53.          Height          =   255
  54.          Left            =   480
  55.          TabIndex        =   8
  56.          Top             =   480
  57.          Width           =   1095
  58.       End
  59.       Begin VScrollBar VBorn 
  60.          Height          =   495
  61.          Left            =   120
  62.          TabIndex        =   9
  63.          Top             =   240
  64.          Width           =   255
  65.       End
  66.       Begin Label LBorn 
  67.          BackColor       =   &H00000000&
  68.          Caption         =   "You were born on..."
  69.          ForeColor       =   &H00FFFFFF&
  70.          Height          =   255
  71.          Left            =   480
  72.          TabIndex        =   7
  73.          Top             =   240
  74.          Width           =   1815
  75.       End
  76.    End
  77.    Begin Frame FToday 
  78.       BackColor       =   &H00000000&
  79.       Height          =   855
  80.       Left            =   120
  81.       TabIndex        =   2
  82.       Top             =   2040
  83.       Width           =   1695
  84.       Begin TextBox TToday 
  85.          BackColor       =   &H00000000&
  86.          BorderStyle     =   0  'None
  87.          ForeColor       =   &H00FFFFFF&
  88.          Height          =   255
  89.          Left            =   480
  90.          TabIndex        =   4
  91.          Top             =   480
  92.          Width           =   1095
  93.       End
  94.       Begin VScrollBar VToday 
  95.          Height          =   495
  96.          Left            =   120
  97.          TabIndex        =   3
  98.          Top             =   240
  99.          Width           =   255
  100.       End
  101.       Begin Label LToday 
  102.          BackColor       =   &H00000000&
  103.          Caption         =   "Today is..."
  104.          ForeColor       =   &H00FFFFFF&
  105.          Height          =   255
  106.          Left            =   480
  107.          TabIndex        =   5
  108.          Top             =   240
  109.          Width           =   1095
  110.       End
  111.    End
  112.    Begin PictureBox PBears 
  113.       AutoSize        =   -1  'True
  114.       BackColor       =   &H00FFFFFF&
  115.       BorderStyle     =   0  'None
  116.       ForeColor       =   &H00000000&
  117.       Height          =   1890
  118.       Left            =   120
  119.       Picture         =   BEARS.FRX:0302
  120.       ScaleHeight     =   66.903
  121.       ScaleMode       =   0  'User
  122.       ScaleWidth      =   105.029
  123.       TabIndex        =   0
  124.       Top             =   120
  125.       Width           =   9120
  126.    End
  127. Sub CAbout_Click ()
  128.     PBears.Cls
  129. End Sub
  130. Sub Command1_Click ()
  131.     End
  132. End Sub
  133. Sub CRythm_Click ()
  134.     DaysOld% = DateValue(TToday.Text) - DateValue(TBorn.Text) - 21
  135.     I% = 0
  136.     OldI% = 0
  137.     PhysPos% = 100 * ((DaysOld% + I%) / 23 - Int((DaysOld% + I%) / 23))
  138.     PhysPY1% = Sin(PhysPos% / 100 * 3.14159 * 2) * 25 + 33
  139.     EmotPos% = 100 * ((DaysOld% + I%) / 28 - Int((DaysOld% + I%) / 28))
  140.     EmotPY1% = Sin(EmotPos% / 100 * 3.14159 * 2) * 25 + 33
  141.     MentPos% = 100 * ((DaysOld% + I%) / 33 - Int((DaysOld% + I%) / 33))
  142.     MentPY1% = Sin(MentPos% / 100 * 3.14149 * 2) * 25 + 33
  143.     For I% = 0 To PBears.ScaleWidth
  144.         
  145.         PBears.DrawWidth = 1
  146.         PBears.Line (OldI%, 0)-(I%, 66.902), QBColor(0), BF
  147.         
  148.         PBears.DrawWidth = 3
  149.         
  150.         Week% = I% Mod 7
  151.         If Week% = 0 And I% <> 21 Then
  152.             PBears.Line (I%, 0)-(I%, 66.902), QBColor(7)
  153.         End If
  154.         If I% = 21 Then
  155.             PBears.DrawWidth = 4
  156.             PBears.Line (I%, 0)-(I%, 66.902), QBColor(12)
  157.         End If
  158.         PBears.DrawStyle = 2
  159.         PBears.PSet (I%, 33), QBColor(13)
  160.         
  161.         PBears.DrawWidth = 2
  162.         PBears.DrawStyle = 0
  163.         PhysPos% = 100 * ((DaysOld% + I%) / 23 - Int((DaysOld% + I%) / 23))
  164.         PhysPY2% = Sin(PhysPos% / 100 * 3.14159 * 2) * 25 + 33
  165.         PBears.Line (OldI%, PhysPY1%)-(I%, PhysPY2%), QBColor(10)
  166.         PhysPY1% = PhysPY2%
  167.         
  168.         EmotPos% = 100 * ((DaysOld% + I%) / 28 - Int((DaysOld% + I%) / 28))
  169.         EmotPY2% = Sin(EmotPos% / 100 * 3.14159 * 2) * 25 + 33
  170.         PBears.Line (OldI%, EmotPY1%)-(I%, EmotPY2%), QBColor(11)
  171.         EmotPY1% = EmotPY2%
  172.         
  173.         MentPos% = 100 * ((DaysOld% + I%) / 33 - Int((DaysOld% + I%) / 33))
  174.         MentPY2% = Sin(MentPos% / 100 * 3.14149 * 2) * 25 + 33
  175.         PBears.Line (OldI%, MentPY1%)-(I%, MentPY2%), QBColor(14)
  176.         MentPY1% = MentPY2%
  177.         
  178.         OldI% = I%
  179.         If I% = 1 Then
  180.             PBears.Line (0, 0)-(0, 66.902), QBColor(7)
  181.         End If
  182.     Next I%
  183.     PBears.DrawWidth = 1
  184.     PBears.Line (3, 15)-(19, 52), QBColor(8), BF
  185.     PBears.Line (2, 13)-(18, 50), QBColor(1), BF
  186.     PBears.Line (2, 13)-(18, 50), QBColor(15), B
  187.     PBears.Line (2, 24)-(18, 24), QBColor(15)
  188.     PBears.ForeColor = QBColor(15)
  189.     PBears.CurrentX = 3
  190.     PBears.CurrentY = 15
  191.     PBears.Print "Today"
  192.     PBears.CurrentX = 3
  193.     PBears.CurrentY = 26
  194.     PBears.Print "Physical"
  195.     PBears.CurrentX = 3
  196.     PBears.CurrentY = 33
  197.     PBears.Print "Emotional"
  198.     PBears.CurrentX = 3
  199.     PBears.CurrentY = 40
  200.     PBears.Print "Mental"
  201.     PBears.DrawWidth = 3
  202.     PBears.Line (14, 19)-(17, 19), QBColor(12)
  203.     PBears.Line (14, 30)-(17, 30), QBColor(10)
  204.     PBears.Line (14, 37)-(17, 37), QBColor(11)
  205.     PBears.Line (14, 44)-(17, 44), QBColor(14)
  206. End Sub
  207. Sub Form_Load ()
  208.     TToday.Text = Date$
  209.     TBorn.Text = "2-13-1962"
  210.     VToday.Value = DateValue(TToday.Text) - 11000
  211.     VBorn.Value = DateValue(TBorn.Text) - 11000
  212. End Sub
  213. Sub PRythm_DblClick ()
  214.     End
  215. End Sub
  216. Sub QuitButt_Click ()
  217.     End
  218. End Sub
  219. Sub VBorn_Change ()
  220.     Dim AdjDate As Long
  221.     AdjDate = VBorn.Value
  222.     TBorn.Text = LTrim$(Str$(Month(AdjDate + 11000))) + "-" + LTrim$(Str$(Day(AdjDate + 11000))) + "-" + LTrim$(Str$(Year(AdjDate + 11000)))
  223. End Sub
  224. Sub VToday_Change ()
  225.     Dim AdjDate As Long
  226.     AdjDate = VToday.Value
  227.     TToday.Text = LTrim$(Str$(Month(AdjDate + 11000))) + "-" + LTrim$(Str$(Day(AdjDate + 11000))) + "-" + LTrim$(Str$(Year(AdjDate + 11000)))
  228. End Sub
  229.