QBasic & Borland Pascal & C/Delphi5.iso/Basic/Samples/VB_SMPL/VB_SMPL.ZIP/CDPLAY.EXE/GLOBAL.BAS

BASIC Source File | 1994-03-31 | 22.3 KB | 763 lines

Option Explicit
' Version Number
Global Const MCI_APP_TITLE = "CD Player"
Global Const Version = "Version 1.1"

'*** Global Constants ***
Global Const Timer_Interval = 1000
Global Const SecondsPerMinute = 60
Global Const SecondsPerHour = SecondsPerMinute * 60
Global Const SecondsPerDay = SecondsPerHour * 24&

'*** Global Variables ***
Global TrackNumChange As Integer
Global CRLF As String
Global Tracks_Loaded As Integer
Global NumOfTracks As Integer
Global TrackIndex As Integer
Global AppPath As String
Global MouseX As Integer
Global MouseY As Integer

'*** CD Information ***
Type CD
    CDTitle As String
    ID As Long
    CDAuthor As String
    CDTotalTime As Variant
    CDTrack As Integer
End Type
Global CDTrackNo() As String
Global CDTime() As Variant
Global CDInfo As CD

' These constants are defined in mmsystem.h.
Global Const MCIERR_INVALID_DEVICE_ID = 30257
Global Const MCIERR_DEVICE_OPEN = 30263
Global Const MCIERR_CANNOT_LOAD_DRIVER = 30266
Global Const MCIERR_UNSUPPORTED_FUNCTION = 30274
Global Const MCIERR_INVALID_FILE = 30304
Global Const MCI_NOTIFY_SUCCESSFUL = 1

Global Const MCI_MODE_NOT_OPEN = 524
Global Const MCI_MODE_STOP = 525
Global Const MCI_MODE_PLAY = 526
Global Const MCI_MODE_RECORD = 527
Global Const MCI_MODE_SEEK = 528
Global Const MCI_MODE_PAUSE = 529
Global Const MCI_MODE_READY = 530

' Track Information Format
Global Const MCI_FORMAT_MILLISECONDS = 0
Global Const MCI_FORMAT_TMSF = 10

' For Tab Stops in ListBox
Declare Function SendMessage Lib "user" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wp As Integer, lp As Any) As Long
Global Const WM_USER = &H400
Global Const LB_SETTABSTOPS = WM_USER + 19

' SetWindowPOSITION
Declare Function SetWindowPos Lib "User" (ByVal h1%, ByVal h2%, ByVal X%, ByVal Y%, ByVal cx%, ByVal cy%, ByVal f%) As Integer
Global Const HWND_TOPMOST = -1
Global Const HWND_NOTOPMOST = -2
Global Const SWP_NOMOVE = 2
Global Const SWP_NOSIZE = 1
Global Const FLAGS = SWP_NOMOVE Or SWP_NOSIZE

' For creation of New CD Database
Global Const DB_INTEGER = 3
Global Const DB_DOUBLE = 7
Global Const DB_DATE = 8
Global Const DB_TEXT = 10
Global Const DB_LANG_GENERAL = ";LANGID=0x0809;CP=1252;COUNTRY=0"

' Profile String Information
Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString$, ByVal nSize%, ByVal lpFileName As String) As Integer
Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer

' For Floating Titles
Declare Function WindowFromPoint Lib "User" (ByVal X As Integer, ByVal Y As Integer) As Integer

Sub AnimateIcon (CDTime As Variant)
    Dim FName As String, Fsize As Integer
    Dim FItalic As Integer

    ' Save and Reset Font Options
    FName = CDForm.FontName
    Fsize = CDForm.FontSize
    FItalic = CDForm.FontItalic
    CDForm.FontName = "Modern"
    CDForm.FontSize = 12
    CDForm.FontItalic = False

    CDForm.Cls
    CDForm.Line (0, 0)-(510, 310), &H0, BF
    CDForm.DrawWidth = 2
    CDForm.Line (525, 75)-(530, 350)
    CDForm.Line (50, 350)-(525, 350)
    CDForm.DrawWidth = 1
    CDForm.CurrentX = 10
    CDForm.CurrentY = 10
    CDForm.Print CDTime

    CDForm.FontName = FName
    CDForm.FontSize = Fsize
    CDForm.FontItalic = FItalic

