VERSION 5.00
Begin VB.Form frmAbout 
   BackColor       =   &H00000000&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "About Virtual Hypnotist"
   ClientHeight    =   5145
   ClientLeft      =   2340
   ClientTop       =   1935
   ClientWidth     =   6225
   ClipControls    =   0   'False
   FillStyle       =   6  'Cross
   ForeColor       =   &H00FFFFFF&
   Icon            =   "frmAbout.frx":0000
   LinkTopic       =   "Form2"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5145
   ScaleWidth      =   6225
   Begin VB.Timer Timer2 
      Enabled         =   0   'False
      Interval        =   100
      Left            =   0
      Top             =   480
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   5
      Left            =   0
      Top             =   0
   End
   Begin VB.PictureBox Picture1 
      BackColor       =   &H00000000&
      ForeColor       =   &H00000000&
      Height          =   2055
      Left            =   840
      ScaleHeight     =   1995
      ScaleWidth      =   4755
      TabIndex        =   9
      Top             =   2280
      Width           =   4815
      Begin VB.Label lblMsg 
         Alignment       =   2  'Center
         BackColor       =   &H00000000&
         ForeColor       =   &H00FFFFFF&
         Height          =   1935
         Left            =   45
         TabIndex        =   10
         Top             =   0
         Width           =   4695
      End
   End
   Begin VB.CommandButton cmdSysInfo 
      Caption         =   "&System Info..."
      Height          =   375
      Left            =   4980
      Style           =   1  'Graphical
      TabIndex        =   4
      ToolTipText     =   "System information"
      Top             =   4665
      Width           =   1245
   End
   Begin VB.CommandButton Command3 
      Caption         =   "License"
      Height          =   375
      Left            =   3735
      Style           =   1  'Graphical
      TabIndex        =   3
      ToolTipText     =   "GPL software license"
      Top             =   4665
      Width           =   1260
   End
   Begin VB.CommandButton Command2 
      Caption         =   "Changelog"
      Height          =   375
      Left            =   2490
      Style           =   1  'Graphical
      TabIndex        =   2
      ToolTipText     =   "Virtual Hypnotist development changelog"
      Top             =   4665
      Width           =   1260
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Release Notes"
      Height          =   375
      Left            =   1245
      Style           =   1  'Graphical
      TabIndex        =   1
      ToolTipText     =   "View this version's release notes"
      Top             =   4665
      Width           =   1260
   End
   Begin VB.CommandButton cmdOK 
      Caption         =   "OK"
      Height          =   375
      Left            =   0
      Style           =   1  'Graphical
      TabIndex        =   0
      Top             =   4665
      Width           =   1260
   End
   Begin VB.Label Label3 
      Alignment       =   2  'Center
      BackColor       =   &H8000000D&
      BackStyle       =   0  'Transparent
      Caption         =   "OS"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   1560
      TabIndex        =   8
      Top             =   1200
      Width           =   3195
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      BackColor       =   &H8000000D&
      BackStyle       =   0  'Transparent
      Caption         =   "The most advanced interactive hypnosis program ever made ;)"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   525
      Left            =   1560
      TabIndex        =   7
      Top             =   1560
      Width           =   3165
   End
   Begin VB.Label lblTitle 
      Alignment       =   2  'Center
      BackColor       =   &H00FDE6EF&
      BackStyle       =   0  'Transparent
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Virtual Hypnotist"
      BeginProperty Font 
         Name            =   "Times New Roman"
         Size            =   24
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   -1  'True
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   600
      Left            =   1350
      TabIndex        =   5
      Top             =   300
      Width           =   3555
   End
   Begin VB.Label lblVersion 
      Alignment       =   2  'Center
      BackColor       =   &H8000000D&
      BackStyle       =   0  'Transparent
      Caption         =   "Version"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00000000&
      Height          =   225
      Left            =   1320
      TabIndex        =   6
      Top             =   960
      Width           =   3645
   End
   Begin VB.Shape Shape1 
      BackColor       =   &H00FFFFFF&
      BorderColor     =   &H00000000&
      FillColor       =   &H00FDE6EF&
      FillStyle       =   0  'Solid
      Height          =   2055
      Left            =   1200
      Shape           =   4  'Rounded Rectangle
      Top             =   120
      Width           =   3855
   End
   Begin VB.Image Image2 
      BorderStyle     =   1  'Fixed Single
      Height          =   1800
      Left            =   3960
      Stretch         =   -1  'True
      Top             =   240
      Width           =   2055
   End
   Begin VB.Image Image1 
      BorderStyle     =   1  'Fixed Single
      Height          =   1800
      Left            =   240
      Stretch         =   -1  'True
      Top             =   240
      Width           =   2055
   End
   Begin VB.Shape Shape2 
      BackColor       =   &H00000000&
      BorderColor     =   &H00000000&
      FillColor       =   &H00C0C0C0&
      FillStyle       =   7  'Diagonal Cross
      Height          =   1455
      Left            =   0
      Top             =   2760
      Width           =   1335
   End
