

1.JACMIDI List of Files (Jacmidi.mak)

JACMIDI.BAS (Declaration of global variables and general procedures)
Controls-
C:\WINDOWS\SYSTEM\CMDIALOG.VBX (for loading files etc.)
Forms
ABOUT.FRM (Title Screen)
CREATALB.FRM (Dialogue screen to create file list (album)
PLAYSONG.FRM (Main Screen with menus and buttons)
SHOWWORD.FRM (Text Screen to display lyrics)
SHOWPIC.FRM (Picture Screen to display visuals)
Compiles program-
ExeName="JACMIDI.EXE"

2. JACMIDI.BAS

Windows API Functions (to send messages to MCI - Media Control Interface)
Declare Function mcisendstring Lib "c:\windows\system\MMsystem" (ByVal lpstrCoMMand As String, ByVal lpstrReturnString As String, ByVal nSize As Integer, ByVal hCallback As Integer) As Long
Declare Function mciGetErrorString Lib "c:\windows\system\MMsystem" (ByVal dwError As Long, ByVal lpstrBuffer As String, ByVal WLength As Integer) As Integer


Main  shared Variables-
Global saveit As Integer
Global midisong As String
Global songwithpath As String
Global album As String
Global albumwithpath As String
Global nowplaying As Integer
Global paused As Integer
Global stopped As Integer
Global Lastpath As String
Global lyric As String
Global tempfilename As String
Global targetpath As String
Global targetfile As String
Global sourcepath As String
Global response As Integer
Global filewithpath As String
Global FName As String
Global newalbum As Integer
Global short As Integer
Global playsec As Integer
Global start As Double
Global picfile As String

Dim used() As Integer

**Function to check if file exists-**

Function FileExists (filename As String) As Integer
 On Error GoTo FileNotFound
 Open filename For Input As #1
 Close #1
 FileExists = True
 Exit Function
FileNotFound:
 Resume NextLine
NextLine:
FileExists = 0
End Function


**Function to separate filename from path with drive and directories-**

 Function Fnameextract (filewithpath) As String
  Dim length As Integer, pathlen As Integer
 length = Len(filewithpath)
 If length < 5 Then Exit Function
 'filewithpath = Left(filewithpath, length - 5)
 'length = length - 5
(NB These 2 lines will strip away the file extension (.*) as well) 
pathlen = length + 1
 pathlen = length + 1
 Do
 pathlen = pathlen - 1
 Loop Until Mid(filewithpath, pathlen, 1) = "\"
 Fnameextract = Right(filewithpath, length - pathlen)
End Function


**Procedure used to launch the program**

Sub Main ()
FrmAbout.Show 1
FrmPlaySongs.Show 0
Lastpath = CurDir
End Sub


**Proc for jumping to next song in current list-**

Sub NextSong ()
Dim item As Integer
item = FrmPlaySongs.LstPlayAlbum.ListIndex
If item = FrmPlaySongs.LstPlayAlbum.ListCount - 1 Then
StopSong
Exit Sub
End If
StopSong
FrmPlaySongs.LstPlayAlbum.Selected(item + 1) = True
midisong = FrmPlaySongs.LstPlayAlbum.List(item + 1)
PlaySong
End Sub


**Proc for pausing current song**

 Sub PauseSong ()
If FrmPlaySongs.LstPlayAlbum.ListIndex = -1 Then
Exit Sub
End If
If nowplaying = 0 Then
Exit Sub
End If
If paused = 0 Then
FrmPlaySongs.Timer1.Enabled = 0
dothis = "pause song"
SendMCIcommand (dothis)
FrmPlaySongs.LblNowPlaying.Caption = "Paused"
FrmPlaySongs.CmdPause.Caption = "Resume"
FrmShowWords.CmdPause.Caption = "Resume"
paused = True
Else
dothis = "play song"
SendMCIcommand (dothis)
FrmPlaySongs.Timer1.Interval = 1000
FrmPlaySongs.Timer1.Enabled = True
FrmPlaySongs.LblNowPlaying.Caption = "Now Playing"
FrmPlaySongs.CmdPause.Caption = "Pause"
FrmShowWords.CmdPause.Caption = "Pause"
paused = 0
End If
End Sub


**Proc for playing selected song**

  Sub PlaySong ()
Dim dothis As String
Dim closed As Integer
If paused = True Then   'Resume play after Pause
 dothis = "play song"
 SendMCIcommand (dothis)
 FrmPlaySongs.TxtNowPlaying.Text = midisong
 FrmPlaySongs.LblNowPlaying.Caption = "Now Playing"
 paused = 0
 Exit Sub
 End If
 FrmPlaySongs.CmdPlaySingleSong.Enabled = 0
 FrmPlaySongs.CmdClear.Enabled = 0
 FrmPlaySongs.CmdOpen.Enabled = 0
 FrmPlaySongs.CmdOpenAlbum.Enabled = 0
 FrmPlaySongs.CmdPlayAlb.Enabled = 0
 FrmPlaySongs.MnuAlbum.Enabled = 0
 FrmPlaySongs.MnuFile.Enabled = 0
 FrmPlaySongs.MnuBrowse.Enabled = 0
 midisong = FrmPlaySongs.LstPlayAlbum.List(FrmPlaySongs.LstPlayAlbum.ListIndex)
 FrmPlaySongs.LblNowPlaying.Caption = "Now Playing " + Str$(FrmPlaySongs.LstPlayAlbum.ListIndex + 1)
 FrmPlaySongs.TxtNowPlaying.Text = midisong
 songwithpath = FrmPlaySongs.LstAlbum.List(FrmPlaySongs.LstPlayAlbum.ListIndex)
 ShowWords
 ShowPic
 dothis = "Open " + songwithpath + " type sequencer alias song"
 SendMCIcommand (dothis)
 dothis = "Play song notify"
 start = Timer
 SendMCIcommand (dothis)
 nowplaying = True
 FrmPlaySongs.Timer1.Interval = 1000
 FrmPlaySongs.Timer1.Enabled = True
 Do
 releasetime = DoEvents()
 If short = True And Timer > start + playsec Then
 dothis = "Close All"
 SendMCIcommand (dothis)
 paused = 0
 nowplaying = 0
 FrmPlaySongs.Timer1.Enabled = 0
 End If
 Loop Until nowplaying = 0
 FrmPlaySongs.TxtNowPlaying.Text = ""
 FrmPlaySongs.LblNowPlaying.Caption = ""
 FrmPlaySongs.CmdPlaySingleSong.Enabled = True
 FrmPlaySongs.CmdClear.Enabled = True
 FrmPlaySongs.CmdOpen.Enabled = True
 FrmPlaySongs.CmdOpenAlbum.Enabled = True
 FrmPlaySongs.CmdPlayAlb.Enabled = True
 FrmPlaySongs.MnuAlbum.Enabled = True
 FrmPlaySongs.MnuFile.Enabled = True
 FrmPlaySongs.MnuBrowse.Enabled = True
End Sub


**Proc for saving created file-list (album)**

Sub Savealbum (albumname)
Dim firststr As String
Dim secondstr As String
If albumname = "" Then
Exit Sub
End If
If InStr(albumname, ".") = 0 Then
albumname = albumname + ".alb"
End If
If InStr(albumname, "\") = 0 Then
albumname = Lastpath + "\" + albumname
End If
FrmPlaySongs.TxtAlbumName.Text = albumname
Open albumname For Output As 1
For item = 0 To FrmPlaySongs.LstPlayAlbum.ListCount - 1
firststr = FrmPlaySongs.LstPlayAlbum.List(item)
 secondstr = FrmPlaySongs.LstAlbum.List(item)
Print #1, firststr
Print #1, secondstr
Next
Close #1
End Sub

 
**Procedure, using API functions, to send commands to MCI**

Sub SendMCIcommand (cmd As String)
Dim result As String, ErrorMessage As String * 255
Dim status As Integer
result = String$(256, 0)'Create Buffer
status = mcisendstring(cmd, result, Len(result), FrmPlaySongs.hWnd)
 If status <> 0 Then
 R = mciGetErrorString(status, ErrorMessage, 255)
 MsgBox ErrorMessage
 End If
 End Sub

**Procedure for automatic loading of picture file to accompany current song**

Sub ShowPic ()
If Len(songwithpath) < 5 Then
Exit Sub
End If
FName = Left(songwithpath, Len(songwithpath) - 3)
If FileExists(FName + "bmp") Then
picfile = FName + "bmp"
FrmShowPic.Picture1.Picture = LoadPicture(picfile)
ElseIf FileExists(FName + "wmf") Then
picfile = FName + "wmf"
FrmShowPic.Picture1.Picture = LoadPicture(picfile)
Else
FrmShowPic.Picture1.Picture = LoadPicture(picfile)
End If
End Sub


**Proc for automatic loading of text-file with words to match current song** 

Sub ShowWords ()
Dim textline As String
Dim F As String
Dim nl As String
Dim wordsfile As String
nl = Chr$(13) + Chr$(10)
wordsfile = Left$(songwithpath, Len(songwithpath) - 3) + "txt"
    If FileExists(wordsfile) Then
    Open wordsfile For Input As #1
    Do While Not EOF(1)
    Line Input #1, textline
    F = F + textline + nl
    Loop
    Close #1
    FrmShowWords.Text1.Text = F
    Else
    FrmShowWords.Text1.Text = "FILE " + wordsfile + " NOT FOUND"
    End If
   End Sub


**Proc to stop playback of current song**

Sub StopSong ()
Dim dothis As String
FrmPlaySongs.TxtNowPlaying.Text = ""
FrmPlaySongs.LblNowPlaying.Caption = ""
dothis = "Close all"
SendMCIcommand (dothis)
nowplaying = 0
FrmPlaySongs.Timer1.Enabled = 0
End Sub

3 FORM PlaySongs
 

Button events-

**Proc to clear list of song names when button is clicked**

Sub CmdClear_Click ()
Do While (LstAlbum.ListCount > 0)
LstAlbum.RemoveItem 0
Loop
Do While (LstPlayAlbum.ListCount > 0)
LstPlayAlbum.RemoveItem 0
Loop
saveit = False
album = ""
TxtAlbumName.Text = ""
TxtNowPlaying.Text = ""
LblNowPlaying.Caption = "Song"
FrmShowWords.Text1.Text = ""
End Sub


**Proc to call the NextSong proc when button is clicked**

Sub CmdNext_Click ()
Dim msg As String
If FrmPlaySongs.LstPlayAlbum.ListIndex = -1 Then
msg = "No MIDI songs selected!"
MsgBox msg
Exit Sub
End If
NextSong
End Sub


**Proc to load a single file for playing when button is clicked** 

Sub CmdOpen_Click ()
On Error GoTo ErrHandlerOF
CmdClear_Click
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select MIDI File"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID"
CMDialog1.Action = 1
songwithpath = CMDialog1.Filename
CMDialog1.Filename = ""
midisong = Fnameextract(songwithpath)
 
LstPlayAlbum.AddItem midisong
LstAlbum.AddItem songwithpath
ShowWords
LstPlayAlbum.Selected(LstPlayAlbum.ListCount - 1) = True
LblNowPlaying.Caption = "Now Playing"
TxtNowPlaying.Text = midisong
ErrHandlerOF:
Exit Sub
End Sub


**Proc to load an album when button is clicked**

Sub CmdOpenAlbum_Click ()
Dim firststr As String
Dim secondstr As String
On Error GoTo ErrHandlerOA
CMDialog1.DefaultExt = "*.ALB"
CMDialog1.DialogTitle = "Select Files for MIDI Album"
CMDialog1.Filter = "MIDI Files (*.alb)|*.ALB"
CMDialog1.Action = 1
filewithpath = CMDialog1.Filename
Fname = Fnameextract(filewithpath)
album = Fname
albumwithpath = filewithpath
FrmPlaySongs.TxtAlbumName.Text = filewithpath
CMDialog1.Filename = ""
If album = "" Then
msg = "No Album Found"
MsgBox msg
Exit Sub
End If
If LstPlayAlbum.ListCount Then
For I = 0 To LstPlayAlbum.ListCount - 1
LstPlayAlbum.RemoveItem 0
LstAlbum.RemoveItem 0
Next
End If
Open albumwithpath For Input As 1
Do While Not EOF(1)
Line Input #1, firststr
LstPlayAlbum.AddItem firststr
Line Input #1, secondstr
LstAlbum.AddItem secondstr
Loop
Close #1
newalbum = True
Exit Sub

ErrHandlerOA:
Close #1
Exit Sub
End Sub


**Proc to call the PauseSong proc when button is clicked** 
Sub CmdPause_Click ()
PauseSong
End Sub


**Proc to play song-list (album) right through when button is clicked**

Sub CmdPlayAlb_Click ()
If LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
 End If
If LstPlayAlbum.ListIndex = -1 Then
msg = "Select Starting File"
MsgBox msg
Exit Sub
End If
FrmPlaySongs.CmdNext.Enabled = 0
PlaySong
If stopped = True Then
stopped = 0
FrmPlaySongs.CmdNext.Enabled = True
Exit Sub
End If
LstPlayAlbum.Selected(LstPlayAlbum.ListIndex) = True
For songitem = LstPlayAlbum.ListIndex To LstPlayAlbum.ListCount - 1
LstPlayAlbum.Selected(songitem) = True
NextSong
If stopped = True Then
stopped = 0
Exit For
End If
Next
FrmPlaySongs.CmdNext.Enabled = True
End Sub

**Proc to play a single song file when button is clicked. Calls PlaySong**

Sub CmdPlaySingleSong_Click ()
If FrmPlaySongs.LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
End If
If FrmPlaySongs.LstPlayAlbum.ListIndex = -1 Then
msg = "Select song to play!"
MsgBox msg
Exit Sub
End If
PlaySong
End Sub


**Proc to display currently selected picture to accompany song** 

Sub CmdShowPic_Click ()
FrmShowPic.Picture1.Picture = LoadPicture(picfile)
FrmShowPic.Show
End Sub



**Proc to display lyric when button is pressed**

Sub CmdShowWords_Click ()
FrmShowWords.Show 0
End Sub

**Proc to call StopSong procedure when button is pressed**

Sub CmdStop_Click ()
 stopped = True
StopSong
End Sub

Form Load Events-

*Proc to set variables on loading**

Sub Form_Load ()
Lastpath = CurDir
openalbum = 0
End Sub

**Proc to close MCI down and save album changes when form is unloaded **

Sub Form_Unload (Cancel As Integer)
dothis = "Close all"
SendMCIcommand (dothis)
If saveit = True Then
Savealbum (albumwithpath)
End If
End
End Sub

**Proc to prevent entry of text into list-box** 

Sub LstAlbum_KeyPress (keyascii As Integer)
 keyascii = 0
End Sub

**Proc to prevent entry of text into list-box** 

Sub LstPlayAlbum_KeyPress (keyascii As Integer)
keyascii = 0
End Sub

Menu Events

**Proc to load and add file to file-list (album)**

Sub MnuAddFile_Click ()
On Error GoTo ErrHandlerAF
If newalbum = 0 Then
msg = "No Album Opened"
MsgBox msg
Exit Sub
End If
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select Files for MIDI Album"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID"
CMDialog1.Action = 1
songwithpath = CMDialog1.Filename
midisong = Fnameextract(songwithpath)
FrmPlaySongs.LstPlayAlbum.AddItem midisong
FrmPlaySongs.LstAlbum.AddItem songwithpath
saveit = True
CMDialog1.Filename = ""
ErrHandlerAF:
Exit Sub
End Sub

**Proc to play album with shortened playback** 

Sub MnuBrowseList_Click ()
short = True
CmdPlayAlb_Click
End Sub


**Proc to set seconds for shortened playback**

Sub MnuBrowseMode_Click ()
Do
playsec = InputBox("Enter play time in seconds (10-60)")
Loop Until playsec > 9 And playsec < 61
short = True
End Sub


**Proc to delete selected file from disk when item is clicked**

Sub MnuDelFile_Click ()
On Error GoTo ErrHandlerDF
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select File to Delete"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID|All Files(*.*)|*.*"
CMDialog1.Action = 1
filewithpath = CMDialog1.Filename
msg = "Are you sure you want to delete " + filewithpath + " ?"
response = MsgBox(msg, 4, "Delete File from Disk")
    If response = 6 Then
    msg = "Deleting " + filewithpath + " from disk"
    Kill filewithpath
   Else
    msg = "You chose not to delete file"
    End If
    MsgBox msg
CMDialog1.Filename = ""
If album = "" Then
msg = "No Album Found"
MsgBox msg
Exit Sub
End If
If LstPlayAlbum.ListCount Then
For I = 0 To LstPlayAlbum.ListCount - 1
LstPlayAlbum.RemoveItem 0
LstAlbum.RemoveItem 0
Next
End If
Open albumwithpath For Input As 1
Do While Not EOF(1)
Line Input #1, firststr
LstPlayAlbum.AddItem firststr
Line Input #1, secondstr
LstAlbum.AddItem secondstr
Loop
Close #1
newalbum = True
Exit Sub
ErrHandlerDF:
Exit Sub
End Sub

**Proc to copy selected file on disk**

Sub MnuFileCopy_Click ()
On Error GoTo ErrHandlerFC
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select File to be Copied"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID|Album Files(*.alb)|*.alb"
CMDialog1.Action = 1
filewithpath = CMDialog1.Filename
Fname = Fnameextract(filewithpath)
targetpath = InputBox("Enter destination for file ")
If targetpath = "" Then
targetfile = filewithpath
End If
If Right$(targetpath, 1) <> "\" Then targetpath = targetpath + "\"
    If InStr(targetpath, Fname) Then
    targetfile = targetpath
    Else
    targetfile = targetpath + Fname
    End If
FileCopy filewithpath, targetfile
 msg = "File copied to " + targetfile
 MsgBox msg
CMDialog1.Filename = ""
ErrHandlerFC:
Exit Sub
End Sub


**Proc to rename selected file**

Sub MnuFileRename_Click ()
On Error GoTo ErrHandlerFR
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select File to Rename"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID|Album Files (*.alb)|*.alb"
CMDialog1.Action = 1
filewithpath = CMDialog1.Filename
Fname = Fnameextract(filewithpath)
sourcepath = Left$(filewithpath, InStr(filewithpath, Fname) - 1)
Do
targetfile = InputBox("Enter new name for file")
Loop Until Len(targetfile) > 0
        suffix = Right(Fname, 4)
        If InStr(targetfile, ".") = 0 Then
        targetfile = targetfile + suffix
        End If
targetpath = InputBox("Enter new path for file if required, or click OK")
        If targetpath = "" Then
        targetpath = sourcepath
        End If
        If Right$(targetpath, 1) <> "\" Then
        targetpath = targetpath + "\"
        End If
targetfile = targetpath + targetfile
Name filewithpath As targetfile
msg = " File renamed to " + targetfile
MsgBox msg
CMDialog1.Filename = ""
ErrHandlerFR:
Exit Sub
End Sub


**Proc to load and insert song into file-list(album)**

Sub MnuInsertSong_Click ()
On Error GoTo ErrHandlerIS
If newalbum = 0 Then
msg = "No Album Opened"
MsgBox msg
Exit Sub
End If
If LstPlayAlbum.ListIndex = -1 Then
msg = "Remember to select where to insert!"
MsgBox msg
Exit Sub
End If
CMDialog1.DefaultExt = "*.MID"
CMDialog1.DialogTitle = "Select MIDI Song to Insert"
CMDialog1.Filter = "MIDI Files (*.mid)|*.MID"
CMDialog1.Action = 1
songwithpath = CMDialog1.Filename
midisong = Fnameextract(songwithpath)
selecteditem = FrmPlaySongs.LstPlayAlbum.ListIndex
 FrmPlaySongs.LstPlayAlbum.AddItem midisong, selecteditem
 FrmPlaySongs.LstAlbum.AddItem songwithpath, selecteditem
 saveit = True
ErrHandlerIS:
Exit Sub
End Sub


**Proc to load CreateAlbum form, select files and save new album**

Sub MnuNewAlbum_Click ()
FrmCreateAlbum.Show 1
If LstPlayAlbum.ListCount Then
album = InputBox("Enter Name of Album", "Create New MIDI Album")
albumwithpath = Lastpath + "\" + album
newalbum = True
Savealbum (albumwithpath)
End If
End Sub


**Proc to click the button for the OpenAlbum proc 

Sub MnuOpenAlbum_Click ()
CmdOpenAlbum_Click
End Sub

**Proc to click the button for the proc to open a single file**

Sub MnuOpenFile_Click ()
CmdOpen_Click
End Sub

*Proc to click the button for the PlayAlbum proc**

Sub MnuPlayAlbum_Click ()
CmdPlayAlb_Click
End Sub

**Proc to play an album right through in random order. Uses PlaySong**

Sub MnuPlayRandomAlbum_Click ()
Dim dothis As String
Dim count As Integer
Randomize
If LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
 End If
 ReDim used(LstAlbum.ListCount) As Integer
 FrmPlaySongs.CmdNext.Enabled = 0
 Do
 If stopped = True Then Exit Do
 item = Int((LstAlbum.ListCount) * Rnd)
 If used(item) <> 99 Then
 LstPlayAlbum.Selected(item) = True
 PlaySong
 used(item) = 99
 count = count + 1
 End If
 Loop Until count = LstAlbum.ListCount
 stopped = 0
FrmPlaySongs.CmdNext.Enabled = True
End Sub


**Proc to close everything down, save album changes and quit program**

Sub MnuQuit_Click ()
dothis = "Close all"
SendMCIcommand (dothis)
If saveit = True Then
Savealbum (albumwithpath)
End If
End
End Sub

**Proc to remove song from song-list (album)**

Sub MnuRemoveSong_Click ()
Dim selecteditem As Integer
If newalbum = 0 Then
msg = "No Album Opened"
MsgBox msg
Exit Sub
End If
If LstPlayAlbum.ListIndex = -1 Then
msg = "Remember to select item to remove!"
MsgBox msg
Exit Sub
End If
selecteditem = FrmPlaySongs.LstPlayAlbum.ListIndex
 FrmPlaySongs.LstPlayAlbum.RemoveItem selecteditem
 FrmPlaySongs.LstAlbum.RemoveItem selecteditem
 saveit = True
End Sub

**Proc to load a lyric manually to accompany the current song** 

Sub MnuSelectLyric_Click ()
On Error GoTo ErrHandlerSL
Dim msg As String
Dim textline As String
Dim F As String
Dim nl As String
nl = Chr$(13) + Chr$(10)
CMDialog1.DefaultExt = "*.TXT"
CMDialog1.DialogTitle = "Select Lyric File"
CMDialog1.Filter = "Text Files (*.txt)|*.TXT"
CMDialog1.Action = 1
lyric = CMDialog1.Filename
Open lyric For Input As #1
    Do While Not EOF(1)
    Line Input #1, textline
    F = F + textline + nl
    Loop
    Close #1
FrmShowWords.Text1.Text = F
CMDialog1.Filename = ""
ErrHandlerSL:
Exit Sub
End Sub

**Proc to display the lyric selected with this menu**

Sub MnuShowLyric_Click ()
FrmShowWords.Show 0
End Sub

**Proc to select new picture manually to accompany current song**

Sub MnuSelectPic_Click ()
On Error GoTo ErrHandlerSP
CMDialog1.DefaultExt = "*.BMP"
CMDialog1.DialogTitle = "Select Picture File"
CMDialog1.Filter = "Bitmap Files (*.bmp)|*.BMP|Metafiles (*.wmf)|*.wmf"
CMDialog1.Action = 1
picfile = CMDialog1.Filename
CMDialog1.Filename = ""
ErrHandlerSP:
Exit Sub
End Sub

**Proc to display the picture selected with this menu

Sub MnuShowPic_Click ()
CmdShowPic_Click
End Sub



**Proc to call PlaySong to play a single song**

Sub MnuSinglePlay_Click ()
PlaySong
End Sub

**Proc to poll the status of the MIDI device to detect end of playback**
  Uses Timer control to scan the device at regular intervals

Sub Timer1_Timer ()
Dim dothis As String
Dim songstatus As String * 255
Dim lx As Long
dothis = "status song mode"
lx = mcisendstring(dothis, songstatus, 255, 0)
If Left(songstatus, 7) <> "playing" Then
dothis = "close song"
SendMCIcommand (dothis)
Timer1.Enabled = False
nowplaying = 0
End If
End Sub


**Proc to prevent user from entering text in text-box**

Sub TxtAlbumName_KeyPress (keyascii As Integer)
 keyascii = 0
End Sub

**Proc to prevent user from interfering with list-box display from keyboard

Sub TxtNowPlaying_KeyPress (keyascii As Integer)
keyascii = 0
End Sub



3. FORM CreateAlbum
   
**Proc to quit using  this form**

Sub CmdDone_Click ()
Unload FrmCreateAlbum
End Sub

**Proc to set current directory path when file is selected**

Sub Dir1_Change ()
File1.Path = Dir1.Path
LastPath = Dir1.Path
End Sub

**Proc to set current drive path when file is selected** 

Sub Drive1_Change ()
On Error GoTo Drive1Error
Dir1.Path = Drive1.Drive
Exit Sub
Drive1Error:
Beep
If Err = 68 Or Err = 71 Then
msg$ = "Error #" + Str$(Err) + "No Floppy in Drive!"
MsgBox msg$, 48
Else
msg$ = "Error #" + Str$(Err)
End If
Resume
End Sub

**Proc to select file and store it with and without full path details**

Sub File1_Click ()
midisong = File1.FileName
songwithpath = Dir1.Path + "\" + File1.FileName
TxtFileName.Text = songwithpath
End Sub

*Proc to limit operation to MIDI files when Form is loaded**

Sub Form_Load ()
File1.Pattern = "*.mid"
Dir1.Path = LastPath
End Sub

**Proc to centre form automatically when resized**

Sub Form_Resize ()
Move (Screen.Width - FrmCreateAlbum.Width) / 2, (Screen.Height - FrmCreateAlbum.Height) / 2
End Sub


**Proc to clear old file-list display in the PlaySongs Form and enter
  new files selected when the CreateAlbum Form is unloaded**

Sub Form_Unload (Cancel As Integer)
        If FrmPlaySongs.LstPlayAlbum.ListCount Then
        For i = 0 To FrmPlaySongs.LstPlayAlbum.ListCount - 1
        FrmPlaySongs.LstPlayAlbum.RemoveItem 0
        FrmPlaySongs.LstAlbum.RemoveItem 0
        Next
        End If
For i = 0 To FrmCreateAlbum.File1.ListCount - 1
    If FrmCreateAlbum.File1.Selected(i) Then
    midisong = FrmCreateAlbum.File1.List(i)
    songwithpath = FrmCreateAlbum.Dir1.Path + "\" + FrmCreateAlbum.File1.List(i)
    FrmPlaySongs.LstPlayAlbum.AddItem midisong
    FrmPlaySongs.LstAlbum.AddItem songwithpath
    End If
Next
saveit = True
LastPath = Dir1.Path
End Sub

**Proc to prevent user from entering text in text-box**

Sub TxtFileName_KeyPress (KeyAscii As Integer)
KeyAscii = 0
End Sub



4. FORM ShowWords

**Proc to clear text from the text display area**

Sub CmdClear_Click ()
Text1.Text = ""
End Sub

**Proc to quit this Form and remove it from the screen**

Sub CmdExit_Click ()
Unload FrmShowWords
End Sub


**Proc to call the PauseSong proc**

Sub CmdPause_Click ()
PauseSong
End Sub

Menu events-

**Proc to select and change the font used in the lyric display**

Sub MnuChangeFont_Click ()
On Error GoTo ErrHandlerCF
CMDialog1.DialogTitle = "Select Font Changes"
 CMDialog1.Flags = &H1& Or &H100&
CMDialog1.Action = 4
Text1.FontName = CMDialog1.FontName
Text1.FontSize = CMDialog1.FontSize
Text1.FontBold = CMDialog1.FontBold
Text1.FontItalic = CMDialog1.FontItalic
Text1.FontUnderline = CMDialog1.FontUnderline
ErrHandlerCF:
Exit Sub
End Sub

**Proc to load and display a lyric or indeed any text file**

Sub MnuSelectText_Click ()
Dim textline As String
Dim F As String
Dim nl As String
nl = Chr$(13) + Chr$(10)
On Error GoTo ErrHandlerSF
CMDialog1.DefaultExt = "*.TXT"
CMDialog1.DialogTitle = "Select Text File"
CMDialog1.Filter = "Text Files (*.txt)|*.TXT"
CMDialog1.Action = 1
lyric = CMDialog1.Filename
Open lyric For Input As #1
    Do While Not EOF(1)
    Line Input #1, textline
    F = F + textline + nl
    Loop
    Close #1
    FrmShowWords.Text1.Text = F
CMDialog1.Filename = ""
ErrHandlerSF:
Close #1
Exit Sub
End Sub


**Proc to prevent user from entering text in text-box**

Sub Text1_KeyPress (Keyascii As Integer)
Keyascii = 0
End Sub


5. FORMAbout - Displays Title and version details 

This form contains the program icon loaded from the file ABOUT.FRX
  

**Proc to unload this form

Sub Command1_Click ()
Unload FrmAbout
End Sub


**Proc to centre form automatically when resized**

Sub Form_Resize ()
Move (Screen.Width - FrmAbout.Width) / 2, (Screen.Height - FrmAbout.Height) / 2
End Sub



6. FORM ShowPic
  
Button Procedures

**Proc to clear the picture window**

Sub CmdClear_Click ()
Picture1.Picture = LoadPicture("")
End Sub

**Proc to quit the picture display**

Sub CmdQuit_Click ()
Unload FrmShowPic
End Sub

**Proc to display currently selected picture**

Sub CmdShowPic_Click ()
Picture1.Picture = LoadPicture(picfile)
End Sub


Menu Procedures-

**Proc to quit picture display**

Sub MnuExit_Click ()
Unload FrmShowPic
End Sub


**Proc to select new picture**

Sub MnuSelectPic_Click ()
On Error GoTo ErrHandlerSP2
CMDialog1.DefaultExt = "*.BMP"
CMDialog1.DialogTitle = "Select Text File"
CMDialog1.Filter = "Bitmap Files (*.bmp)|*.BMP|Metafiles (*.wmf)| *.WMF"
CMDialog1.Action = 1
picfile = CMDialog1.Filename
CMDialog1.Filename = ""
ErrHandlerSP2:
Exit Sub
End Sub