End Sub

Function CDExists (CDIDNo As Long) As Integer
    Dim Db As Database
    Dim Tb As Table

    Set Db = OpenDatabase(AppPath & "\CDPlayer.MDb")
    Set Tb = Db.OpenTable("Titles")
    Tb.Index = "PrimaryKey"
    Tb.Seek "=", CDIDNo
    If Tb.NoMatch Then
    CDExists = False
    Else
    CDExists = True
    End If


End Function

Sub CenterForm (Center As Form, ShowForm As Integer)
    Load Center
    Center.Top = (Screen.Height - Center.Height) / 2
    Center.Left = (Screen.Width - Center.Width) / 2
    If ShowForm = True Then
    Center.Show
    Center.Refresh
    End If
End Sub

Sub CenterLogo (CForm As Form, TheControl As Control)
    CForm.picLogo.Left = (TheControl.Width - CForm.picLogo.Width) / 2
End Sub

Sub ChangeMenuStatus (State As Integer)
        CDForm.mnuOptions.Enabled = State
        CDForm.mnuCDInfo.Enabled = State
        CDForm.Status.Caption = "Length: -None- Time: -None-"
End Sub

Sub CommitChanges ()
    Dim Db As Database
    Dim DS As Dynaset
    Dim Titles As Dynaset, Tracks As Dynaset
    Dim I As Integer

    Set Db = OpenDatabase(AppPath & "\CDPlayer.Mdb")
    Set Titles = Db.CreateDynaset("Titles")
    Set Tracks = Db.CreateDynaset("Tracks")

    If CDExists(CDInfo.ID) Then
    Titles.FindFirst "Title_ID = " & CDInfo.ID
    If Titles.NoMatch Then
        MsgBox "Couldn't Find Record!", 0, "Attention!"
        Exit Sub
    End If
    BeginTrans ' Begin a TransAction
    Titles.Edit
    Titles("Title_Name") = CDInfo.CDTitle
    Titles("Title_Artist") = CDInfo.CDAuthor

    If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
    If Len(CDInfo.CDTotalTime) >= 5 Then
        Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
    Else
        Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
    End If

    Titles.Update
    CommitTrans

    Tracks.Filter = "Title_ID = " & CDInfo.ID
    Set Tracks = Tracks.CreateDynaset()
    BeginTrans

    For I = 1 To NumOfTracks
        Tracks.FindFirst "Track_No = " & I
        Tracks.Edit
        Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
        Tracks("Track_Length") = TimeValue(CDTime(I))
        Tracks.Update
    Next
    CommitTrans

    Else
    BeginTrans
    Titles.AddNew
    Titles("Title_ID") = CDInfo.ID
    Titles("Title_Name") = CDInfo.CDTitle
    Titles("Title_Artist") = CDInfo.CDAuthor

    If CDInfo.CDTotalTime = "" Then CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
    If Len(CDInfo.CDTotalTime) >= 5 Then
        Titles("Title_Length") = TimeValue(("12:" & CDInfo.CDTotalTime))
    Else
        Titles("Title_Length") = TimeValue(CDInfo.CDTotalTime)
    End If

    Titles.Update

    For I = 1 To NumOfTracks
        Tracks.AddNew
        Tracks("Title_ID") = CDInfo.ID
        Tracks("Track_No") = I
        Tracks("Track_Title") = Left$(Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5)), 30)
        Tracks("Track_Length") = TimeValue(CDTime(I))
        Tracks.Update
    Next
    CommitTrans
    End If
End Sub