End
Attribute VB_Name = "frmAbout"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'Virtual Hypnotist
'©2003-2008 FollowTheWatch Software
'http://vhypno.sourceforge.net
'http://sourceforge.net/projects/vhypno
'Contact - followthewatch55@yahoo.com

'This program is free software; you can redistribute it and/or
'modify it under the terms of the GNU General Public License
'as published by the Free Software Foundation; either version 2
'of the License, or (at your option) any later version.

'This program is distributed in the hope that it will be useful,
'but WITHOUT ANY WARRANTY; without even the implied warranty of
'MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'GNU General Public License for more details.

'You should have received a copy of the GNU General Public License
'along with this program; if not, write to the Free Software
'Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

Option Explicit

Private Fader As New ColorFader

' Reg Key Security Options...
Const READ_CONTROL = &H20000
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
                       KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
                       KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
                     
' Reg Key ROOT Types...
Const HKEY_LOCAL_MACHINE = &H80000002
Const ERROR_SUCCESS = 0
Const REG_SZ = 1                         ' Unicode nul terminated string
Const REG_DWORD = 4                      ' 32-bit number

Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
Const gREGVALSYSINFOLOC = "MSINFO"
Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
Const gREGVALSYSINFO = "PATH"

Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long


Private Sub cmdSysInfo_Click()
  Call StartSysInfo
End Sub

Private Sub cmdOK_Click()
  Unload Me
End Sub

Private Sub Command1_Click()
If ExceptionHandlers = True Then On Error GoTo ErrorHandler
Dim TempString As String
Dim TempString2 As String
'load file
Open App.path + "\readme.rtf" For Input As #1
    TempString = ""
    TempString2 = ""
    Do While Not EOF(1)
        DoEvents
        Line Input #1, TempString
        TempString2 = TempString2 + TempString + vbCrLf
    Loop
Close #1

Call frmViewer.View(3, "Release Notes", 0, TempString2)
Exit Sub

ErrorHandler:
err.Source = "About Screen - Command1"
   Call ErrorReport("An error occurred while loading the release notes.", vbExclamation)

End Sub

Private Sub Command2_Click()
If ExceptionHandlers = True Then On Error GoTo ErrorHandler
Dim TempString As String
Dim TempString2 As String
'load file
Open App.path + "\changelog.txt" For Input As #1
    TempString = ""
    TempString2 = ""
    Do While Not EOF(1)
        DoEvents
        Line Input #1, TempString
        TempString2 = TempString2 + TempString + vbCrLf
    Loop
Close #1

Call frmViewer.View(1, "Changelog", 0, TempString2)
Exit Sub

ErrorHandler:
err.Source = "About Screen - Command2"
   Call ErrorReport("An error occurred while loading the changelog.", vbExclamation)

End Sub

Private Sub Command3_Click()
If ExceptionHandlers = True Then On Error GoTo ErrorHandler
Dim TempString As String
Dim TempString2 As String
'load file
Open App.path + "\gpl.txt" For Input As #1
    TempString = ""
    TempString2 = ""
    Do While Not EOF(1)
        DoEvents
        Line Input #1, TempString
        TempString2 = TempString2 + TempString + vbCrLf
    Loop
