JACMIDI

BASIC MODULE


Global saveit As Integer
Global insertit As Integer
Global removeit As Integer
Global addsong As Integer
Global midisong As String
Global songwithpath As String
Global openalbum As Integer
Global album As String
Global albumwithpath As String
Global nowplaying As Integer
Global killit As Integer
Global newalbum As Integer
Global delfile As String
Global paused As Integer
Global copyit As Integer
Global renameit As Integer
Global stopped As Integer
Global lastpath As String
Global lyric As String
Global tempfilename As String
Dim used() As Integer

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

Sub main ()
FrmPlaySongs.Show 1
lastpath = CurDir
End Sub

Sub ShowWords ()
Dim textline As String
Dim F As String
Dim NL As String
Dim wordsfile As String
NL = Chr$(13) + Chr$(10)

If Len(songwithpath) > 3 Then
wordsfile = Left$(songwithpath, Len(songwithpath) - 3) + "txt"
End If
End If
    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 If
If FileExists(tempfilename) Then
KILL tempfilename
End If

End Sub

FORM ABOUT

Sub Command1_Click ()
Unload FrmAbout
main
End Sub

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


FORM PLAY SONG



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

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

Sub CmdPause_Click ()
If paused = 0 Then
dothis = "pause song"
SendMciCommand (dothis)
LblNowPlaying.Caption = "Paused"
paused = -1
Else
dothis = "play song notify"
SendMciCommand (dothis)
LblNowPlaying.Caption = "Now Playing"
paused = 0
End If
End Sub

Sub CmdPlaySong_Click ()
Dim dothis As String
If LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
End If
If LstPlayAlbum.ListIndex = -1 Then
msg = "Select song to play!"
MsgBox msg
Exit Sub
End If

 If paused = -1 Then
 dothis = "play song"
 SendMciCommand (dothis)
 TxtNowPlaying.Text = midisong
 LblNowPlaying.Caption = "Now Playing"
 paused = 0
 Exit Sub
 End If
 CmdPlaySong.Enabled = 0
 CmdClear.Enabled = 0
 midisong = LstPlayAlbum.List(LstPlayAlbum.ListIndex)
 LblNowPlaying.Caption = "Now Playing"
 TxtNowPlaying.Text = midisong
 songwithpath = LstAlbum.List(LstPlayAlbum.ListIndex)
  ShowWords
 dothis = "Open " + songwithpath + " type sequencer alias song"
 SendMciCommand (dothis)
 dothis = "Play song notify"
 SendMciCommand (dothis)
 nowplaying = -1
 Do While nowplaying = -1
 releasetime = DoEvents()
 Loop
 nowplaying = 0
 dothis = "Close all"
 SendMciCommand (dothis)
 TxtNowPlaying.Text = ""
 LblNowPlaying.Caption = ""
 CmdPlaySong.Enabled = -1
 CmdClear.Enabled = -1

End Sub

Sub CmdShowWords_Click ()
ShowWords
FrmShowWords.Show 1
End Sub

Sub CmdStop_Click ()
Dim dothis As String
stopped = -1
TxtNowPlaying.Text = ""
LblNowPlaying.Caption = ""
dothis = "Close all"
SendMciCommand (dothis)
nowplaying = 0
End Sub

Sub Form_Load ()

MsgHook1.Message(&H3B9) = -1
MsgHook1.HwndHook = FrmPlaySongs.hWnd
LastPath = CurDir
End Sub

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

Sub MnuAddFile_Click ()
addsong = -1
FrmGetFiles.Caption = "Select Files for MIDI Album"
FrmGetFiles.Show 1
saveit = -1
End Sub

Sub MnuDeleteSong_Click ()
 Dim selecteditem As Integer
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 = -1
End Sub

Sub MnuDelFile_Click ()
killit = -1
FrmGetFiles.Show 1
End Sub

Sub MnuFileCopy_Click ()

copyit = -1
FrmGetFiles.Caption = "Select MIDI File to Copy"
FrmGetFiles.Show 1
End Sub

