main.frm

电子书 一个很不错的程序 电子书童(110KB) 希望大家有用的下

 If .HitTest(x, y) Then ' .HitTest(x, y).Selected = True
     Set NodeToMove = .HitTest(x, y) '.SelectedItem '设置要拖动的项。
     Set .DropHighlight = Nothing
 End If
ElseIf Button = 2 Then
     .HitTest(x, y).Selected = True
If tvMain.SelectedItem.Tag = "" Then mnuTClearLink.Enabled = False Else mnuTClearLink.Enabled = True
     PopupMenu mnuTree
End If
End With
End Sub

Private Sub tvMain_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
    If Button = vbLeftButton Then '指示拖动操作。
        Indrag = True '设置标志为 true。
        tvMain.Drag vbBeginDrag '拖动操作。
    End If
End Sub
    
Public Sub AddPathToTree(tree As TreeView, path As String) '未用
Dim PathItem As String
Dim NewItem As String
Dim PathLen As Integer
Dim c As String * 1
Dim i As Integer

If Right$(path, 1) <> "\" Then path = path & "\"
PathLen = Len(path)
For i = 1 To PathLen
c = Mid$(path, i, 1)
 If c = "\" Then
 If PathItem = "" Then
     On Error Resume Next
   tree.Nodes.Add , , "\" & NewItem, NewItem
      PathItem = "\" & NewItem
  Else
    tree.Nodes.Add PathItem, tvwChild, PathItem & "\" & NewItem, NewItem
    PathItem = PathItem & "\" & NewItem
   End If
  NewItem = ""
 Else
 NewItem = NewItem & c
End If
Next i
End Sub

Sub ChooseFiletoSave()
Dim i, findex As Integer
On Error GoTo errd:
With Comdlg
.CancelError = True
.Filter = "Book Index (*.BOI)|*.BOI"
'.InitDir = Left(App.path, 3)
.DialogTitle = "保存 “电子书童” 索引文件"
.FileName = "*.BOI"
.Flags = 4
End With

Comdlg.ShowSave
SaveFileN = Comdlg.FileName
findex = InRecentFiles((SaveFileN))

If findex > MaxRFiles Then
  WriteRecentFiles (SaveFileN)
Else
  UpdateRecentFiles findex
End If

For i = Len(SaveFileN) To 1 Step -1
 If Mid(SaveFileN, i, 1) = "\" Then Exit For
Next
SaveFileP = Left(SaveFileN, i)
HasSelectFile = True
frmBook.Caption = FrmCaption + " - " + SaveFileN
Exit Sub
errd:
HasSelectFile = False
End Sub

Sub ChooseFiletoMatch(M As Integer) '关联文件
Dim tfn As String
On Error GoTo errd:

With Comdlg
.CancelError = True
.Filter = "文本文件 (*.TXT;*.htm;*.html)|*.txt;*.htm;*.html|压缩文件(*.ZIP;*.EXE;*.CHM)|*.ZIP;*.EXE;*.CHM|多媒体(MP3,WAV,MID,JPG,GIF,BMP)|*.MP3;*.WAV;*.MID;*.JPG;*.GIF;*.BMP|所有文件(*.*)|*.*"
.InitDir = ""
.DialogTitle = "选择文件"
.FileName = ""
.Flags = &H40004
End With
Comdlg.ShowOpen
 tfn = Comdlg.FileName

With tvMain
  .Nodes(M).Tag = tfn
  .Nodes(M).Image = Imagen((tfn))
  .Nodes(M).SelectedImage = 0
  
If .Nodes(M).Text = "新建标题" Then .Nodes(M).Text = GetMainName(Comdlg.FileName)
lbCaption.Caption = GetMainName(Comdlg.FileName)
End With
sbMain.Panels(2).Text = tfn
onshow.n = M
loadtext ((tfn))

HasModify = True
Exit Sub
errd:
sbMain.Panels(2).Text = ""
End Sub

Private Sub tvMain_NodeClick(ByVal Node As ComctlLib.Node)
'On Error Resume Next
lbCaption.Caption = Node.Text
sbMain.Panels(2).Text = Right(Node.Tag, Len(Node.Tag) - InStr(Node.Tag, Chr(0)))
If Node.Tag <> "" And ShowText <> Right(Node.Tag, Len(Node.Tag) - InStr(Node.Tag, Chr(0))) Then
 If Dir(Right(Node.Tag, Len(Node.Tag) - InStr(Node.Tag, Chr(0)))) <> "" Then
  onshow.n = Node.index
  loadtext (Node.Tag)
 Else
  txtMain.Text = "无法找到文件 - " + Node.Tag
  ShowText = ""
  onshow.n = 0
 End If