Sub CreateCDDatabase ()
    On Error GoTo DB_Problems:
    Dim CDPlayer As Database

    ' Titles Table
    Dim NewTitles As New TableDef
    Dim NewTitlesIdx As New Index
    Dim TitlesTitle_ID As New Field
    Dim Title_Name As New Field
    Dim Title_Artist As New Field
    Dim Title_Length As New Field

    ' Tracks Table
    Dim NewTracks As New TableDef
    Dim NewTracksIdx As New Index
    Dim TracksTitle_ID As New Field
    Dim Track_No As New Field
    Dim Track_Title As New Field
    Dim Track_Length As New Field

    CDForm.frmDisabledCD.Caption = "Creating New CD Database . . ."
    Set CDPlayer = CreateDatabase(AppPath & "\CDPlayer.mdb", DB_LANG_GENERAL)

    ' Create Titles Table and Fields
    NewTitles.Name = "Titles"
    TitlesTitle_ID.Name = "Title_ID"
    TitlesTitle_ID.Type = DB_DOUBLE
    Title_Name.Name = "Title_Name"
    Title_Name.Type = DB_TEXT
    Title_Name.Size = 30
    Title_Artist.Name = "Title_Artist"
    Title_Artist.Type = DB_TEXT
    Title_Artist.Size = 30
    Title_Length.Name = "Title_Length"
    Title_Length.Type = DB_DATE

    ' Create Tracks Table and Fields
    NewTracks.Name = "Tracks"
    TracksTitle_ID.Name = "Title_ID"
    TracksTitle_ID.Type = DB_DOUBLE
    Track_No.Name = "Track_No"
    Track_No.Type = DB_INTEGER
    Track_Title.Name = "Track_Title"
    Track_Title.Type = DB_TEXT
    Track_Title.Size = 30
    Track_Length.Name = "Track_Length"
    Track_Length.Type = DB_DATE


    ' Create Indexes
    NewTitlesIdx.Name = "PrimaryKey"
    NewTitlesIdx.Fields = "Title_ID"
    NewTitlesIdx.Primary = True
    NewTitlesIdx.Unique = True
    NewTracksIdx.Name = "PrimaryKey"
    NewTracksIdx.Fields = "Title_ID;Track_No"
    NewTracksIdx.Primary = True
    NewTracksIdx.Unique = True

    ' Append New Fields To Titles Table
    NewTitles.Fields.Append TitlesTitle_ID
    NewTitles.Fields.Append Title_Name
    NewTitles.Fields.Append Title_Artist
    NewTitles.Fields.Append Title_Length

    ' Append New Fields To Track Table
    NewTracks.Fields.Append TracksTitle_ID
    NewTracks.Fields.Append Track_No
    NewTracks.Fields.Append Track_Title
    NewTracks.Fields.Append Track_Length

    ' Append New Indexes
    NewTitles.Indexes.Append NewTitlesIdx
    NewTracks.Indexes.Append NewTracksIdx

    ' Append Tables to Database
    CDPlayer.TableDefs.Append NewTitles
    CDPlayer.TableDefs.Append NewTracks

    ' Close Everything
    CDPlayer.Close
    Exit Sub

DB_Problems:
    Kill AppPath & "\CDPlayer.mdb"
    Resume Next

End Sub

Sub FloatingTitle ()
    Dim Handle As Integer
    Static X As Integer

    X = X + 1
    If X = 3 Then X = 0
    Handle = WindowFromPoint(MouseX, MouseY)

    If CDForm.txtFloatTitle.Tag = "" Then Exit Sub

    'If CDForm.TrackNum((CInt(CDForm.txtFloatTitle.Tag))).hWnd <> Handle Then
    If X = 2 Then
    CDForm.txtFloatTitle.Visible = False
    End If

End Sub

Function GetCDID (NumOfTracks As Integer) As Long
    Dim DiskID As Double
    Dim Track As Integer

    DiskID = CDForm.MMControl1.Tracks
    For Track = 1 To NumOfTracks
    CDForm.MMControl1.Track = Track
    DiskID = DiskID + CDForm.MMControl1.TrackLength
    DiskID = DiskID + CDForm.MMControl1.Length
    Next Track

    GetCDID = DiskID
End Function

