VB编的文本浏览器带查找功能了.请高人指点下,怎么清除上次查找记录 - VB6论坛

maya2012chin
来　自：四川
等　级：新手上路
帖　子：4
专家分：0
注　册：2011-1-5
结帖率：50%
楼主
已结贴√ 问题点数：20 回复次数：2
VB编的文本浏览器带查找功能了.请高人指点下,怎么清除上次查找记录
程序代码：
Option Explicit
Dim SearchFlag As Integer
Private Type NOTIFYICONDATA
    cbSize As Long
    hwnd As Long
    uId As Long
    uFlags As Long
    ucallbackMessage As Long
    hIcon As Long
    szTip As String * 64
End Type
Private Const NIM_ADD = &H0
Private Const NIM_MODIFY = &H1
Private Const NIM_DELETE = &H2
Private Const WM_MOUSEMOVE = &H200
Private Const NIF_MESSAGE = &H1
Private Const NIF_ICON = &H2
Private Const NIF_TIP = &H4
'Shell_NotifyIcon与结构NOTIFYICONDATA将图标设置到系统托盘中
Private Declare Function Shell_NotifyIcon Lib "shell32" Alias "Shell_NotifyIconA" (ByVal dwMessage As Long, pnid As NOTIFYICONDATA) As Boolean
Dim t As NOTIFYICONDATA
' 使用mciSendString函数打开/关闭光驱
Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
'定义点击鼠标左键常量
Private Const WM_LBUTTONDOWN As Long = &H201
'定义点击鼠标右键常量
Private Const WM_RBUTTONDOWN As Long = &H204
Const HTCAPTION = 2
Const WM_NCLBUTTONDOWN = &HA1
Private Declare Function ReleaseCapture Lib "User32" () As Long
Private Declare Function SendMessage Lib "User32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private a() As String
Private idx As Integer
Dim MouseOver
Dim MousePress
Dim NewIndex
Dim Min As Long

Private Sub ButtonPicture1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If MousePress Then Exit Sub
   ButtonPicture1(Index).Picture = DownImage.Picture
   MousePress = True
End Sub

Private Sub ButtonPicture1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If MouseOver Then Exit Sub
   ButtonPicture1(Index).Picture = overImage.Picture
   NewIndex = Index
   MouseOver = True
End Sub

Private Sub ButtonPicture1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Not MousePress Then Exit Sub
       ButtonPicture1(Index).Picture = upImage.Picture
       MousePress = False
       End
End Sub
Private Sub ResetSearch()
dirBrowse.Path = CurDir$: drvBrowse.Drive = dirBrowse.Path 
End Sub
Private Sub Dirbrowse_Change()

 filBrowse.Path = dirBrowse.Path

 Label1.Caption = dirBrowse.Path
    ' Update File listbox to sync with Dir listbox.
    filBrowse.Path = dirBrowse.Path
End Sub

Private Sub Dirbrowse_LostFocus()
    dirBrowse.Path = dirBrowse.List(dirBrowse.ListIndex)
End Sub

Private Sub cmdSearch_Click()
Dim FirstPath As String, DirCount As Integer, NumFiles As Integer
Dim result As Integer
  ' Check what the user did last:
    If cmdSearch.Caption = "&Reset" Then  
    ResetSearch                        
    txtSearchSpec.SetFocus
    Exit Sub
  End If

  ' Update dirList.Path if it is different from the currently
  ' selected directory, otherwise perform the search.
  If dirBrowse.Path <> dirBrowse.List(dirBrowse.ListIndex) Then
     dirBrowse.Path = dirBrowse.List(dirBrowse.ListIndex)
     Exit Sub        
  End If
    Picture1.Move 6000, 6000
Label2.Visible = False
Label3.Visible = False
Label4.Visible = False
drvBrowse.Visible = False
filBrowse.Visible = False
dirBrowse.Visible = False
Label9.Visible = True
file1.Visible = True
Image9.Visible = True
filBrowse.Pattern = txtSearchSpec.Text
  FirstPath = dirBrowse.Path
  DirCount = dirBrowse.ListCount
  Image9.Caption = "Cancel"
  NumFiles = 0                     
  result = DirDiver(FirstPath, DirCount, "")
  filBrowse.Path = dirBrowse.Path
  MsgBox "Search OK! " + dirBrowse.Path
  cmdSearch.Caption = "&Reset"
  cmdSearch.SetFocus
