main.frm

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

Call tvMain_NodeClick(tvMain.SelectedItem)
End Sub

Private Sub mnuMatch_Click()
If tvMain.Nodes.Count = 0 Then mnuAddPoint_Click
sbMain.Panels(2).Text = "请选择要加入索引的文件"
ChooseFiletoMatch (tvMain.SelectedItem.index)
End Sub

Private Sub mnuNew_Click()
Dim result As Long
If HasModify = True Then
result = MsgBox("是否将索引存盘？", vbQuestion Or vbYesNoCancel, "打开原有索引")
Select Case result
   Case 6 'Yes
    mnuSave_Click
   Case 7 'No
   Case 2 'Cancel
   Exit Sub
End Select
End If
With tvMain
.Nodes.Clear
.Nodes.Add , , , "我的文件", 12, 13
.Nodes(1).Selected = True
.SetFocus
End With
HasSelectFile = False
SaveFileP = ""
SaveFileN = ""

Call tvMain_NodeClick(tvMain.Nodes(1))
frmBook.Caption = FrmCaption
HasModify = False
End Sub

Private Sub mnuOpen_Click()
Dim result As Long
If HasModify = True Then

result = MsgBox("是否将索引存盘？", vbQuestion Or vbYesNoCancel, "打开原有索引")
Select Case result
   Case 6 'Yes
    mnuSave_Click
   Case 7 'No
   Case 2 'Cancel
   Exit Sub
End Select
End If
Loadfile
End Sub

Private Sub mnuPath_Click()
mnuPath.Checked = Not mnuPath.Checked
End Sub
Private Sub mnuSave_Click()
Dim n, i As Integer
aa = 0
For i = 1 To tvMain.Nodes.Count
tvMain.Nodes(i).Key = ""
Next
If Not HasSelectFile Then ChooseFiletoSave
If HasSelectFile Then
If tvMain.Nodes.Count = 0 Then Call tvMain.Nodes.Add(, , , "我的文件", 12, 13)
Open SaveFileN For Output As 1
Getsub (tvMain.Nodes(1).Root.index) '*******************************
Close 1
HasModify = False
End If
End Sub

Private Sub mnuSaveAs_Click()
Dim n, i As Integer
aa = 0
For i = 1 To tvMain.Nodes.Count
 tvMain.Nodes(i).Key = ""
Next
ChooseFiletoSave
If HasSelectFile Then
If tvMain.Nodes.Count = 0 Then Call tvMain.Nodes.Add(, , , "我的文件", 12, 13)
 Open SaveFileN For Output As 1
 Getsub (tvMain.Nodes(1).Root.index)
 Close 1
 HasModify = False
End If

End Sub

Private Sub mnuSearch_Click()
Dim Txtsearch As String
Dim i As Long, c As Long, n As Integer
Dim lS As Long, tfn As String
Dim nodx As Node
Txtsearch = InputBox("在所有文件中查找什么?")
With tvMain
If Txtsearch <> "" Then
 c = .Nodes.Count
 gFindString = Txtsearch
 gFindCase = 0
 gFindDirection = 1
 gCurPos = 1
 gFirstTime = True
 Set nodx = .Nodes.Add(, , , "包含" + Txtsearch + "的文件", 12, 13)
 n = nodx.index
 For i = 1 To c
  tfn = Right(.Nodes(i).Tag, Len(.Nodes(i).Tag) - InStr(.Nodes(i).Tag, Chr(0)))
  If tfn <> "" Then
   If Search(tfn, Txtsearch) Then
    Set nodx = .Nodes.Add(n, 4, , .Nodes(i).Text)
    nodx.Tag = .Nodes(i).Tag
   End If
  End If
 Next
End If
End With
End Sub

Function Search(FileSearch As String, Txtsearch As String) As Boolean
Dim tmpStr As String
Dim lFileLen, lGet, lStart As Long
'*****************下次改进
If Dir(FileSearch) <> "" Then
 Open FileSearch For Binary As 3
  lFileLen = LOF(3)
  tmpStr = String(lFileLen, 32)
  Get 3, 1, tmpStr
  If InStr(tmpStr, Txtsearch) Then Search = True
 Close 3
End If
End Function

Private Sub mnuSort_Click()
''
With tvMain

If .Nodes.Count > 0 Then