ElseIf Node.Tag = "" Then
 txtMain.Text = ""
 ShowText = ""
 onshow.n = 0
End If
End Sub
Function GetMainName(ByVal fn As String) As String
Dim i As Integer
For i = Len(fn) To 1 Step -1
If Mid(fn, i, 1) = "\" Then Exit For
If Mid(fn, i, 1) = "." Then fn = Left(fn, i - 1): Exit For
Next

For i = Len(fn) To 1 Step -1
If Mid(fn, i, 1) = "\" Then GetMainName = Right(fn, Len(fn) - i): Exit For
Next

End Function

Private Sub txtMain_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = 2 Then
If txtMain.SelText = "" Then mnuXCap.Enabled = False Else mnuXCap.Enabled = True
PopupMenu mnuTxt
End If

End Sub

Sub Getsub(ByVal i As Integer) '保存TreeView的内容
Dim tn As String
With tvMain
   
aa = aa + 1
.Nodes(i).Key = "K" + Str(aa)
tn = .Nodes(i).Tag
If .Nodes(i).Root Is .Nodes(i) Then
Write #1, "K 0", .Nodes(i).Text, Left(tn, Switch(InStr(tn, Chr(0)) = 0, 0, InStr(tn, Chr(0)) > 0, InStr(tn, Chr(0)) - 1)) + Chr(255) + FNtoSave(Right(tn, Len(tn) - InStr(tn, Chr(0))))
Else
Write #1, .Nodes(i).Parent.Key, .Nodes(i).Text, Left(tn, Switch(InStr(tn, Chr(0)) = 0, 0, InStr(tn, Chr(0)) > 0, InStr(tn, Chr(0)) - 1)) + Chr(255) + FNtoSave(Right(tn, Len(tn) - InStr(tn, Chr(0))))
End If

 If .Nodes(i).Children > 0 Then
 Getsub (.Nodes(i).Child.index)
 End If

Do
 
 If i <> .Nodes(i).LastSibling.index Then
   i = .Nodes(i).Next.index
   aa = aa + 1
  .Nodes(i).Key = "K" + Str(aa)
   tn = .Nodes(i).Tag
  If .Nodes(i).FirstSibling Is .Nodes(i).Root Then
   Write #1, "K 0", .Nodes(i).Text, Left(tn, Switch(InStr(tn, Chr(0)) = 0, 0, InStr(tn, Chr(0)) > 0, InStr(tn, Chr(0)) - 1)) + Chr(255) + FNtoSave(Right(tn, Len(tn) - InStr(tn, Chr(0))))
  Else
   Write #1, .Nodes(i).Parent.Key, .Nodes(i).Text, Left(tn, Switch(InStr(tn, Chr(0)) = 0, 0, InStr(tn, Chr(0)) > 0, InStr(tn, Chr(0)) - 1)) + Chr(255) + FNtoSave(Right(tn, Len(tn) - InStr(tn, Chr(0))))
  End If
  If .Nodes(i).Children > 0 Then
   Getsub (.Nodes(i).Child.index)
  End If
 End If
Loop Until i = .Nodes(i).LastSibling.index

End With
End Sub

Function FNtoSave(fn As String) As String
If InStr(fn, SaveFileP) Then
FNtoSave = Mid(fn, Len(SaveFileP) + 1)
Else
FNtoSave = fn
End If
'MsgBox SaveFileP
'MsgBox FN, , FNtoSave
End Function

Sub Loadfile()
Dim s, i, findex As Integer
Dim f As String, g As String, t As String, OpenFileN As String, OpenFileP As String
Dim nodx As Node, tfn As String, conn As String
On Error GoTo errd:

With Comdlg
.CancelError = True
.Filter = "Book Index (*.BOI)|*.BOI"
.DialogTitle = "打开 “电子书童” 索引文件"
.InitDir = BOIPath
.FileName = "*.BOI"
.Flags = &H4 Or &H1000
End With