Image9.Caption = "E&xit"
End Sub
Private Function DirDiver(NewPath As String, DirCount As Integer, BackUp As String) As Integer
'  Recursively search directories from NewPath down...
'     NewPath is searched on this recursion.
'     BackUp is origin of this recursion.
'     DirCount is number of subdirectories in this directory.
Static FirstErr As Integer
Dim DirsToPeek As Integer, AbandonSearch As Integer, ind As Integer
Dim OldPath As String, ThePath As String, entry As String
Dim retval As Integer
  SearchFlag = True            
  DirDiver = False             
  retval = DoEvents()         
  If SearchFlag = False Then
    DirDiver = True
    Exit Function
  End If
  On Local Error GoTo DirDriverHandler
  DirsToPeek = dirBrowse.ListCount           
  Do While DirsToPeek > 0 And SearchFlag = True
    OldPath = dirBrowse.Path                
    dirBrowse.Path = NewPath
    If dirBrowse.ListCount > 0 Then
    ' Get to the node bottom.
      dirBrowse.Path = dirBrowse.List(DirsToPeek - 1)
      AbandonSearch = DirDiver((dirBrowse.Path), DirCount%, OldPath)
    End If
    ' Go up 1 level in directories.
    DirsToPeek = DirsToPeek - 1
    If AbandonSearch = True Then Exit Function
  Loop
  ' Call function to enumerate files.
  If filBrowse.ListCount Then
    If Len(dirBrowse.Path) <= 3 Then
        ThePath = dirBrowse.Path         
    Else
        ThePath = dirBrowse.Path + "\"   
    End If
    For ind = 0 To filBrowse.ListCount - 1    
        entry = ThePath + filBrowse.List(ind)     
        file1.AddItem entry
        Label9.Caption = Str$(Val(Label9.Caption) + 1) & "个文件被查找到"
    Next ind
  End If
  If BackUp <> "" Then       
      dirBrowse.Path = BackUp    
  End If
  Exit Function
DirDriverHandler:
  If Err = 7 Then         
    DirDiver = True       
    MsgBox "You've filled the listbox. Search being abandoned..."
    Exit Function        
  Else                   
    MsgBox Error
    End
  End If
End Function
Private Sub DrvBrowse_Change()
    On Error GoTo DriveHandler
    dirBrowse.Path = drvBrowse.Drive
    Exit Sub

DriveHandler:
    drvBrowse.Drive = dirBrowse.Path
    Exit Sub

 On Error GoTo lWrongMsg

 dirBrowse.Path = drvBrowse.Drive

 Exit Sub
lWrongMsg:
txtContents.Text = "实时错误:" & Err.Number & Chr(13) & Err.Description
End Sub

Private Sub filBrowse_Click()
txtContents.LoadFile filBrowse.Path & "\" & filBrowse.FileName
Label1.Caption = dirBrowse.Path & filBrowse.FileName
Label7.Caption = "正在查阅:" & filBrowse
End Sub

Private Sub Form_Load()
Dim i As Integer
    For i = ButtonPicture1.LBound To ButtonPicture1.UBound
      ButtonPicture1(i).Picture = upImage.Picture
    Next i

 dirBrowse.Path = drvBrowse.Drive

 filBrowse.Path = dirBrowse.Path

 filBrowse.FileName = "*.txt"

 Label5 = Time

 Label1.Caption = dirBrowse.Path

 t.cbSize = Len(t)
    t.hwnd = Picture1.hwnd
    t.uId = 1&
    t.uFlags = NIF_ICON Or NIF_TIP Or NIF_MESSAGE
    t.ucallbackMessage = WM_MOUSEMOVE
    t.hIcon = Picture1.Picture
    t.szTip = "威奇文本浏览器" & Chr$(0)
    Shell_NotifyIcon NIM_ADD, t '加入系统托盘中
    Me.Show
    App.TaskVisible = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    t.cbSize = Len(t)
    t.hwnd = Picture1.hwnd
    t.uId = 1&
    Shell_NotifyIcon NIM_DELETE, t ' 从系统托盘中删除图标
End Sub
Private Sub Form_Unload(Cancel As Integer)
    delHotKey Me.hwnd
End Sub
Private Sub RichTextBox1_Change()
End Sub

Private Sub Image1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ReleaseCapture
    SendMessage Me.hwnd, &HA1, 2, 0&
End Sub

Private Sub Image1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = Image5.Picture
Image2.Picture = Image8.Picture
If Not MouseOver Then Exit Sub
   MouseOver = False
   MousePress = False
   ButtonPicture1(NewIndex).Picture = upImage.Picture
End Sub

Private Sub Image2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Frmtextbrowse.Hide
End Sub

Private Sub Image2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image2.Picture = Image7.Picture
End Sub

Private Sub Image3_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = Image6.Picture

End Sub

Private Sub Image3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Image3.Picture = Image4.Picture
End Sub

Private Sub Image3_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
frmAbout.Show
End Sub
Private Sub Image9_Click()
  If Image9.Caption = "E&xit" Then

 cmdSearch.Caption = "&Search"
Label2.Visible = True
Label3.Visible = True
Label4.Visible = True
drvBrowse.Visible = True
filBrowse.Visible = True
dirBrowse.Visible = True
Label9.Visible = False
file1.Visible = False
  Else                
    SearchFlag = False
  End If
End Sub

Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim lMsg As Long
    Static bInHere As Boolean
    lMsg = X / Screen.TwipsPerPixelX
    ' 点击左键弹出菜单
    If lMsg = WM_LBUTTONDOWN Then Frmtextbrowse.Show

    End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
Timer1.Interval = 1000
Label5 = Time
End Sub

Private Sub Timer2_Timer()
Timer2.Enabled = True
Timer2.Interval = 1000
Label5 = Time
End Sub