Sub MnuFileRename_Click ()
 
renameit = -1
FrmGetFiles.Caption = "Select MIDI File to rename"
FrmGetFiles.Show 1

End Sub

Sub MnuInsertSong_Click ()
If LstPlayAlbum.ListIndex = -1 Then
msg = "Remember to select where to insert!"
MsgBox msg
Exit Sub
End If
insertit = -1
FrmGetFiles.Caption = "Select Song to Insert in Album"
FrmGetFiles.Show 1

End Sub

Sub MnuNewAlbum_Click ()
newalbum = -1
FrmGetFiles.Caption = "Create MIDI Album"
FrmGetFiles.Show 1
If LstPlayAlbum.ListCount Then
album = InputBox("Enter Name of Album", "Create New MIDI Album")
savealbum (album)
End If
End Sub

Sub MnuOpenAlbum_Click ()
Dim firststr As String
Dim secondstr As String
On Error GoTo ErrHandler

openalbum = -1
FrmGetFiles.Caption = "Open MIDI Album"
FrmGetFiles.Show 1
openalbum = 0
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
Exit Sub

ErrHandler:
msg = Error(Err)
MsgBox msg
Resume Abandon
Abandon:
End Sub

Sub MnuOpenFile_Click ()
FrmGetFiles.Caption = "Open MIDI File"
FrmGetFiles.Show 1
If FrmGetFiles.File1.ListIndex = -1 Then Exit Sub
LstPlayAlbum.AddItem midisong
LstAlbum.AddItem songwithpath
ShowWords
LstPlayAlbum.Selected(LstPlayAlbum.ListCount - 1) = -1
LblNowPlaying.Caption = "Now Playing"
TxtNowPlaying.Text = midisong
End Sub

Sub MnuPlayAlbum_Click ()
Dim dothis As String
Dim item As Integer
If LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
 End If
 CmdClear.Enabled = 0
 CmdPlaySong.Enabled = 0
 For item = 0 To LstAlbum.ListCount - 1
 If stopped = -1 Then
 Exit For
 End If
 midisong = LstPlayAlbum.List(item)
 TxtNowPlaying.Text = midisong
 LblNowPlaying.Caption = "Now Playing"
 songwithpath = LstAlbum.List(item)
 ShowWords
 dothis = "Open " + songwithpath + " type sequencer alias song"
 SendMciCommand (dothis)
 dothis = "Play song notify"
 SendMciCommand (dothis)
 nowplaying = -1
 Do While nowplaying = -1
 releasetime = DoEvents()
 Loop
 nowplaying = 0
 dothis = "Close all"
 SendMciCommand (dothis)
 TxtNowPlaying.Text = ""
 LblNowPlaying.Caption = ""
 Next
 stopped = 0
 CmdClear.Enabled = -1
 CmdPlaySong.Enabled = -1

End Sub

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
 CmdClear.Enabled = 0
 CmdPlaySong.Enabled = 0
 
 Do
 If stopped = -1 Then Exit Do
 item = Int((LstAlbum.ListCount) * Rnd)
 If used(item) <> 99 Then
 midisong = LstPlayAlbum.List(item)
 TxtNowPlaying.Text = midisong
 LblNowPlaying.Caption = "Now Playing " + Str$(item + 1)
 songwithpath = LstAlbum.List(item)
 ShowWords
 dothis = "Open " + songwithpath + " type sequencer alias song"
 SendMciCommand (dothis)
 dothis = "Play song notify"
 SendMciCommand (dothis)
 nowplaying = -1
 Do While nowplaying = -1
 releasetime = DoEvents()
 Loop
 nowplaying = 0
 dothis = "Close all"
 SendMciCommand (dothis)
 used(item) = 99
 count = count + 1
 End If
 Loop Until count = LstAlbum.ListCount
 TxtNowPlaying.Text = ""
 LblNowPlaying.Caption = ""
 stopped = 0
 CmdClear.Enabled = -1
 CmdPlaySong.Enabled = -1

End Sub

Sub MnuQuit_Click ()
dothis = "Close all"
SendMciCommand (dothis)
If saveit = -1 Then
savealbum (albumwithpath)
End If
End
End Sub

Sub MnuSaveAlbumAs_Click ()
If LstPlayAlbum.ListCount = 0 Then Exit Sub
album = InputBox("Enter Name of Album", "Save MIDI Album As...")
savealbum (album)
End Sub

Sub MnuSelectLyric_Click ()
FrmLyrics.Show 1
If Len(songwithpath) > 3 Then
tempfilename = Left$(songwithpath, Len(songwithpath) - 3) + "txt"
End If
If Len(lyric) > 3 Then
FileCopy lyric, tempfilename
End If
End Sub

Sub MnuShowLyric_Click ()
CmdShowWords_Click
End Sub

Sub MnuSinglePlay_Click ()
Dim dothis As String
If LstPlayAlbum.ListCount = 0 Then
msg = "No Songs to Play!"
MsgBox msg
Exit Sub
 End If
If LstPlayAlbum.ListIndex = -1 Then
msg = "Select song to play!"
MsgBox msg
Exit Sub
End If
 
 If paused = -1 Then
 dothis = "play song"
 SendMciCommand (dothis)
 TxtNowPlaying.Text = midisong
 LblNowPlaying.Caption = "Now Playing"
 paused = 0
 Exit Sub
 End If
 
 CmdPlaySong.Enabled = 0
 CmdClear.Enabled = 0
 midisong = LstPlayAlbum.List(LstPlayAlbum.ListIndex)
 TxtNowPlaying.Text = midisong
 LblNowPlaying.Caption = "Now Playing"
 songwithpath = LstAlbum.List(LstPlayAlbum.ListIndex)
 ShowWords
 dothis = "Open " + songwithpath + " type sequencer alias song"
 SendMciCommand (dothis)
 dothis = "Play song notify"
 nowplaying = -1
 SendMciCommand (dothis)
 Do While nowplaying = -1
 releasetime = DoEvents()
 Loop
 nowplaying = 0
 dothis = "Close all"
 SendMciCommand (dothis)
 TxtNowPlaying.Text = ""
 LblNowPlaying.Caption = ""
 CmdPlaySong.Enabled = -1
 CmdClear.Enabled = -1

End Sub

Sub MsgHook1_Message (msg As Integer, wParam As Integer, lParam As Long, action As Integer, result As Long)
If wParam = 1 Then
nowplaying = 0
End If
End Sub