Comdlg.ShowOpen
frmBook.ZOrder 0
OpenFileN = Comdlg.FileName
SaveFileN = OpenFileN
HasSelectFile = True
HasModify = False
For i = Len(OpenFileN) To 1 Step -1
If Mid(OpenFileN, i, 1) = "\" Then Exit For
Next
OpenFileP = Left(OpenFileN, i)
SaveFileP = OpenFileP
BOIPath = OpenFileP
DataPath = BOIPath
frmBook.Caption = FrmCaption + " - " + SaveFileN

findex = InRecentFiles((OpenFileN))
If findex > MaxRFiles Then
  WriteRecentFiles (OpenFileN)
Else
  UpdateRecentFiles findex
End If
Open OpenFileN For Input As 2

With tvMain

.Nodes.Clear

Do Until EOF(2) '调入TreeView的内容
Input #2, f, g, t
tfn = Right(t, Len(t) - InStr(t, Chr(255)))
If InStr(t, Chr(255)) Then conn = Left(t, InStr(t, Chr(255)) - 1)
s = Val(Right(f, Len(f) - 1))
If s = 0 Then
  Set nodx = .Nodes.Add(, , , g, Imagen((tfn)))
  If tfn <> "" Then
    If InStr(tfn, ":") Then
      nodx.Tag = conn + Chr(0) + tfn
    Else
      nodx.Tag = conn + Chr(0) + OpenFileP + tfn
    End If
  End If
Else
  Set nodx = .Nodes.Add(s, 4, , g, Imagen((tfn)))
  If .Nodes(s).Image = 0 Then .Nodes(s).Image = 12: .Nodes(s).SelectedImage = 13
  If tfn <> "" Then
    If InStr(tfn, ":") Then
      nodx.Tag = conn + Chr(0) + tfn
    Else
      nodx.Tag = conn + Chr(0) + OpenFileP + tfn
    End If
  End If
End If
Loop
Close 2
If tvMain.Nodes.Count = 0 Then Call tvMain.Nodes.Add(, , , "我的文件", 12, 13)
.Nodes(1).Expanded = True
.Nodes(1).Selected = True
Call tvMain_NodeClick(ByVal .Nodes(1))

End With
errd:
End Sub

Sub LoadSet()
Dim Wnds As Integer
On Error Resume Next
Dim tp As String
With txtMain
'.ForeColor = GetSetting("BookManager", "Setting", "fc", &H0)
.Font.Name = GetSetting("BookManager", "Setting", "fontname", "宋体")
.Font.Size = GetSetting("BookManager", "Setting", "fontsize", 12)
.Font.Bold = GetSetting("BookManager", "Setting", "fontbold", 0)
.Font.Italic = GetSetting("BookManager", "Setting", "fonti", 0)
.Font.Underline = GetSetting("BookManager", "Setting", "fontu", 0)
End With
mnuAFSon.Checked = GetSetting("BookManager", "Setting", "AFson", -1)
mnuHtml.Checked = GetSetting("BookManager", "Setting", "DealHtml", -1)
mnuSun.Checked = GetSetting("BookManager", "Setting", "AddSon", -1)
mnuDrag.Checked = GetSetting("BookManager", "Setting", "Drag", 0)
tbMain.Buttons(26).Value = -mnuAFSon.Checked
tbMain.Buttons(25).Value = -mnuHtml.Checked
tbMain.Buttons(24).Value = -mnuSun.Checked
BOIPath = GetSetting("BookManager", "Setting", "BOIPath", App.path)
DataPath = GetSetting("BookManager", "Setting", "DataPath", App.path)

picSplit.Left = GetSetting("BookManager", "Setting", "split", 2700)
DefBrowse = GetSetting("BookManager", "Setting", "defbrowse", "")
CurDir (GetSetting("BookManager", "Setting", "Lastdir", ""))
Wnds = GetSetting("BookManager", "Setting", "wndstyle", 2)
tp = String(260, " ")
Call GetTempPath(260, tp)
TempFile = Left(tp, InStr(tp, Chr(0)) - 1) + "bookman.tmp"
ReadRecentFiles
If Wnds <> 1 Then frmBook.WindowState = Wnds
'errd:
'If Err.Number = 380 Then font_Click
End Sub

