www.pudn.com > mima.zip > frmVisLoader.frm
VERSION 5.00
Begin VB.Form frmVisLoader
BackColor = &H00000000&
BorderStyle = 0 'None
Caption = "Form1"
ClientHeight = 3945
ClientLeft = 0
ClientTop = 0
ClientWidth = 9705
LinkTopic = "Form1"
ScaleHeight = 263
ScaleMode = 3 'Pixel
ScaleWidth = 647
ShowInTaskbar = 0 'False
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdPrnt
Caption = "Prnt"
Height = 375
Left = 5325
TabIndex = 14
Top = 3450
Width = 510
End
Begin VB.CommandButton cmdBg
Caption = "Bg"
Height = 375
Left = 4890
TabIndex = 13
Top = 3450
Width = 420
End
Begin VB.CheckBox chkSetDef
BackColor = &H00000000&
Caption = "Set as Default"
ForeColor = &H00FFFFFF&
Height = 195
Left = 3510
TabIndex = 12
Top = 3540
Width = 1350
End
Begin VB.CommandButton cSelDir
Caption = "&Select Dir"
Height = 360
Left = 2535
TabIndex = 10
Top = 3450
Width = 945
End
Begin VB.CommandButton cNext
Caption = "Pg &Dn"
Height = 360
Left = 1695
TabIndex = 6
Top = 3450
Width = 720
End
Begin VB.CommandButton cCancel
Cancel = -1 'True
Caption = "&Cancel"
Height = 360
Left = 75
TabIndex = 5
Top = 3465
Width = 810
End
Begin VB.ListBox FileList
BackColor = &H00000000&
ForeColor = &H0000C000&
Height = 645
Left = 4035
TabIndex = 4
Top = 510
Visible = 0 'False
Width = 1485
End
Begin VB.ListBox Dummy
BackColor = &H00000000&
ForeColor = &H0000C000&
Height = 645
Left = 4035
TabIndex = 3
Top = 1215
Visible = 0 'False
Width = 1485
End
Begin VB.CommandButton cPrev
Caption = "Pg &Up"
Height = 360
Left = 960
TabIndex = 2
Top = 3450
Width = 720
End
Begin VB.ListBox PlayList
Appearance = 0 'Flat
BackColor = &H00000000&
ForeColor = &H0000C000&
Height = 1590
ItemData = "frmVisLoader.frx":0000
Left = 6015
List = "frmVisLoader.frx":0007
TabIndex = 1
Top = 675
Width = 3540
End
Begin VB.CommandButton cLoad
Caption = "&Load"
Height = 360
Left = 6000
TabIndex = 0
Top = 3465
Width = 3525
End
Begin VB.Label lPgStat
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "Page:"
ForeColor = &H0000FFFF&
Height = 195
Left = 945
TabIndex = 11
Top = 3195
Width = 420
End
Begin VB.Image iPic
Height = 1350
Index = 0
Left = 135
Stretch = -1 'True
Top = 465
Width = 1350
End
Begin VB.Label PName
BackStyle = 0 'Transparent
Caption = "<-"
ForeColor = &H00FFFFFF&
Height = 285
Left = 6060
TabIndex = 9
Top = 375
Width = 3540
End
Begin VB.Label lPlHeader
BackColor = &H0000C000&
Caption = "Selected Playlist:"
Height = 240
Left = 6045
TabIndex = 8
Top = 75
Width = 3540
End
Begin VB.Label lblVPS
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "VB-Amp Visual Playlist Selector"
BeginProperty Font
Name = "MS Sans Serif"
Size = 18
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H8000000E&
Height = 435
Left = 75
TabIndex = 7
Top = 15
Width = 5055
End
End
Attribute VB_Name = "frmVisLoader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' Visual Playlist Selector (VPS)
' ========================
' Displays up to 16 thumbnails corresponding to playlist files
' If a playlist does not have a bitmap the "nocover.bmp" file
' will be shown. If a ".DIR" file is found only those directories
' will appear (used to categorize playlists by artist or genre).
Public Page As Integer, SelName As String, DefPic As String
Public MaxPage As Integer, LastPic As Integer
Public Busy As Boolean
Const MaxPic = 16 'maximum number of bitmaps to view
'Initialize elements etc
Private Sub Form_Load()
Busy = True
LastPic = 0
Me.WindowState = 2 'Make window fill screen
Me.Show: DoEvents 'display the window now
W = Me.ScaleWidth: H = Me.ScaleHeight
HH = H - 35: Sz = (HH - 60) \ 4
PP = Sz * 4 + 20: PW = W - PP
'Move the buttons to the bottom of the screen
cLoad.Move PP, HH, PW
cCancel.Top = HH
cPrev.Top = HH: cNext.Top = HH
cSelDir.Top = HH: cmdPrnt.Top = HH: cmdBg.Top = HH
chkSetDef.Top = HH + 4
lPgStat.Top = HH - 16
'Move Playlist to far right
lPlHeader.Left = PP: lPlHeader.Width = PW
PName.Left = PP: PName.Width = PW
PlayList.Move PP, 45, PW, HH - 60
'Create image objects to hold bitmap covers
iPic(0).Move 0, 0, Sz - 10, Sz - 10
For J = 1 To MaxPic - 1: Load iPic(J): Next
'Arrange images in 4 by 4 matrix
For J = 0 To 3
For K = 0 To 3
iPic(J * 4 + K).Move K * Sz + 5, J * Sz + 35
Next K
Next J
'Check for default playlist bitmap
F$ = App.Path + "\nocover.bmp"
If Exists(F$) = True Then DefPic = F$
Path$ = OptVisPLPath 'initial directory from preferences
If Path$ = "" Then Path$ = App.Path
'Load and display initial playlists
Call GetVPSDir(Path$)
End Sub
'Exit and unload
Private Sub cCancel_Click()
If Busy = False Then
Call AlwaysOnTop(frmVBAmp, OptAlwaysOnTop)
Unload Me
End If
End Sub
' Select new directory and load playlists
Private Sub cSelDir_Click()
A$ = GetBrowseDir(Me, "Select directory containing media files:")
If A$ <> "" Then Call GetVPSDir(A$)
End Sub
'Get the directory and display it
Private Sub GetVPSDir(A$)
Busy = True
Path$ = ValidateDir(A$)
Call ClearVPS
DD$ = Dir$(Path$ + "*.DIR")
If DD$ <> "" Then
'Directory contains ".DIR" file so only add it/them
Do
FileList.AddItem Path$ + DD$ 'add one
DD$ = Dir$ 'get the next
Loop While DD$ <> ""
Else
'Add all playlists in this folder and all subfolders
Call AddDir(Path$, Me, Dummy, FileList, "M3U PLS")
End If
Page = 0: Call ShowPage
If chkSetDef.Value = 1 Then OptVisPLPath = Path$
Busy = False
End Sub
'Go to next page
Private Sub cNext_Click()
If Page < MaxPage Then Page = Page + 1: Call ShowPage
End Sub
'Go to previous page
Private Sub cPrev_Click()
If Page > 0 Then Page = Page - 1: Call ShowPage
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If Busy = True Then Cancel = True
End Sub
'Load selected playlist and exit
Private Sub iPic_DblClick(Index As Integer)
Call LoadPlayList(Index)
Call LoadIt
End Sub
'Load the playlist then exit
Private Sub cLoad_Click()
Call LoadIt
End Sub
'Load selected playlist for viewing
Private Sub iPic_Click(Index As Integer)
Call LoadPlayList(Index)
End Sub
'Highlight the bitmap by turning on border, un-highlight previous image
Private Sub iPic_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Index <> LastPic Then
iPic(LastPic).BorderStyle = 0
iPic(Index).BorderStyle = 1
LastPic = Index
End If
End Sub
'Un-Highlight previous image
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
If LastPic <> 0 Then
iPic(LastPic).BorderStyle = 0
LastPic = 0
End If
End Sub
'Clear all lists and set help message
Private Sub ClearVPS()
FileList.Clear: Dummy.Clear
PlayList.Clear
PName.Caption = "<- Select playlist from left"
End Sub
'Load the specified playlist for Viewing only
Private Sub LoadPlayList(ByVal Index As Integer)
n = Page * MaxPic + Index
If n > FileList.ListCount - 1 Then Exit Sub
Filename = FileList.List(n)
PlayList.Clear
PName.Caption = MakeTitle(GetFileName(Filename))
SelName = Filename
If UCase$(Right$(SelName, 4)) = ".DIR" Then PlayList.AddItem "This is a directory. Double-click to enter!": Exit Sub
FIO% = FreeFile
Open Filename For Input As FIO%
Do While Not EOF(FIO%)
Line Input #FIO%, A$
PlayList.AddItem GetFileName(A$)
Loop
Close FIO%
End Sub
'Load selected playlist into main form, play it, and exit screen
Private Sub LoadIt()
If UCase$(Right$(SelName, 4)) = ".DIR" Then
A$ = Left$(SelName, Len(SelName) - 4)
If A$ <> "" Then Call GetVPSDir(A$)
Else
Call frmVBAmp.PlClear
Call frmVBAmp.PlRead(SelName)
Call frmVBAmp.PlayIt
Unload Me
End If
End Sub
'Display one page of playlist bitmaps
Private Sub ShowPage()
Me.MousePointer = 11
PlayList.Clear
PName.Caption = "One moment, loading..."
DoEvents
n = Page * MaxPic
Max = FileList.ListCount - 1
MaxPage = Max \ MaxPic
lPgStat.Caption = "Page " & Str$(Page + 1) & " of " & Str$(MaxPage + 1) & ". Total Playlists:" & Str$(Max + 1)
For J = 0 To MaxPic - 1
If CancelFlag = True Then Exit For
Num = n + J
If Num <= Max Then
F$ = GetBaseName(FileList.List(Num))
GoSub FindPic
Else
iPic(J).Visible = False
End If
DoEvents
Next J
Me.MousePointer = 0
PName.Caption = "Select playlist..."
Busy = False
Exit Sub
FindPic:
C$ = ""
FF$ = F$ + ".BMP": GoSub TestIt
FF$ = F$ + ".GIF": GoSub TestIt
FF$ = F$ + ".JPG": GoSub TestIt
If C$ <> "" Then
iPic(J).Picture = LoadPicture(C$)
Else
If DefPic = "" Then
iPic(J).Picture = Nothing
Else
iPic(J).Picture = LoadPicture(DefPic)
End If
End If
iPic(J).ToolTipText = MakeTitle(F$)
iPic(J).Visible = True
Return
TestIt:
If Exists(FF$) = True Then C$ = FF$
Return
End Sub
Private Sub cmdBg_Click()
c1 = &HFFFFFF: c2 = 0
If Me.BackColor = 0 Then c2 = &HFFFFFF: c1 = 0
chkSetDef.BackColor = c2
chkSetDef.ForeColor = c1
PlayList.BackColor = c2
PlayList.ForeColor = c1
lblVPS.ForeColor = c1
PName.ForeColor = c1
Me.BackColor = c2
End Sub
Private Sub cmdPrnt_Click()
Me.PrintForm
End Sub