fav.frm

OpenPlayer代码

VERSION 5.00
Begin VB.Form Fav 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "整理收藏夹"
   ClientHeight    =   4110
   ClientLeft      =   1950
   ClientTop       =   1965
   ClientWidth     =   6345
   Icon            =   "Fav.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   4110
   ScaleWidth      =   6345
   Begin VB.CommandButton cmdExit 
      Caption         =   "关闭"
      Height          =   315
      Left            =   5250
      TabIndex        =   7
      Top             =   3630
      Width           =   765
   End
   Begin VB.CommandButton cmdDel 
      Caption         =   "删除"
      Height          =   315
      Left            =   5250
      TabIndex        =   6
      Top             =   3120
      Width           =   765
   End
   Begin VB.CommandButton cmdChange 
      Caption         =   "修改"
      Height          =   315
      Left            =   4260
      TabIndex        =   5
      Top             =   3120
      Width           =   765
   End
   Begin VB.TextBox Text1 
      BackColor       =   &H80000004&
      BorderStyle     =   0  'None
      Height          =   255
      Index           =   1
      Left            =   720
      Locked          =   -1  'True
      TabIndex        =   2
      Top             =   3660
      Width           =   4245
   End
   Begin VB.TextBox Text1 
      Height          =   285
      Index           =   0
      Left            =   690
      TabIndex        =   1
      Top             =   3120
      Width           =   3435
   End
   Begin VB.ListBox List1 
      Height          =   2760
      ItemData        =   "Fav.frx":27A2
      Left            =   150
      List            =   "Fav.frx":27A4
      TabIndex        =   0
      Top             =   150
      Width           =   6015
   End
   Begin VB.Label Label1 
      Caption         =   "路径:"
      Height          =   195
      Index           =   1
      Left            =   240
      TabIndex        =   4
      Top             =   3660
      Width           =   525
   End
   Begin VB.Label Label1 
      Caption         =   "名称:"
      Height          =   255
      Index           =   0
      Left            =   210
      TabIndex        =   3
      Top             =   3120
      Width           =   525
   End
End
Attribute VB_Name = "Fav"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Private Sub cmdChange_Click()

    Text1(0).Locked = False                                 '解锁[名称]文本框,使其可以修改
    Text1(0).BackColor = &HFFFFFF                           '改变其背景色,为白色
    
    If cmdChange.Caption = "保存" Then
       List1.List(List1.ListIndex) = Text1(0).Text          '改变列表框中选项的文字
       ControlForm.List(2).List(List1.ListIndex) = Text1(0).Text '改变控制台 收藏夹 列表中的 选项文字
       Call FavoritesSave                                   '保存更改
    End If
    
    cmdChange.Caption = "保存"                              '改变按钮的文字为保存

End Sub

Private Sub cmdDel_Click()
'删除一项
'注释见:控制台的:Private Sub MFavDelOne_Click()
Dim Index As Integer

    If List1.ListIndex > -1 Then
        Index = List1.ListIndex
        ControlForm.List(2).RemoveItem (List1.ListIndex)
        ControlForm.List(3).RemoveItem (List1.ListIndex)
        List1.RemoveItem (List1.ListIndex)
        
        Call FavoritesSave
        
        If List1.ListCount > Index Then
            List1.ListIndex = Index
        Else
            If List1.ListCount > 0 Then
                List1.ListIndex = Index - 1
            End If
        End If
        
        Text1(0).Text = List1.List(List1.ListIndex)
        Text1(1).Text = ControlForm.List(3).List(List1.ListIndex)
    End If
End Sub

Private Sub cmdExit_Click()
   Call FavoritesSave
   Unload Me
End Sub

Private Sub Form_Load()
  For i = 0 To ControlForm.List(2).ListCount - 1
       List1.AddItem ControlForm.List(2).List(i), i
  Next
  If List1.ListCount > 0 Then
     List1.ListIndex = 0
     Text1(0).Text = List1.List(0)
     Text1(1).Text = ControlForm.List(3).List(0)
  End If
  
End Sub


Private Sub List1_Click()
Dim oFSO As New FileSystemObject

    Text1(0).Text = List1.List(List1.ListIndex)
    Text1(1).Text = ControlForm.List(3).List(List1.ListIndex)
    Text1(0).Locked = True
    Text1(0).BackColor = Me.BackColor
    cmdChange.Caption = "修改"
    If Not oFSO.FileExists(Text1(1).Text) Then
        Text1(1).ForeColor = vbRed
        Text1(1).Text = Text1(1).Text & "（文件不存在！）"
    Else
        Text1(1).ForeColor = RGB(0, 0, 0)
    End If
End Sub



Private Sub List1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim lXPoint As Long
Dim lYPoint As Long
Dim lIndex As Long
    '
    If List1.ListIndex > -1 Then  ' 如果没有按钮被按下
        lXPoint = CLng(X / Screen.TwipsPerPixelX)
        lYPoint = CLng(Y / Screen.TwipsPerPixelY)
        With List1
            ' 获得当前的光标所在的的屏幕位置确定标题位置
            lIndex = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ((lYPoint * 65536) + lXPoint))
            ' 显示提示行或清除提示行
            If (lIndex >= 0) And (lIndex <= .ListCount) Then
                .ToolTipText = .List(lIndex)
            Else
                .ToolTipText = ""
            End If
        End With
    End If
End Sub

Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
    If KeyAscii = 13 And cmdChange.Caption = "保存" Then        '回车
        KeyAscii = 0
        Call cmdChange_Click
    End If
End Sub

Private Sub Text1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Text1(Index).ToolTipText = Text1(Index).Text
End Sub