If .SelectedItem.Parent Is Nothing Then
.Sorted = True
.Sorted = False

Else
.SelectedItem.Parent.Sorted = True
.SelectedItem.Parent.Sorted = False
End If

End If
End With
End Sub

Private Sub mnuStatus_Click()

mnuStatus.Checked = Not mnuStatus.Checked
sbMain.Visible = mnuStatus.Checked
ControlSize
End Sub

Private Sub mnuSun_Click()
mnuSun.Checked = Not mnuSun.Checked
tbMain.Buttons(24).Value = -mnuSun.Checked
End Sub

Private Sub mnuTAddFile_Click()
Call mnuAddfile_Click
End Sub

Private Sub mnuTAddPoint_Click()
Call mnuAddPoint_Click
End Sub

Private Sub mnuTAddSub_Click()
Call mnuAddSub_Click
End Sub

Private Sub mnuTClearLink_Click()
mnuClearLink_Click
End Sub

Private Sub mnuTDelete_Click()
Call mnuDeletePoint_Click
End Sub

Private Sub mnuTDeleteFile_Click()
mnuDeleteFile_Click
End Sub

Private Sub mnuTExec_Click()
mnuExec_Click
End Sub

Private Sub mnuTExport_Click()
Call mnuExport_Click
End Sub

Private Sub mnuTMatch_Click()
Call mnuMatch_Click
End Sub

Private Sub mnuTool_Click()
mnuTool.Checked = Not mnuTool.Checked
tbMain.Visible = mnuTool.Checked
ControlSize
End Sub

Private Sub mnuXAppend_Click()
mnuAppend_Click
End Sub

Private Sub mnuXCap_Click()
Dim cap As String

If frmBook.ActiveControl Is txtMain Then
 If txtMain.SelText <> "" And tvMain.Nodes.Count > 0 Then
  cap = Left(txtMain.SelText, 50)
  tvMain.SelectedItem.Text = cap
 End If
ElseIf frmBook.ActiveControl Is tvMain Then
 tvMain.StartLabelEdit
End If
HasModify = True
End Sub

Private Sub mnuXCopy_Click()
mnuCopy_Click
End Sub

Private Sub mnuXExec_Click()
mnuExec_Click
End Sub

Private Sub mnuXFont_Click()
mnuFont_Click
End Sub

Private Sub picSplit_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Lastx = x
If Not mnuDrag.Checked Then
picSplit.BackColor = picSplit.ForeColor
picSplit.ZOrder 0
End If
End Sub

Private Sub picSplit_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim tempLeft As Single
If Button = 1 Then
 If mnuDrag.Checked Then
 With picSplit
  tempLeft = .Left + x - Lastx
  If tempLeft < SplitLimit Then tempLeft = SplitLimit
  If tempLeft > Me.Width - 2 * SplitLimit Then tempLeft = Me.Width - SplitLimit * 2
  .Left = tempLeft
  tvMain.Width = tempLeft
  txtMain.Left = tempLeft + .Width - 15
  lbCaption.Left = txtMain.Left + 15
  txtMain.Width = frmBook.Width - txtMain.Left - 90
  lbCaption.Width = txtMain.Width - 60
 End With
 ElseIf mnuDrag.Checked = False Then
  tempLeft = picSplit.Left + x - Lastx
  If tempLeft < SplitLimit Then tempLeft = SplitLimit
  If tempLeft > Me.Width - 2 * SplitLimit Then tempLeft = Me.Width - SplitLimit * 2
  picSplit.Left = tempLeft
 End If
End If
End Sub

Private Sub picSplit_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Lastx = 0
If Not mnuDrag.Checked Then
picSplit.BackColor = frmBook.BackColor
picSplit.ZOrder 1
ControlSize
End If
End Sub
Sub ControlSize()
On Error Resume Next

tvMain.Width = picSplit.Left
txtMain.Left = picSplit.Left + picSplit.Width - 15
lbCaption.Left = txtMain.Left + 15
txtMain.Width = frmBook.Width - txtMain.Left - 90
lbCaption.Width = txtMain.Width - 60

With picSplit
If mnuTool.Checked Then
   .Top = tbMain.Height
Else
   .Top = 0
