none
FindText API 的问题 RRS feed

  • 问题

  • 在VB.net 如何实现

    或者

    http://support.microsoft.com/kb/267939/zh-cn 这里有一篇,有一段代码翻译不过去了

    请给位好心人帮帮忙

    Public Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA" (ByRef pFindreplace As FINDREPLACE) As Integer
        Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As Integer) As Integer
        Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer) As Integer
        Public Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Integer, ByVal hwnd As Integer, ByVal Msg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        Public Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Integer, ByVal nIDDlgItem As Integer) As Integer
        Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        Public Declare Function SetFocus Lib "user32" (ByVal hwnd As Integer) As Integer
        Public Declare Function IsDlgButtonChecked Lib "user32" (ByVal hDlg As Integer, ByVal nIDButton As Integer) As Integer
        Public Declare Function GetDlgItemText Lib "user32" Alias "GetDlgItemTextA" (ByVal hDlg As Integer, ByVal nIDDlgItem As Integer, ByVal lpString As String, ByVal nMaxCount As Integer) As Integer

        Public Const GWL_WNDPROC As Short = (-4)
        Public Const WM_LBUTTONDOWN As Integer = &H201

        Public Const FR_NOMATCHCASE As Integer = &H800
        Public Const FR_MATCHCASE As Integer = &H4
        Public Const FR_NOUPDOWN As Integer = &H400
        Public Const FR_UPDOWN As Integer = &H1
        Public Const FR_NOWHOLEWORD As Integer = &H1000
        Public Const FR_WHOLEWORD As Integer = &H2
        Public Const EM_SETSEL As Integer = &HB1

        Public Const MaxPatternLen As Short = 50 ' Maximum Pattern Length

        Public gOldDlgWndHandle As Integer
        'UPGRADE_ISSUE: FINDREPLACE 对象 未升级。 单击以获得更多信息:“ms-help://MS.VSCC.v90/dv_commoner/local/redirect.htm?keyword="6B85A2A7-FE9F-4FBE-AA0C-CF11AC86A305"”
        Public frText As FINDREPLACE
        Public gTxtSrc As String
        Public gHDlg As Integer
        Public gHTxtWnd As Integer

        ''  Delegate Function FindTextHookProc1(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer

        Function FindTextHookProc(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
            Dim strPtn As String ' pattern string
            Dim hTxtBox As Integer ' handle of the text box in dialog box
            Dim ptnLen As Short ' actual length read by GetWindowString
            Dim sp As Short ' start point of matching string
            Dim ep As Short ' end point of matchiing string
            Dim ret As Integer ' return value for SendMessage

            strPtn = Space(MaxPatternLen)

            Select Case uMsg
                Case WM_LBUTTONDOWN
                    ' Get the pattern string
                    ptnLen = GetDlgItemText(gHDlg, &H480, strPtn, MaxPatternLen)

                    ' Call default window procedure
                    If gOldDlgWndHandle <> 0 Then
                        FindTextHookProc = CallWindowProc(gOldDlgWndHandle, hDlg, uMsg, wParam, lParam)
                    End If

                    ' Customize the winodw procedure
                    If ptnLen <> 0 Then
                        strPtn = Microsoft.VisualBasic.Left(strPtn, ptnLen)
                        SetFocus(gHTxtWnd)

                        ' Get the MatchCase option
                        If IsDlgButtonChecked(gHDlg, &H411) = 0 Then
                            sp = InStr(LCase(gTxtSrc), LCase(strPtn))
                        Else
                            sp = InStr(gTxtSrc, strPtn)
                        End If

                        sp = IIf(sp = 0, -1, sp - 1)

                        If sp = -1 Then
                            Call MessageNoFound()
                        End If

                        ep = Len(strPtn)
                        ret = SendMessage(gHTxtWnd, EM_SETSEL, sp, sp + ep)
                    End If

                Case Else
                    ' Call the default window procedure
                    If gOldDlgWndHandle <> 0 Then
                        FindTextHookProc = CallWindowProc(gOldDlgWndHandle, hDlg, uMsg, wParam, lParam)
                    End If
            End Select
        End Function

    Dim FrText As FINDREPLACE
            FrText.flags = FR_MATCHCASE Or FR_NOUPDOWN Or FR_NOWHOLEWORD
            FrText.lpfnHook = 0&
            FrText.lpTemplateName = 0&
            FrText.lStructSize = Len(FrText)
            FrText.hwndOwner = Me.Handle
            FrText.hInstance = VB6.GetHInstance.ToInt32()

            FrText.lpstrFindWhat = "Sin"

            FrText.lpstrReplaceWith = 0&
            FrText.wFindWhatLen = Len("Sin")
            FrText.wReplaceWithLen = 0
            FrText.lCustData = 0
            gHDlg = FindText(FrText)
            hCmdBtn = GetDlgItem(gHDlg, 1)

            ' Get necessary value for calling default window procedure.
            gOldDlgWndHandle = GetWindowLong(hCmdBtn, GWL_WNDPROC)

            If SetWindowLong(hCmdBtn, GWL_WNDPROC, AddressOf FindTextHookProc) = 0 Then
                gOldDlgWndHandle = 0
            End If

     

    说AddressOf FindTextHookProc 不能转化为integer

     

    2011年4月16日 12:02

答案

  • Hi ,

    将函数声明方式改成这样:Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As FindTextHookProc1) As Integer

    然后再试试。

    Best regards,


    Mike Feng [MSFT]
    MSDN Community Support | Feedback to us
    Get or Request Code Sample from Microsoft
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    2011年4月18日 5:41
    版主
  •   Delegate Function FindTextHookProc1(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    
      Function FindTextHookProc(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        If Form1.InvokeRequired Then
          Dim intarr(4) As Integer
          intarr(0) = hDlg
          intarr(1) = uMsg
          intarr(2) = wParam
          intarr(3) = lParam
          Form1.Invoke(New FindTextHookProc1(AddressOf FindTextHookProc), intarr)
        Else
          ' the whole function
    

    Mike Feng [MSFT]
    MSDN Community Support | Feedback to us
    Get or Request Code Sample from Microsoft
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    2011年4月18日 5:49
    版主

全部回复

  • Hi ,

    将函数声明方式改成这样:Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Integer, ByVal nIndex As Integer, ByVal dwNewLong As FindTextHookProc1) As Integer

    然后再试试。

    Best regards,


    Mike Feng [MSFT]
    MSDN Community Support | Feedback to us
    Get or Request Code Sample from Microsoft
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    2011年4月18日 5:41
    版主
  •   Delegate Function FindTextHookProc1(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    
      Function FindTextHookProc(ByVal hDlg As Integer, ByVal uMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
        If Form1.InvokeRequired Then
          Dim intarr(4) As Integer
          intarr(0) = hDlg
          intarr(1) = uMsg
          intarr(2) = wParam
          intarr(3) = lParam
          Form1.Invoke(New FindTextHookProc1(AddressOf FindTextHookProc), intarr)
        Else
          ' the whole function
    

    Mike Feng [MSFT]
    MSDN Community Support | Feedback to us
    Get or Request Code Sample from Microsoft
    Please remember to mark the replies as answers if they help and unmark them if they provide no help.

    2011年4月18日 5:49
    版主
  • 礼拜五回家试试
    2011年4月19日 8:08
  • 谢谢版主
    2011年4月23日 0:07