Close #1

Call frmViewer.View(1, "License", 0, TempString2)
Exit Sub

ErrorHandler:
err.Source = "About Screen - Command3"
   Call ErrorReport("An error occurred while loading the license file.", vbExclamation)

End Sub

Private Sub Form_Load()
Fader.StartColor = QBColor(7)
Fader.EndColor = vbYellow
Fader.Steps = 100
Fader.PingPong = False
lblMsg.Top = Picture1.Height
lblMsg.Height = 7000
Shape2.Left = 0
Shape2.Top = 0
Shape2.Width = Me.Width
Shape2.Height = Me.Height
lblMsg.Caption = "Virtual Hypnotist " + LTrim$(App.Major) + "." + LTrim$(App.Minor) + vbCrLf + vbCrLf + "©2003-2008 FollowTheWatch Software" + vbCrLf + vbCrLf + "Created by FollowTheWatch55" + vbCrLf + vbCrLf
lblMsg.Caption = lblMsg.Caption + "Warning - This software was designed for recreational use only and comes with ABSOLUTELY NO WARRANTY.  The maker(s) of this software are not responsible for anything negative resulting from the use of this software.  This is free software, and you are welcome to redistribute it under certain conditions.  For details, see the file gpl.txt" + vbCrLf + vbCrLf + vbCrLf + "----- Credits -----" + vbCrLf + vbCrLf + "Program and Program Concept by FollowTheWatch55" + vbCrLf + vbCrLf + "3D environments originally part of HypnoHouse by FollowTheWatch55" + vbCrLf + vbCrLf
lblMsg.Caption = lblMsg.Caption + "Includes Microsoft Agent technology" + vbCrLf + "The Genie and Merlin characters are" + vbCrLf + "(c) 1996-1998 Microsoft Corporation. All rights reserved." + vbCrLf + "All other characters are copyright by their respective creators or owners." + vbCrLf + vbCrLf + "Brainwave Sychronizer originally Kyma Mindwave by Michael Herbert" + vbCrLf + vbCrLf + "Spiral code in Visual Maker originally by GD Software" + vbCrLf + vbCrLf + "Color Tunnel code originally by Jose M. Lopez" + vbCrLf + vbCrLf + "AIM-compatable instant messenger system by DosFX" + vbCrLf + vbCrLf + "ZIP file creation and unpacking by vbAccelerator" + vbCrLf + vbCrLf + "File downloader by Sean Gallardy" + vbCrLf + vbCrLf + "Encryption by DanSoft Australia" + vbCrLf + vbCrLf + vbCrLf + "Updates and Information at http://vhypno.sourceforge.net" + vbCrLf + vbCrLf + vbCrLf + "Seran is Loved and Owned"
Image1.Picture = frmSplash.imgLogo.Picture
Image2.Picture = frmSplash.imgLogo.Picture
frmAbout.Left = (ScreenX / 2) - (frmAbout.Width / 2)
frmAbout.Top = (ScreenY / 2) - (frmAbout.Height / 2)
    'Me.Caption = "About " & App.Title
    If ReleaseType = 4 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " Build " & App.Revision
    If ReleaseType = 3 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " RC " & BetaVersion & " Build " & App.Revision
    If ReleaseType = 2 And BetaVersion > 0 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " Beta " & BetaVersion & " Build " & App.Revision
    If ReleaseType = 2 And BetaVersion = 0 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " Beta Build " & App.Revision
    If ReleaseType = 1 And BetaVersion > 0 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " Alpha " & BetaVersion & " Build " & App.Revision
    If ReleaseType = 1 And BetaVersion = 0 Then lblVersion.Caption = "Version " & App.Major & "." & App.Minor & " Alpha Build " & App.Revision
    Label3.Caption = "On Windows "
    If getWindowsVersion(0) = 2 Then
        Label3.Caption = Label3.Caption + "NT "
        'Give raw version numbers for NT, 2000, and XP instead of regular names like above
        Label3.Caption = Label3.Caption + LTrim$(getWindowsVersion(1)) + "." + LTrim$(getWindowsVersion(2))
    End If
    If getWindowsVersion(0) = 1 Then
        If getWindowsVersion(2) = 0 Then Label3.Caption = Label3.Caption + "95"
        If getWindowsVersion(2) = 10 Then Label3.Caption = Label3.Caption + "98"
        If getWindowsVersion(2) > 10 Then Label3.Caption = Label3.Caption + "ME"
    End If
    'lblTitle.Caption = App.Title