End If
If mnuStatus.Checked Then
.Height = Me.ScaleHeight - sbMain.Height - .Top
Else
.Height = Me.ScaleHeight - .Top
End If
tvMain.Top = .Top
tvMain.Height = .Height
lbCaption.Top = .Top
txtMain.Top = .Top + lbCaption.Height + 45
txtMain.Height = .Height - lbCaption.Height - 45
sbMain.Panels(2).Width = frmBook.Width - 2000
End With

End Sub


Private Sub sbMain_PanelClick(ByVal Panel As ComctlLib.Panel)
If Panel.index = 1 Then Call ShellExecute(Me.hwnd, "open", "mailto: [e-mail]?subject=电子书童反馈", "", "", 1)
End Sub

Private Sub tbMain_ButtonClick(ByVal Button As ComctlLib.Button)

Select Case Button.index
   Case 2
     mnuNew_Click
   Case 3
     mnuOpen_Click
   Case 4
     mnuSave_Click
   Case 6
     mnuSort_Click
   Case 8
     Call mnuAddfile_Click
   Case 9
     Call mnuAddPoint_Click
   Case 10
     Call mnuAddSub_Click
   Case 11
     Call mnuMatch_Click
   Case 12
     Call mnuDeletePoint_Click
   Case 13
     Call mnuDeleteFile_Click
     
   Case 15
     Call mnuCopy_Click
   Case 16
     Call mnuAppend_Click
   Case 17
     Call mnuXCap_Click
   Case 18
     Clipboard.Clear
   Case 20
     Call mnuExec_Click
   Case 22
     Call mnuExit_Click
   Case 24
     mnuSun.Checked = -tbMain.Buttons(24).Value
   Case 25
     mnuHtml.Checked = -tbMain.Buttons(25).Value
     ShowText = ""
     Call tvMain_NodeClick(tvMain.SelectedItem)
   Case 26
     mnuAFSon.Checked = -tbMain.Buttons(26).Value
End Select

End Sub

Private Sub tvMain_AfterLabelEdit(Cancel As Integer, NewString As String)
lbCaption.Caption = NewString
HasModify = True
End Sub
Private Sub tvMain_DragDrop(Source As Control, x As Single, y As Single)
    Dim nodx As Node
    Dim i, N1 As Integer
        '如果用户没移动鼠标，或在无效区释放它。
With tvMain
         
    If .DropHighlight Is Nothing Then
        Indrag = False
        Exit Sub
    ElseIf NodeToMove Is Nothing Then
        Indrag = False
        Exit Sub
    ElseIf .DropHighlight.index = NodeToMove.index Then
        Indrag = False
        Exit Sub
    Else
        '设置被拖动的节点的 parent 属性为目标节点。
        On Error GoTo checkerror '阻止循环错误。
        If mnuSun.Checked Then '同级
          If .DropHighlight.FirstSibling.index <> .Nodes(1).Root.index Then
           Set NodeToMove.Parent = .DropHighlight.Parent
          Else
           Set nodx = .Nodes.Add(, , , NodeToMove.Text)
           nodx.Tag = NodeToMove.Tag
           nodx.Image = NodeToMove.Image
           nodx.SelectedImage = NodeToMove.SelectedImage
           
           N1 = NodeToMove.index
           For i = 1 To NodeToMove.Children
            Set .Nodes(N1).Child.LastSibling.Parent = nodx
           Next
          .Nodes.Remove NodeToMove.index
          End If
        Else
         Set NodeToMove.Parent = .DropHighlight
         If .DropHighlight.Image = 0 Then .DropHighlight.Image = 12: .DropHighlight.Image = 13
         NodeToMove.Selected = True
         
        End If
        
        Set .DropHighlight = Nothing '释放 DropHighlight 引用。
        Indrag = False
        HasModify = True
        Exit Sub '如未发生错误则退出。
    End If
 
checkerror:
    '定义表示 Visual Basic 错误代码的常数。
    Const CircularError = 35614
  '  MsgBox Err.Description
    If Err.Number = CircularError Then
            Indrag = False
            Set .DropHighlight = Nothing
    End If
    End With
End Sub

Private Sub tvMain_DragOver(Source As Control, x As Single, y As Single, State As Integer)
    Set tvMain.DropHighlight = tvMain.HitTest(x, y)
End Sub

Private Sub tvMain_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
On Error Resume Next
With tvMain
If Button = 1 Then