Sub GetCDInfo ()
    Dim Db As Database
    Dim DS As Dynaset
    Dim I As Integer
    ReDim CDTrackNo(NumOfTracks)
    ReDim CDTime(NumOfTracks)
    On Error GoTo CreateNewCDPlayer:

    ' Search for CD Data
    Set Db = OpenDatabase(AppPath & "\CDPlayer.mdb")
    Set DS = Db.CreateDynaset("Select * From Titles, Tracks, Titles INNER JOIN Tracks On Titles.Title_ID = Tracks.Title_ID Where Titles.Title_ID = " & CDInfo.ID)

    If DS.BOF = True And DS.EOF = True Then
    CDInfo.CDTitle = "UnTitled"
    CDInfo.CDAuthor = "Unknown"
    CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
    ' Initialize the Array
    UpdateTracks CDForm.MMControl1, False
    I = MsgBox("Would you like to Add this CD to the Database?", 4, "New CD Detected!")
    If I = 6 Then CDEntry.Show 1
    Else
    ' Set up Title Information
    CDInfo.CDTitle = DS("Title_Name")
    CDInfo.CDAuthor = "" & DS("Title_Artist")
    If IsNull(DS("Title_Length")) = False Then
        CDInfo.CDTotalTime = DS("Title_Length")
        If (Left$(CDInfo.CDTotalTime, 2)) = "12" Then
        CDInfo.CDTotalTime = Mid(CDInfo.CDTotalTime, 4, (Len(CDInfo.CDTotalTime) - 3))
        CDInfo.CDTotalTime = Left(CDInfo.CDTotalTime, (Len(CDInfo.CDTotalTime) - 3))
        Else
        CDInfo.CDTotalTime = Left(CDInfo.CDTotalTime, (Len(CDInfo.CDTotalTime) - 3))
        End If

    Else
        CDInfo.CDTotalTime = GetCDLength(NumOfTracks)
    End If

    ' Set up Track Information
    Do While Not DS.EOF
        I = DS("Track_No")
        CDTrackNo(I) = " - """ & DS("Track_Title") & """"

        If DS("Track_Length") = "12:00" Then
        CDTime(I) = Left(DS("Track_Length"), (Len(DS("Track_Length")) - 6))
        Else
        CDTime(I) = GetTrackLength(I)
        End If

        DS.MoveNext
    Loop
    End If
    CDForm.Caption = CDInfo.CDTitle
    Exit Sub

CreateNewCDPlayer:
    CreateCDDatabase
    Set Db = OpenDatabase(AppPath & "\CDPlayer.mdb")
    Resume Next

End Sub

Function GetCDLength (NumOfTracks As Integer) As Variant
    Dim Length As Variant
    Dim Tracks As Integer
    Dim CDSeconds As Integer, CDMinutes As Integer

    CDSeconds = CDSeconds + (CDForm.MMControl1.Length And &HFF00&) / &H100
    CDMinutes = CDMinutes + (CDForm.MMControl1.Length And &HFF)

    Length = DateAdd("s", CDSeconds, Length)
    Length = DateAdd("n", CDMinutes, Length)
    If (Left$(Length, 2)) = "12" Then
    Length = Mid(Length, 4, (Len(Length) - 3))
    GetCDLength = Left(Length, (Len(Length) - 3))
    Else
    GetCDLength = Left(Length, (Len(Length) - 3))
    End If
End Function

Function GetCDTime () As String
    Dim CDMinutes As Integer, CDSeconds As Integer

    CDMinutes = (CDForm.MMControl1.Position And &HFF00&) \ &H100
    CDSeconds = (CDForm.MMControl1.Position And &HFF0000) \ &H10000

    GetCDTime = Format(CStr(CDMinutes & ":" & CDSeconds), "hh:mm")
End Function

Function GetCDTrack () As Integer
    ' Get Track Info
    GetCDTrack = (CDForm.MMControl1.Position And &HFF)

End Function

Sub GetOptionSettings ()
    Dim SectionName As String, TopicName As String
    ReDim Topic(4) As String
    Dim ReturnString As String
    Dim Size As Integer
    Dim INIFileName As String
    Dim ReturnLen As Integer
    Dim I As Integer

    SectionName = "OptionSettings"
    ReturnString = Space$(128)
    Size = Len(ReturnString)
    Topic(0) = "Animate"
    Topic(2) = "OnTop"
    Topic(3) = "Float"
    Topic(4) = "Repeat"

    ' Name of our INI File
    INIFileName = "CDPlayer.INI"

    For I = 0 To 4
    If I = 1 Then I = 2 ' Skip the Option Bar
    TopicName = Topic(I) ' Set up Topic

    ' Call API
    ReturnLen = GetPrivateProfileString(SectionName, TopicName, "", ReturnString, Size, INIFileName)

    If ReturnLen <> 0 Then
        If I < 4 Then
        '* Discard the trailing spaces and null character.
        CDForm.mnuOptionsItem(I).Checked = Left$(ReturnString, ReturnLen)
        Else
        CDForm.Repeat = Left$(ReturnString, ReturnLen)
        End If
    End If
    Next

    If CDForm.mnuOptionsItem(2).Checked Then
    OnTop CDForm
    Else
    OnTop CDForm
    End If

End Sub

Function GetTrackLength (Track As Integer) As Variant
    Dim CDSeconds As Double, CDMinutes As Double

    CDForm.MMControl1.Track = Track
    CDMinutes = CDForm.MMControl1.TrackLength And &HFF
    CDSeconds = (CDForm.MMControl1.TrackLength And &HFF00&) / &H100
    GetTrackLength = CDMinutes & ":" & Format(CDSeconds, "00")

End Function

Sub InitMMControl ()

    ' Initialize Control
    CDForm.frmDisabledCD.Caption = "Initializing The CD Player!"

    ' Force the MCI control to complete before returning
    ' to the application.
    CDForm.MMControl1.Wait = False
    CDForm.MMControl1.UpdateInterval = 0

    ' Set the DeviceType to a musical CD device.
    CDForm.MMControl1.DeviceType = "CDAudio"

    ' Set the time format
    CDForm.MMControl1.TimeFormat = MCI_FORMAT_TMSF

    CDForm.MMControl1.NextEnabled = True
    CDForm.MMControl1.PrevEnabled = True
    NumOfTracks = CDForm.MMControl1.Tracks

    ' Get Unique CD Identifier
    CDForm.frmDisabledCD.Caption = "Retrieving CD Information. . ."
    CDInfo.ID = GetCDID(NumOfTracks)
    GetCDInfo

    ' Find Number of Tracks
    CDForm.frmDisabledCD.Caption = "Loading Track Information. . ."
    Call LoadTracks(NumOfTracks, True)

    ' Set Default Button
    CDForm.frmDisabledCD.Caption = "Setting Default Values. . ."
    TrackNumChange = True
    CDForm.TrackNum(1).Value = True
    TrackNumChange = False

    ' Get rid of Messagebar
    CDForm.frmDisabledCD.Visible = False
    CDForm.Refresh
    CDForm.frmDisabledCD.Caption = "Please Insert A CD!"

    ' Set the track number to the first track.
    CDForm.Status.Caption = "Current Track Length: -None-" & CRLF & "Current Track Time: -None-"
    CDForm.PicTotalTime.Cls
    CDForm.PicTotalTime.Print "    Total Playing Time: " & CDInfo.CDTotalTime

End Sub

Sub LoadListBox (TheControl As Control)
    Dim I As Integer, RetVal As Long
    Static tabs(1 To 3) As Integer

    'Set up the array of defined tab stops.
    tabs(1) = 30
    tabs(2) = 150
    tabs(3) = 200

    'Send a message to the message queue.
    RetVal& = SendMessage(TheControl.hWnd, LB_SETTABSTOPS, 3, tabs(1))


    TheControl.Clear
    For I = 1 To NumOfTracks
    TheControl.AddItem I & ":" & Chr$(9) & (Mid$(CDTrackNo(I), 5, (Len(CDTrackNo(I)) - 5))) & Chr$(9) & CDTime(I)
    Next
End Sub

Sub LoadTracks (NumOfCDTracks As Integer, Action As Integer)
    Dim I As Integer
    Dim X As Integer
    Dim FreeSpace As Integer

    Select Case Action
    Case -1 ' Load Tracks
        FreeSpace = CDForm.DisplayTracks.Width - (NumOfCDTracks * CDForm.TrackNum(0).Width)
        X = FreeSpace / (NumOfCDTracks + 1)

        For I = 1 To NumOfCDTracks
        Load CDForm.TrackNum(I)
        CDForm.TrackNum(I).Top = CDForm.TrackNum(1).Top
        CDForm.TrackNum(I).Left = ((I - 1) * ((CDForm.TrackNum(1).Width) + X)) + X
        CDForm.TrackNum(I).Visible = True
        CDForm.TrackNum(I).ZOrder 0

        Load CDForm.TrackLabel(I)
        CDForm.TrackLabel(I).Top = CDForm.TrackLabel(1).Top
        CDForm.TrackLabel(I).Left = ((I - 1) * ((CDForm.TrackNum(1).Width) + X)) + X
        CDForm.TrackLabel(I).Visible = True
        CDForm.TrackLabel(I).ZOrder 0
        CDForm.TrackLabel(I).Caption = I
        CDForm.TrackLabel(I).Width = CDForm.TextWidth(CDForm.TrackLabel(I))
        Next
        Tracks_Loaded = True
    Case 0 ' Unload Tracks
        For I = NumOfCDTracks To 1 Step -1
        Unload CDForm.TrackNum(I)
        Unload CDForm.TrackLabel(I)
        Next
        Tracks_Loaded = False


    End Select
End Sub

Function MMInstalled () As Integer
    Dim Message As String

    ' Open the CD device -- the disk must already be
    ' in the drive.
    CDForm.MMControl1.Command = "Open"
    If CDForm.MMControl1.Error = 291 Then ' Another program using!
    Message = "The MCI CD Device is in use by another application.  Wait until it is finished, and then" & CRLF
    Message = Message & "try again!"
    MsgBox Message, 0, "Attention!"
    End
    ElseIf CDForm.MMControl1.Error <> 266 And CDForm.MMControl1.CanPlay = False Then
    Message = "(MCI)CD Audio Driver is not installed!" & CRLF
    Message = Message & "Check the Control Panel Settings Under" & CRLF
    Message = Message & "Drivers for CD Audio Driver installation." & CRLF
    MsgBox Message, 0, "Driver Not Installed!"
    End

    ElseIf CDForm.MMControl1.Error = 266 Then ' No CD in Drive
    ChangeMenuStatus False
    CDForm.Timer1.Interval = Timer_Interval
    CDForm.Timer1.Enabled = True
    MMInstalled = False
    Else
    MMInstalled = True
    End If


End Function

Sub OnTop (TopForm As Form)
    Dim RetVal As Integer

    CDForm.mnuOptionsItem(2).Checked = Not CDForm.mnuOptionsItem(2).Checked
    If CDForm.mnuOptionsItem(2).Checked Then
    RetVal = SetWindowPos(TopForm.hWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS)
    Else
    RetVal = SetWindowPos(TopForm.hWnd, HWND_NOTOPMOST, 0, 0, 0, 0, FLAGS)
    End If
End Sub

Sub SaveOptionSettings ()
    Dim SectionName As String, TopicName As String
    ReDim Topic(4) As String
    Dim StringValue As String
    Dim INIFileName As String
    Dim ReturnLen As Integer
    Dim I As Integer

    SectionName = "OptionSettings"
    Topic(0) = "Animate"
    Topic(2) = "OnTop"
    Topic(3) = "Float"
    Topic(4) = "Repeat"

    ' Name of our INI File
    INIFileName = "CDPlayer.INI"

    For I = 0 To 4
    If I = 1 Then I = 2 ' Skip the Option Bar
    TopicName = Topic(I) ' Set up Topic
    If I < 4 Then
        StringValue = CStr(CDForm.mnuOptionsItem(I).Checked)
    Else
        StringValue = CStr(CDForm.Repeat.Value)
    End If

    ' Call API
    ReturnLen = WritePrivateProfileString(SectionName, TopicName, StringValue, INIFileName)
    Next
End Sub

Sub Timer_Control (State As Integer)

    CDForm.Timer1.Interval = Timer_Interval
    CDForm.Timer1.Enabled = State

End Sub

Sub UpdateCaption (TrackNo As Integer, State As String)
    If TrackNo > NumOfTracks Then Exit Sub

    If State = "None" Then
    CDForm.Caption = "Please Insert CD!"
    ElseIf CDForm.Caption = CDInfo.CDTitle & CDTrackNo(TrackNo) Then
    Exit Sub
    ElseIf State = "Stopped" Or State = "Paused" Then
    CDForm.Caption = CDInfo.CDTitle & " (" & State & ")"
    Else
    CDForm.Caption = CDInfo.CDTitle & CDTrackNo(TrackNo)
    End If
End Sub

Sub UpdateCDInfo (CDTrack As Integer, CDTrackTime As Variant)
    If CDTrack > NumOfTracks Then Exit Sub

    ' Update the Track/Time Caption
    CDForm.Status.Caption = "Current Track Length: " & Format(CDTime(CDTrack), "hh:mm") & CRLF & "Current Track Time: " & CDTrackTime

    ' Update the Status Bar!
    Call UpdateStatusBar(CDTime(CDTrack), CDTrackTime)

   ' Set Current Track
    If CDTrack = 0 Then Exit Sub
    TrackNumChange = True
    CDForm.TrackNum(CDTrack).Value = True
    TrackNumChange = False
    CDForm.TrackPanel3D.Refresh

    CDForm.MMControl1.Track = CDTrack

End Sub

Sub UpdateSeek (TotalTime, MousePos As Single)
    Dim Seconds As Integer, Minutes As Integer
    Dim PercentSeek As Double, TSeconds As Integer

    PercentSeek = MousePos / CDForm.CDStatusBar.Width

    TSeconds = (Minute(TotalTime) + (Hour(TotalTime) * 60)) * PercentSeek
    Minutes = TSeconds \ 60
    Seconds = TSeconds Mod 60


    CDForm.MMControl1.To = ((Seconds * 256& * 256&) + (Minutes * 256) + TrackIndex)
    CDForm.MMControl1.Command = "Seek"
End Sub

Sub UpdateStatusBar (TotalTime, CurrentTime)
    On Error Resume Next

    Dim TotalTimeInt As Double
    Dim CurrentTimeInt As Double

    If CurrentTime = "00:00" Then
    CDForm.CDStatusBar.FloodPercent = 0
    Exit Sub
    End If

    TotalTimeInt = (Hour(TotalTime) * 60) + (Minute(TotalTime))
    CurrentTimeInt = (Hour(CurrentTime) * 60) + (Minute(CurrentTime))

    If CurrentTimeInt <= 1 Then
    CDForm.CDStatusBar.FloodPercent = 0
    ElseIf CurrentTimeInt >= 1 And TotalTimeInt >= CurrentTimeInt Then
    CDForm.CDStatusBar.FloodPercent = Format(((CurrentTimeInt / TotalTimeInt) * 100), "##")
    If CDForm.CDStatusBar.FloodPercent >= 50 Then
        CDForm.CDStatusBar.ForeColor = &HFFFFFF
    ElseIf CDForm.CDStatusBar.FloodPercent <= 50 Then
        CDForm.CDStatusBar.ForeColor = &H0&
    End If
    End If
End Sub

Sub UpdateTracks (TheControl As Control, Action As Integer)
    Dim I As Integer
    Dim Title As String

    Select Case Action
    Case -1 ' Update
        For I = 0 To TheControl.ListCount - 1
        Title = Mid$(TheControl.List(I), (InStr(TheControl.List(I), Chr$(9)) + 1), (Len(TheControl.List(I)) - (InStr(TheControl.List(I), Chr$(9)))))
        CDTrackNo(I + 1) = " - """ & (Left$(Title, (InStr(Title, Chr$(9)) - 1))) & """"
        Next
    Case 0 ' Reset
        For I = 1 To NumOfTracks
        CDTrackNo(I) = " - ""Track: " & I & """"
        CDTime(I) = GetTrackLength(I)
        Next
    End Select

End Sub