Sub SaveSet()
With txtMain
SaveSetting "BookManager", "Setting", "fontname", .Font.Name
SaveSetting "BookManager", "Setting", "fontsize", .Font.Size
SaveSetting "BookManager", "Setting", "fontbold", .Font.Bold
SaveSetting "BookManager", "Setting", "fonti", .Font.Italic
SaveSetting "BookManager", "Setting", "fontu", .Font.Underline
End With
SaveSetting "BookManager", "Setting", "AddSon", mnuSun.Checked
SaveSetting "BookManager", "Setting", "AFSon", mnuAFSon.Checked

SaveSetting "BookManager", "Setting", "DealHtml", mnuHtml.Checked
SaveSetting "BookManager", "Setting", "Drag", mnuDrag.Checked
SaveSetting "BookManager", "Setting", "Split", picSplit.Left
SaveSetting "BookManager", "Setting", "WndStyle", frmBook.WindowState
SaveSetting "BookManager", "Setting", "DefBrowse", DefBrowse
SaveSetting "BookManager", "Setting", "LastDir", CurDir
SaveSetting "BookManager", "Setting", "BOIPath", BOIPath
SaveSetting "BookManager", "Setting", "DataPath", DataPath

End Sub

Sub CommandLineLoad(FileName As String)
Dim s, i As Integer
Dim f As String, g As String, t As String, OpenFileN, OpenFileP As String
Dim nodx As Node, tfn As String, conn As String
On Error GoTo errd:
OpenFileN = FileName
SaveFileN = OpenFileN
'SaveSetting "BookManager", "Setting", "InitDir", GetFilePath((SaveFileN))********
HasSelectFile = True
For i = Len(OpenFileN) To 1 Step -1
If Mid(OpenFileN, i, 1) = "\" Then Exit For
Next
OpenFileP = Left(OpenFileN, i)
SaveFileP = OpenFileP
If OpenFileP <> "" Then BOIPath = OpenFileP
frmBook.Caption = FrmCaption + " - " + SaveFileN

Open OpenFileN For Input As 2

With tvMain

.Nodes.Clear

Do Until EOF(2)
Input #2, f, g, t

tfn = Right(t, Len(t) - InStr(t, Chr(255)))
If InStr(t, Chr(255)) Then conn = Left(t, InStr(t, Chr(255)) - 1)

s = Val(Right(f, Len(f) - 1))
If s = 0 Then
  Set nodx = .Nodes.Add(, , , g, Imagen((tfn)))
  If tfn <> "" Then
    If InStr(tfn, ":") Then
      nodx.Tag = conn + Chr(0) + tfn
    Else
      nodx.Tag = conn + Chr(0) + OpenFileP + tfn
    End If
  End If
Else
  Set nodx = .Nodes.Add(s, 4, , g, Imagen((tfn)))
  If .Nodes(s).Image = 0 Then .Nodes(s).Image = 12: .Nodes(s).SelectedImage = 13

  If tfn <> "" Then
    If InStr(tfn, ":") Then
      nodx.Tag = conn + Chr(0) + tfn
    Else
      nodx.Tag = conn + Chr(0) + OpenFileP + tfn
    End If
  End If
End If
Loop
Close 2
If .Nodes.Count = 0 Then Call .Nodes.Add(, , , "我的文件", 12, 13)
.Nodes(1).Expanded = True
.Nodes(1).Selected = True
Call tvMain_NodeClick(ByVal .Nodes(1))
End With
Exit Sub
errd:
SaveFileN = ""
HasSelectFile = False
SaveFileP = ""
frmBook.Caption = FrmCaption
End Sub

Private Sub WriteRecentFiles(FileName As String)
  Dim fileptr As Integer
  If Len(Trim(FileName)) Then
    fileptr = Val(GetSetting("BookManager", "Setting", "FirstFile", "0"))
    fileptr = IIf(fileptr - 1 >= 0, fileptr - 1, MaxRFiles - 1)
    SaveSetting "BookManager", "Setting", "FirstFile", fileptr & ""
    SaveSetting "BookManager", "Setting", "File" & fileptr, FileName
    ReadRecentFiles
  End If
End Sub

Private Sub ReadRecentFiles()
    Dim i As Integer
    Dim fileptr As Integer
    Dim rFile As String
    Dim rCount As Integer
    '第一个文件的位置
    fileptr = Val(GetSetting("BookManager", "Setting", "FirstFile", "0"))
    rFile = GetSetting("BookManager", "Setting", "File" & fileptr, "")
    rCount = 0
    Do While Len(rFile) And rCount < MaxRFiles
      mLastFile(rCount).Caption = "&" &