Sub savealbum (albumname)
Dim firststr As String
Dim secondstr As String
If albumname = "" Then
Exit Sub
End If
If Len(albumname) < 4 Then
albumname = albumname + ".alb"
End If
If Right$(albumname, 4) <> ".alb" Then
albumname = albumname + ".alb"
End If
If InStr(albumname, "\") = 0 Then
albumname = LastPath + "\" + albumname
End If
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

 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

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

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

FORM GETFILES


Sub CmdDone_Click ()
Unload FrmGetFiles
killit = 0
insertit = 0
copyit = 0
newalbum = 0
openalbum = 0
removeit = 0
renameit = 0
End Sub

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

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

Sub File1_Click ()
On Error GoTo Handler
Dim targetwithpath As String
Dim targetfile As String
Dim sourcefilepath As String
Dim targetfilepath As String
Dim selecteditem As Integer
Dim response As Integer
Dim selectedfile As String
Dim filewithpath As String



selectedfile = File1.FileName
filewithpath = Dir1.Path + "\" + File1.FileName


If openalbum = 0 Then
midisong = selectedfile
songwithpath = filewithpath
TxtFileName.Text = songwithpath
End If

If addsong = -1 Then
FrmPlaySongs.LstPlayAlbum.AddItem midisong
FrmPlaySongs.LstAlbum.AddItem songwithpath
End If

If openalbum = -1 Then
album = selectedfile
albumwithpath = filewithpath
FrmPlaySongs.TxtAlbumName.Text = filewithpath
TxtFileName.Text = filewithpath
Exit Sub
End If

If renameit = -1 Then
sourcefilepath = Left$(filewithpath, InStr(filewithpath, selectedfile) - 1)
targetfile = InputBox("Enter new name for file")
        suffix = Right$(selectedfile, 4)
        If Len(targetfile) < 4 Then
        targetfile = targetfile + suffix
        End If
        If Right$(targetfile, 4) <> suffix Then
        targetfile = targetfile + suffix
        End If
targetfilepath = InputBox("Enter new path for file if required, or press RETURN")
        If targetfilepath = "" Then
        targetfilepath = sourcefilepath
        End If
        If Right$(targetfilepath, 1) <> "\" Then
        targetfilepath = targetfilepath + "\"
        End If
targetwithpath = targetfilepath + targetfile
Name filewithpath As targetwithpath
msg = " File renamed to " + targetwithpath
MsgBox msg
File1.Refresh
Exit Sub
End If


If copyit = -1 Then
sourcefilepath = Left$(filewithpath, InStr(filewithpath, selectedfile) - 1)
targetfilepath = InputBox("Enter destination for file ")
If targetfilepath = "" Then
targetfilepath = sourcefilepath
End If
If Right$(targetfilepath, 1) <> "\" Then targetfilepath = targetfilepath + "\"
    If InStr(targetfilepath, midisong) Then
    targetwithpath = targetfilepath
    Else
    targetwithpath = targetfilepath + selectedfile
    End If
FileCopy filewithpath, targetwithpath
 msg = "File copied to " + targetwithpath
 MsgBox msg
File1.Refresh
Exit Sub
End If




If insertit = -1 Then
 selecteditem = FrmPlaySongs.LstPlayAlbum.ListIndex
 FrmPlaySongs.LstPlayAlbum.AddItem midisong, selecteditem
 FrmPlaySongs.LstAlbum.AddItem songwithpath, selecteditem
 saveit = -1
End If
 
If killit = -1 Then
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
    File1.Refresh
    Else
    msg = "You chose not to delete file"
    End If
    MsgBox msg
End If
 
 Exit Sub


Handler:
 msg = Error(Err)
 MsgBox msg
Resume Next
End Sub

Sub Form_Load ()
If killit = -1 Or copyit = -1 Or renameit = -1 Then
File1.Pattern = "*.alb;*.mid"
Exit Sub
End If
If openalbum = -1 Then
File1.Pattern = "*.alb"
Exit Sub
End If
File1.Pattern = "*.mid"
Dir1.Path = LastPath
End Sub

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

Sub Form_Unload (Cancel As Integer)

Dim response As Integer
If newalbum = -1 Then
        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 FrmGetFiles.File1.ListCount - 1
    If FrmGetFiles.File1.Selected(i) Then
    midisong = FrmGetFiles.File1.List(i)
    songwithpath = FrmGetFiles.Dir1.Path + "\" + FrmGetFiles.File1.List(i)
    FrmPlaySongs.LstPlayAlbum.AddItem midisong
    FrmPlaySongs.LstAlbum.AddItem songwithpath
    End If
Next
saveit = -1
newalbum = 0
addsong = 0
LastPath = Dir1.Path
End If
 End Sub

FORM SHOW WORDS

Sub CmdExit_Click ()
Unload FrmShowWords
End Sub

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

FORM LYRICS


Sub Command1_Click ()
Unload FrmLyrics
End Sub

Sub Dir1_Change ()
File1.Path = dir1.Path
End Sub

Sub Drive1_Change ()
dir1.Path = Drive1.Drive
End Sub

Sub File1_Click ()
lyric = dir1.Path + "\" + File1.FileName
Unload FrmLyrics
End Sub

Sub Form_Load ()
File1.Pattern = "*.txt"
tempfilename = "temp.txt"
End Sub

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


