📄 frminfo.frm
字号:
VERSION 5.00
Begin VB.Form frmInfo
BorderStyle = 1 'Fixed Single
Caption = "Track Info"
ClientHeight = 2895
ClientLeft = 45
ClientTop = 330
ClientWidth = 6525
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 193
ScaleMode = 3 'Pixel
ScaleWidth = 435
StartUpPosition = 3 '窗口缺省
Begin VB.Timer Timer1
Interval = 2000
Left = 15
Top = 15
End
Begin VB.CheckBox cbEdit
Caption = "Edit"
Height = 195
Left = 1350
TabIndex = 19
Top = 2235
Width = 600
End
Begin VB.TextBox txtFileName
Height = 285
Left = 750
Locked = -1 'True
TabIndex = 17
Text = "Filename"
Top = 30
Width = 5670
End
Begin VB.ComboBox cboGenre
Height = 315
ItemData = "frmInfo.frx":0000
Left = 2670
List = "frmInfo.frx":00F7
Style = 2 'Dropdown List
TabIndex = 16
Top = 1425
Width = 1575
End
Begin VB.CommandButton cmdCurrent
Caption = "Current"
Height = 360
Left = 1980
TabIndex = 15
Top = 2160
Width = 1080
End
Begin VB.CommandButton cmdSave
Caption = "Save"
Enabled = 0 'False
Height = 360
Left = 3135
TabIndex = 14
Top = 2160
Width = 1080
End
Begin VB.CommandButton cmdOk
Caption = "OK"
Height = 360
Left = 90
TabIndex = 13
Top = 2160
Width = 1080
End
Begin VB.TextBox txtYear
Height = 285
Left = 1590
MaxLength = 4
TabIndex = 11
Text = "1999"
Top = 1425
Width = 480
End
Begin VB.TextBox txtTrack
Height = 285
Left = 765
MaxLength = 2
TabIndex = 10
Text = "99"
Top = 1425
Width = 285
End
Begin VB.TextBox txtComment
Height = 285
Left = 750
MaxLength = 29
TabIndex = 12
Top = 1785
Width = 3480
End
Begin VB.TextBox txtAlbum
Height = 285
Left = 750
MaxLength = 30
TabIndex = 9
Top = 1080
Width = 3480
End
Begin VB.TextBox txtArtist
Height = 285
Left = 750
MaxLength = 30
TabIndex = 8
Top = 750
Width = 3480
End
Begin VB.TextBox txtTitle
Height = 285
Left = 750
MaxLength = 30
TabIndex = 7
Top = 420
Width = 3480
End
Begin VB.Label Label9
Alignment = 2 'Center
BackColor = &H80000002&
Caption = "Click ""Edit"" to avoid tag updates. Click ""Current"" to load tag from current song."
ForeColor = &H8000000E&
Height = 270
Left = 90
TabIndex = 20
Top = 2580
Width = 6345
End
Begin VB.Image imgCover
BorderStyle = 1 'Fixed Single
Height = 2100
Left = 4335
Stretch = -1 'True
ToolTipText = "Album Cover"
Top = 420
Width = 2100
End
Begin VB.Label Label8
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "File"
Height = 195
Left = 450
TabIndex = 18
Top = 75
Width = 240
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Track"
Height = 195
Left = 285
TabIndex = 6
Top = 1470
Width = 420
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Comment"
Height = 195
Left = 45
TabIndex = 5
Top = 1815
Width = 660
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Genre"
Height = 195
Left = 2175
TabIndex = 4
Top = 1470
Width = 435
End
Begin VB.Label Label4
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Year"
Height = 195
Left = 1215
TabIndex = 3
Top = 1470
Width = 330
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Album"
Height = 195
Left = 270
TabIndex = 2
Top = 1110
Width = 435
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Artist"
Height = 195
Left = 345
TabIndex = 1
Top = 795
Width = 345
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "Title"
Height = 195
Left = 390
TabIndex = 0
Top = 465
Width = 300
End
End
Attribute VB_Name = "frmInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' ID3 Tag Display/Editor
' ======================
' You can open this form and leave it open and the info
' will be updated when the song is changed provided the
' edit checkbox is not checked. When the edit box is checked
' you can edit the tag info without fear of it changing
' when the song changes.
' Initializes the form设定形式初值
Private Sub Form_Load()
Me.Icon = frmVBAmp.Icon
Show
Call GetInfo
End Sub
'Fills the textboxes with info from the tag structure将 textboxes 装满来自标签结构的信息
Sub GetInfo()
txtFileName.Text = frmVBAmp.SongPath
With InfoTag
txtTitle.Text = Trim$(.Title)
txtArtist.Text = Trim$(.Artist)
txtAlbum.Text = Trim$(.Album)
txtYear.Text = Trim$(.Year)
txtTrack.Text = Format$(Asc(.Track), "00")
txtComment.Text = Trim$(.Comment)
n = Asc(.Genre) + 1: If n > 80 Then n = 0
cboGenre.ListIndex = n
End With
Call SetCover
End Sub
'Loads the matching album cover bitmap (if available)
Sub SetCover()
Dim PP As String, X1 As String, X2 As String, F As String, XX As String
If txtAlbum.Text = "" Then Exit Sub
PP = GetPath(txtFileName.Text): XX = ""
X1 = Trim(txtArtist.Text)
X2 = Trim(txtAlbum.Text)
If X2 <> "" Then F = FindCover(PP & X2): If F <> "" Then XX = F
If X1 <> "" Then
F = FindCover(PP & X1 & "-" & X2): If F <> "" Then XX = F
F = FindCover(PP & X1 & " - " & X2): If F <> "" Then XX = F
End If
If XX <> "" Then
imgCover.Picture = LoadPicture(XX)
Else
imgCover.Picture = Nothing
End If
End Sub
'Watches for new song and updates the info
Private Sub Timer1_Timer()
If cbEdit.Value = 0 Then
If frmVBAmp.SongPath <> txtFileName.Text Then Call GetInfo
End If
End Sub
'Closes the form
Private Sub cmdOk_Click()
Unload Me
End Sub
Private Sub cbEdit_Click()
If cbEdit.Value = 0 Then cmdSave.Enabled = False Else cmdSave.Enabled = True
End Sub
Private Sub cmdCurrent_Click()
Call GetInfo
End Sub
Private Sub cmdSave_Click()
Call SaveIDTag
End Sub
Sub SaveIDTag()
Dim F As String, FIO As Integer, n As Long, tagpos As Long
Dim p As Long, M As String, TPos As Double
Dim NewTag As IDTag, Inbuf As String * 256
F = txtFileName.Text
FIO = FreeFile
Open F For Binary As FIO
n = LOF(FIO): If n < 256 Then Close: Exit Sub
Get #FIO, (n - 255), Inbuf
p = InStr(1, Inbuf, "tag", 1) 'find position of existing tag if any
If p = 0 Then
tagpos = n + 1: M = "Added!"
Else
M = "Updated!"
tagpos = n - 256 + p 'calculate position in file
End If
Close FIO
With NewTag
.Title = txtTitle.Text
.Artist = txtArtist.Text
.Album = txtAlbum.Text
.Year = txtYear.Text
.Track = Chr(Val(txtTrack.Text))
.Comment = txtComment.Text
n = cboGenre.ListIndex - 1: If n < 0 Then n = 254
.Genre = Chr(n)
End With
' If same track is playing; stop it and close file
If F = frmVBAmp.SongPath Then
TPos = frmVBAmp.MediaPosition.CurrentPosition
Call frmVBAmp.CleanUP
Timer1.Enabled = False
InfoTag = NewTag 'Update current info tag
End If
'On Error GoTo WriteErr
FIO = FreeFile
Open F For Binary As FIO
Put #FIO, tagpos, "TAG" 'write the tag header
Put #FIO, tagpos + 3, NewTag 'update or append tag
Close FIO
' Restart song if nesessary
If (F = frmVBAmp.SongPath) And (frmVBAmp.Playing = True) Then
Set frmVBAmp.MediaControl = New FilgraphManager
Set frmVBAmp.MediaPosition = frmVBAmp.MediaControl
Set frmVBAmp.BasicAudio = frmVBAmp.MediaControl
frmVBAmp.MediaControl.RenderFile (frmVBAmp.SongPath)
frmVBAmp.MediaPosition.CurrentPosition = TPos
frmVBAmp.MediaControl.Run
Timer1.Enabled = True
End If
MsgBox "Tag " & M
Exit Sub
WriteErr:
MsgBox "Error writing tag (is file in use?)!"
Close FIO
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -