frmdirectory.frm

用VB语言编写的电子书阅读器

VERSION 5.00
Begin VB.Form frmDirectory 
   AutoRedraw      =   -1  'True
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   5  'Sizable ToolWindow
   Caption         =   "打开新书"
   ClientHeight    =   5250
   ClientLeft      =   10680
   ClientTop       =   4890
   ClientWidth     =   3480
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5250
   ScaleWidth      =   3480
   ShowInTaskbar   =   0   'False
   Begin VB.FileListBox File1 
      Height          =   450
      Left            =   2280
      TabIndex        =   2
      Top             =   4440
      Visible         =   0   'False
      Width           =   1095
   End
   Begin VB.DirListBox Dir1 
      Height          =   3240
      Left            =   360
      TabIndex        =   1
      Top             =   1080
      Width           =   2775
   End
   Begin VB.DriveListBox Drive1 
      Height          =   300
      Left            =   360
      TabIndex        =   0
      Top             =   480
      Width           =   2775
   End
   Begin VB.Label Label1 
      Alignment       =   2  'Center
      AutoSize        =   -1  'True
      BackColor       =   &H00FFFFFF&
      Caption         =   "确定"
      BeginProperty Font 
         Name            =   "宋体"
         Size            =   12
         Charset         =   134
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   240
      Left            =   1560
      TabIndex        =   3
      Top             =   4560
      Width           =   510
   End
End
Attribute VB_Name = "frmDirectory"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

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

Private Sub Drive1_Change()
    Dir1.Path = Drive1.Drive
End Sub

Private Sub Form_Load()
    Drive1.Drive = "c:"
End Sub

Public Sub AddBook()        '添加书
    Dim i As Integer
    Dim j As Integer
    j = 1
    Dim strBookName As String
    Dim strkey As String
    Dim nodeTem As Node
    Dim errorFlag As Boolean
    errorFlag = False
    
    strBookName = StrReverse(Mid(StrReverse(File1.Path), 1, InStr(1, StrReverse(File1.Path), "\") - 1))     '获得书名（以文件夹名命名）
    
    If strBookName = "" Then        '检测用户是否已选择书目
        MsgBox "未选择书目", 0 + vbInformation, "提示"
        errorFlag = True
    Else
        For i = 1 To frmBookCollection.treeBookCollection.Nodes.Count
            If strBookName = frmBookCollection.treeBookCollection.Nodes.Item(i).Key Then        '有重名书
                MsgBox "这本书已经加入书架", 0 + vbInformation, "提示"
                errorFlag = True
            End If
        Next i
    End If
    
    If Not errorFlag Then        '无重名书则添加新书
        frmBookCollection.treeBookCollection.ImageList = frmBookCollection.ImageList1
        Set nodeTem = frmBookCollection.treeBookCollection.Nodes.Add("我的书架", tvwChild, strBookName, strBookName, 1)      '加入结点
        frmBookCollection.listBookPath.AddItem File1.Path       '保存路径
    
        For i = 0 To File1.ListCount - 1        '文件夹下所有符合要求文件加入结点
            If File1.List(i) Like "*.txt" Or File1.List(i) Like "*.html" Then
                strkey = strBookName & "Chapter" & Str(j)       '以 文件夹名+Chapter+序号 命名子结点关键字
                frmBookCollection.treeBookCollection.Nodes.Add strBookName, tvwChild, strkey, File1.List(i), 3
                frmBookCollection.listBookPath.AddItem File1.Path & "\" & File1.List(i)     '保存路径
                j = j + 1
            End If
        Next i
    
        nodeTem.ExpandedImage = 2       '书被展开时，显示图片2
        nodeTem.Expanded = False
    End If
    
End Sub

Private Sub Label1_Click()      '确定
    If frmBookCollection.boolAddBook Then
        AddBook         '调用过程添加书籍
    ElseIf frmMusic.boolAddMusic Then
        AddMusic        '调用函数添加音乐
    End If
    frmDirectory.Hide
End Sub

Public Sub AddMusic()       '添加音乐
    Dim i As Integer
    Dim newad As String
    Dim newMe As IWMPMedia
    
    For i = 0 To File1.ListCount       '判断文件类型，音乐文件写入播放列表，并记录该文件路径
        If File1.List(i) Like "*.mp3" Or File1.List(i) Like "*.mpga" Or File1.List(i) Like "*.wma" Or File1.List(i) Like "*.wav" Or File1.List(i) Like "*.midi" Or File1.List(i) Like "*.mid" Or File1.List(i) Like "*.mp2" Or File1.List(i) Like "*.cda" Then
            newad = File1.Path & "\" & File1.List(i)      '得到新音乐文件的地址
            Set newMe = frmMusic.WMP.newMedia(newad)      '创建新Media对象
            frmMusic.WMP.currentPlaylist.appendItem newMe         '将新Media加入到当前播放列表
            frmMusic.listMusic.AddItem newMe.Name
        End If
    Next i
End Sub