Timer1.Enabled = True
Timer2.Enabled = True
End Sub

Public Sub StartSysInfo()
    On Error GoTo SysInfoErr
  
    Dim rc As Long
    Dim SysInfoPath As String
    
    ' Try To Get System Info Program Path\Name From Registry...
    If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
    ' Try To Get System Info Program Path Only From Registry...
    ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
        ' Validate Existance Of Known 32 Bit File Version
        If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
            SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
            
        ' Error - File Can Not Be Found...
        Else
            GoTo SysInfoErr
        End If
    ' Error - Registry Entry Can Not Be Found...
    Else
        GoTo SysInfoErr
    End If
    
    Call Shell(SysInfoPath, vbNormalFocus)
    
    Exit Sub
SysInfoErr:
Call ErrorReport("System Information Is Unavailable At This Time.", vbExclamation)
End Sub

Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
    Dim I As Long                                           ' Loop Counter
    Dim rc As Long                                          ' Return Code
    Dim hKey As Long                                        ' Handle To An Open Registry Key
    Dim hDepth As Long                                      '
    Dim KeyValType As Long                                  ' Data Type Of A Registry Key
    Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
    Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
    '------------------------------------------------------------
    ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
    '------------------------------------------------------------
    rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
    
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
    
    tmpVal = String$(1024, 0)                             ' Allocate Variable Space
    KeyValSize = 1024                                       ' Mark Variable Size
    
    '------------------------------------------------------------
    ' Retrieve Registry Key Value...
    '------------------------------------------------------------
    rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
                         KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
                        
    If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
    
    If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
        tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
    Else                                                    ' WinNT Does NOT Null Terminate String...
        tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
    End If
    '------------------------------------------------------------
    ' Determine Key Value Type For Conversion...
    '------------------------------------------------------------
    Select Case KeyValType                                  ' Search Data Types...
    Case REG_SZ                                             ' String Registry Key Data Type
        KeyVal = tmpVal                                     ' Copy String Value
    Case REG_DWORD                                          ' Double Word Registry Key Data Type
        For I = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
            KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, I, 1)))   ' Build Value Char. By Char.
        Next
        KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
    End Select
    
    GetKeyValue = True                                      ' Return Success
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
    Exit Function                                           ' Exit
    
GetKeyError:      ' Cleanup After An Error Has Occured...
    KeyVal = ""                                             ' Set Return Val To Empty String
    GetKeyValue = False                                     ' Return Failure
    rc = RegCloseKey(hKey)                                  ' Close Registry Key
End Function

Private Sub Timer1_Timer()
    If lblMsg.Top > -lblMsg.Height Then
        lblMsg.Top = lblMsg.Top - 1
    Else
        lblMsg.Top = Picture1.Height
    End If
End Sub

Private Sub Timer2_Timer()
Static CColor As Long
Static LC As Long
CColor = Fader.GetNextColor
If CColor = -1 Then
    Fader.Reset
    Fader.StartColor = LC
    Fader.EndColor = QBColor(CInt(Rnd * 15))
    CColor = Fader.GetNextColor
Else
    LC = CColor
    If LC < 0 Then LC = 0
End If
If CColor >= 0 Then
    cmdOK.BackColor = CColor
    'cmdSysInfo.BackColor = CColor
    'Command1.BackColor = CColor
    'Command2.BackColor = CColor
    'Command3.BackColor = CColor
End If

End Sub
