0

我正在尝试基于 SharpDevelop TextEditor 创建一个 vb.net 用户控件。我想要语法高亮和代码完成。为了做到这一点,我决定从 SharpDevelop 的源代码(版本 3.2.1.6466)中移植 CSharpCodeCompletion 示例。它在文件夹“samples\CSharpCodeCompletion”中

控件似乎在运行,语法突出显示正常,并且在“。”时显示代码完成窗口。(句号)键被按下。所有成员都在完成窗口中列出。现在我面临三个问题: 1. 当显示代码完成窗口时,任何击键都会进入编辑器,因此列表框中的搜索功能不起作用。2. 当我从列表框中选择一个条目时,单词会返回到编辑器,但会删除句点。例如,我正在输入“字符串”。--> 显示列表框 --> 选择单词“Empty”,我在编辑器中得到“StringEmpty”。3. 在这个命令Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember))中,我得到一个强制转换异常。

请注意,当我从示例编译和运行原始 C# 代码时,编辑器和完成窗口按预期工作。我的猜测集中在两件事上,首先有一个问题,因为我将编辑器放在用户控件而不是示例中的表单中,但是我在代码中看不到任何明显的问题指向这个方向。其次,由于将 C# 代码移植到 VB,因此存在问题。C# 根本不是我的菜,但我尽我所能(我知道一些 Java)将整个东西重写为 VB。

我知道我的代码很大,但我会发布整个控制代码,以防有人想将它加载到 VS2010 并试一试。在这种情况下,您将需要示例 bin 文件夹中的 ICSharpCode.NRefactory、ICSharpCode.SharpDevelop.Dom、ICSharpCode.TextEditor、log4net 和 Mono.Cecil 程序集。

谢谢,请原谅我的英语。这是我的代码

Public Class ctlVBCodeEditor

Private Class HostCallbackImplementation
    Private Shared Sub ShowMessageWithException(msg As String, ex As Exception)
        DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & ex.Message, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
    End Sub

    Private Shared Sub ShowMessage(msg As String)
        DevExpress.XtraEditors.XtraMessageBox.Show(msg, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
    End Sub

    Private Shared Sub ShowAssemblyLoadError(fileName As String, include As String, msg As String)
        DevExpress.XtraEditors.XtraMessageBox.Show(msg & vbCrLf & "File: " & fileName & vbCrLf & "Include: " & include, "Error", MessageBoxButtons.OK, MessageBoxIcon.Stop)
    End Sub

    Public Shared Sub Register(ctlCode As ctlVBCodeEditor)
        ICSharpCode.SharpDevelop.Dom.HostCallback.GetCurrentProjectContent = New Func(Of ICSharpCode.SharpDevelop.Dom.IProjectContent)(Function() ctlCode.myContent)
        ICSharpCode.SharpDevelop.Dom.HostCallback.ShowError = New Action(Of String, System.Exception)(AddressOf ShowMessageWithException)
        ICSharpCode.SharpDevelop.Dom.HostCallback.ShowMessage = New Action(Of String)(AddressOf ShowMessage)
        ICSharpCode.SharpDevelop.Dom.HostCallback.ShowAssemblyLoadError = New Action(Of String, String, String)(AddressOf ShowAssemblyLoadError)
    End Sub
End Class

Private Class CodeCompletionData
    Inherits ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData
    Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData

    Private Shared vbAmbience As ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience

    Private Shared Function GetMemberImageIndex(m As ICSharpCode.SharpDevelop.Dom.IMember) As Integer
        Dim Result As Integer = 0

        If TypeOf m Is ICSharpCode.SharpDevelop.Dom.IMethod Then
            Result = 1
        ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IProperty Then
            Result = 2
        ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IField Then
            Result = 3
        ElseIf TypeOf m Is ICSharpCode.SharpDevelop.Dom.IEvent Then
            Result = 6
        Else
            Result = 3
        End If
        Return Result
    End Function

    Private Shared Function GetClassImageIndex(cl As ICSharpCode.SharpDevelop.Dom.IClass) As Integer
        Dim Result As Integer = 0
        If cl.ClassType = ICSharpCode.SharpDevelop.Dom.ClassType.Enum Then
            Result = 4
        End If
        Return Result
    End Function

    Private Shared Function GetEntityText(e As ICSharpCode.SharpDevelop.Dom.IEntity) As String
        Dim Result As String = String.Empty

        Dim amb As ICSharpCode.SharpDevelop.Dom.IAmbience = vbAmbience

        If TypeOf e Is ICSharpCode.SharpDevelop.Dom.IMethod Then
            Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IMethod))
        ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IProperty Then
            Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IProperty))
        ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IEvent Then
            Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IEvent))
        ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IField Then
            Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IField))
        ElseIf TypeOf e Is ICSharpCode.SharpDevelop.Dom.IClass Then
            Result = amb.Convert(CType(e, ICSharpCode.SharpDevelop.Dom.IClass))
        Else
            Result = e.ToString
        End If

        Return Result
    End Function

    Public Shared Function XmlDocumentationToText(xmlDoc As String) As String
        Dim sb As New System.Text.StringBuilder

        Try
            Using reader As New Xml.XmlTextReader(New IO.StringReader("<root>" & xmlDoc & "</root>"))
                reader.XmlResolver = Nothing
                While reader.Read
                    Select Case reader.NodeType
                        Case Xml.XmlNodeType.Text
                            sb.Append(reader.Value)
                        Case Xml.XmlNodeType.Element
                            Select Case reader.Name
                                Case "filterpriority"
                                    reader.Skip()
                                Case "returns"
                                    sb.AppendLine()
                                    sb.Append("Returns: ")
                                Case "param"
                                    sb.AppendLine()
                                    sb.Append(reader.GetAttribute("name") + ": ")
                                Case "remarks"
                                    sb.AppendLine()
                                    sb.Append("Remarks: ")
                                Case "see"
                                    If reader.IsEmptyElement Then
                                        sb.Append(reader.GetAttribute("cref"))
                                    Else
                                        reader.MoveToContent()
                                        If reader.HasValue Then
                                            sb.Append(reader.Value)
                                        Else
                                            sb.Append(reader.GetAttribute("cref"))
                                        End If
                                    End If
                            End Select
                    End Select
                End While
            End Using

            Return sb.ToString
        Catch ex As Exception
            Return xmlDoc
        End Try
    End Function

    Private member As ICSharpCode.SharpDevelop.Dom.IMember
    Private c As ICSharpCode.SharpDevelop.Dom.IClass
    Private mOverloads As Integer = 0

    Private _Description As String
    Public Overrides ReadOnly Property Description As String
        Get
            If String.IsNullOrEmpty(_Description) Then
                Dim entity As ICSharpCode.SharpDevelop.Dom.IEntity
                If member IsNot Nothing Then
                    entity = CType(member, ICSharpCode.SharpDevelop.Dom.IEntity)
                Else
                    entity = CType(c, ICSharpCode.SharpDevelop.Dom.IEntity)
                End If
                _Description = GetEntityText(entity)
                If mOverloads > 1 Then _Description &= " (+" & mOverloads.ToString & " overloads"
                _Description &= vbCrLf & XmlDocumentationToText(entity.Documentation)
            End If

            Return _Description
        End Get
    End Property
    Public Sub AddOverload()
        mOverloads += 1
    End Sub
    Public Sub New(theMember As ICSharpCode.SharpDevelop.Dom.IMember)
        MyBase.New(theMember.Name, String.Empty, GetMemberImageIndex(theMember))
        Me.member = theMember
    End Sub
    Public Sub New(theClass As ICSharpCode.SharpDevelop.Dom.IClass)
        MyBase.New(theClass.Name, String.Empty, GetClassImageIndex(theClass))
        Me.c = theClass
    End Sub
End Class

Private Class CodeCompletionProvider
    Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider
    Private ctlCode As ctlVBCodeEditor
    Private Function FindExpression(txtArea As ICSharpCode.TextEditor.TextArea) As ICSharpCode.SharpDevelop.Dom.ExpressionResult
        Dim finder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
        Dim Result As ICSharpCode.SharpDevelop.Dom.ExpressionResult = finder.FindExpression(txtArea.Document.TextContent, txtArea.Caret.Offset)
        If Result.Region.IsEmpty Then Result.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(txtArea.Caret.Line + 1, txtArea.Caret.Column + 1)
        Return Result
    End Function
    Private Sub AddCompletionData(resultList As List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData), completionData As ArrayList)
        Dim nameDictionary As Dictionary(Of String, CodeCompletionData) = New Dictionary(Of String, CodeCompletionData)
        'Add the completion data as returned by SharpDevelop.Dom to the
        'list for the text editor
        For Each obj As Object In completionData
            If TypeOf obj Is String Then
                'namespace names are returned as string
                resultList.Add(New ICSharpCode.TextEditor.Gui.CompletionWindow.DefaultCompletionData(Convert.ToString(obj), "namespace " & obj.ToString, 5))
            ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IClass Then
                Dim cl As ICSharpCode.SharpDevelop.Dom.IClass = CType(obj, ICSharpCode.SharpDevelop.Dom.IClass)
                resultList.Add(New CodeCompletionData(cl))
            ElseIf TypeOf obj Is ICSharpCode.SharpDevelop.Dom.IMember Then
                Dim mm As ICSharpCode.SharpDevelop.Dom.IMember = CType(obj, ICSharpCode.SharpDevelop.Dom.IMember)
                If (TypeOf mm Is ICSharpCode.SharpDevelop.Dom.IMethod) AndAlso (CType(mm, ICSharpCode.SharpDevelop.Dom.IMethod).IsConstructor) Then
                    Continue For
                End If
                'Group results by name and add "(x Overloads)" to the
                'description if there are multiple results with the same name.
                Dim data As CodeCompletionData = Nothing
                If nameDictionary.TryGetValue(mm.Name, data) Then
                    data.AddOverload()
                Else
                    data = New CodeCompletionData(mm)
                    nameDictionary(mm.Name) = data
                    resultList.Add(data)
                End If
            Else
                'Current ICSharpCode.SharpDevelop.Dom should never return anything else
                Throw New NotSupportedException
            End If
        Next
    End Sub
    Public ReadOnly Property ImageList As System.Windows.Forms.ImageList Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ImageList
        Get
            Return ctlCode.imageList1
        End Get
    End Property
    Public ReadOnly Property PreSelection As String Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.PreSelection
        Get
            Return String.Empty
        End Get
    End Property
    Public ReadOnly Property DefaultIndex As Integer Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.DefaultIndex
        Get
            Return -1
        End Get
    End Property
    Public Function ProcessKey(key As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.ProcessKey
        If (Char.IsLetterOrDigit(key) Or key = " ") Then
            Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.NormalKey
        Else
            Return ICSharpCode.TextEditor.Gui.CompletionWindow.CompletionDataProviderKeyResult.InsertionKey
        End If
    End Function
    Public Function InsertAction(data As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData, textArea As ICSharpCode.TextEditor.TextArea, insertionOffset As Integer, key As Char) As Boolean Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.InsertAction
        textArea.Caret.Position = textArea.Document.OffsetToPosition(insertionOffset)
        Return data.InsertAction(textArea, key)
    End Function
    Public Function GenerateCompletionData(fileName As String, textArea As ICSharpCode.TextEditor.TextArea, charTyped As Char) As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData() Implements ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider.GenerateCompletionData
        Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
        Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(FindExpression(textArea), _
                                                                                ctlCode.parseInfo, _
                                                                                textArea.MotherTextEditorControl.Text)
        Dim resultList As New List(Of ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionData)
        If rr IsNot Nothing Then
            Dim completionData As ArrayList = rr.GetCompletionData(ctlCode.myContent)
            If completionData IsNot Nothing Then
                AddCompletionData(resultList, completionData)
            End If
        End If
        Return resultList.ToArray()
    End Function
    Public Sub New(myControl As ctlVBCodeEditor)
        Me.ctlCode = myControl
    End Sub
End Class

Private Class CodeCompletionKeyHandler
    Private ctlCode As ctlVBCodeEditor
    Private txtCode As ICSharpCode.TextEditor.TextEditorControl
    Private codeCompletionWin As ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow
    Private Sub CloseCodeCompletionWindow(sender As Object, e As EventArgs)
        If codeCompletionWin IsNot Nothing Then
            RemoveHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
            codeCompletionWin.Dispose()
            codeCompletionWin = Nothing
        End If
    End Sub
    Public Function TextAreaKeyEventHandler(key As Char) As Boolean
        If codeCompletionWin IsNot Nothing Then
            If codeCompletionWin.ProcessKeyEvent(key) Then
                Return True
            End If
        End If
        If key = "." Then
            Dim completionDataProvider As ICSharpCode.TextEditor.Gui.CompletionWindow.ICompletionDataProvider = New CodeCompletionProvider(Me.ctlCode)
            Dim theForm As System.Windows.Forms.Form = Me.ctlCode.FindForm
            codeCompletionWin = ICSharpCode.TextEditor.Gui.CompletionWindow.CodeCompletionWindow.ShowCompletionWindow(theForm, Me.txtCode, ctlVBCodeEditor.DummyFileName, completionDataProvider, key)
            If codeCompletionWin IsNot Nothing Then
                AddHandler codeCompletionWin.FormClosed, AddressOf CloseCodeCompletionWindow
            End If
        End If
        Return False
    End Function
    Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
        Me.ctlCode = myControl
        Me.txtCode = myCodeText
    End Sub
    Public Shared Function Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl) As CodeCompletionKeyHandler
        Dim Result As New CodeCompletionKeyHandler(theControl, theEditor)
        AddHandler theEditor.ActiveTextAreaControl.TextArea.KeyEventHandler, AddressOf Result.TextAreaKeyEventHandler
        AddHandler theEditor.Disposed, AddressOf Result.CloseCodeCompletionWindow
        Return Result
    End Function
End Class

Private Class ToolTipProvider
    Private ctlCode As ctlVBCodeEditor
    Private txtCode As ICSharpCode.TextEditor.TextEditorControl
    Private Function GetText(result As ICSharpCode.SharpDevelop.Dom.ResolveResult) As String
        If result Is Nothing Then
            Return String.Empty
        End If

        If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MixedResolveResult Then
            Return GetText(CType(result, ICSharpCode.SharpDevelop.Dom.MixedResolveResult).PrimaryResult)
        End If
        Dim ambience As ICSharpCode.SharpDevelop.Dom.IAmbience = New ICSharpCode.SharpDevelop.Dom.VBNet.VBNetAmbience
        ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.StandardConversionFlags Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowAccessibility
        If TypeOf result Is ICSharpCode.SharpDevelop.Dom.MemberResolveResult Then
            Return GetMemberText(ambience, CType(result, ICSharpCode.SharpDevelop.Dom.MemberResolveResult).ResolvedMember)
        ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.LocalResolveResult Then
            Dim lrr As ICSharpCode.SharpDevelop.Dom.LocalResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.LocalResolveResult)
            ambience.ConversionFlags = ICSharpCode.SharpDevelop.Dom.ConversionFlags.UseFullyQualifiedTypeNames Or ICSharpCode.SharpDevelop.Dom.ConversionFlags.ShowReturnType
            Dim sb As New System.Text.StringBuilder
            If lrr.IsParameter Then
                sb.Append("parameter ")
            Else
                sb.Append("local variable ")
            End If
            sb.Append(ambience.Convert(lrr.Field))
            Return sb.ToString
        ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult Then
            Return "namespace " & CType(result, ICSharpCode.SharpDevelop.Dom.NamespaceResolveResult).Name
        ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.TypeResolveResult Then
            Dim c As ICSharpCode.SharpDevelop.Dom.IClass = CType(result, ICSharpCode.SharpDevelop.Dom.TypeResolveResult).ResolvedClass
            If c IsNot Nothing Then
                'Return ambience.Convert(result.ResolvedType)
                Return GetMemberText(ambience, CType(c, ICSharpCode.SharpDevelop.Dom.IMember))
            Else
                Return ambience.Convert(result.ResolvedType)
            End If
        ElseIf TypeOf result Is ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult Then
            Dim mrr As ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult = CType(result, ICSharpCode.SharpDevelop.Dom.MethodGroupResolveResult)
            Dim m As ICSharpCode.SharpDevelop.Dom.IMethod = mrr.GetMethodIfSingleOverload
            If m IsNot Nothing Then
                Return GetMemberText(ambience, m)
            Else
                Return "Overload of " & ambience.Convert(mrr.ContainingType) & "." & mrr.Name
            End If
        Else
            Return String.Empty
        End If
    End Function
    Private Shared Function GetMemberText(ambience As ICSharpCode.SharpDevelop.Dom.IAmbience, member As ICSharpCode.SharpDevelop.Dom.IMember) As String
        Dim sb As New System.Text.StringBuilder
        If TypeOf member Is ICSharpCode.SharpDevelop.Dom.IField Then
            sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IField)))
        ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IProperty Then
            sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IProperty)))
        ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IEvent Then
            sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IEvent)))
        ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IMethod Then
            sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IMethod)))
        ElseIf TypeOf member Is ICSharpCode.SharpDevelop.Dom.IClass Then
            sb.Append(ambience.Convert(CType(member, ICSharpCode.SharpDevelop.Dom.IClass)))
        Else
            sb.Append("unknown member ")
            sb.Append(member.ToString())
        End If
        Dim documentation As String = member.Documentation
        If (documentation IsNot Nothing) AndAlso (documentation.Length > 0) Then
            sb.Append(vbCrLf)
            sb.Append(CodeCompletionData.XmlDocumentationToText(documentation))
        End If

        Return sb.ToString
    End Function
    Private Sub OnToolTipRequest(sender As Object, e As ICSharpCode.TextEditor.ToolTipRequestEventArgs)
        If e.InDocument And (Not e.ToolTipShown) Then
            Dim expFinder As ICSharpCode.SharpDevelop.Dom.IExpressionFinder = New ICSharpCode.SharpDevelop.Dom.VBNet.VBExpressionFinder
            Dim expResult As ICSharpCode.SharpDevelop.Dom.ExpressionResult = expFinder.FindFullExpression(txtCode.Text, txtCode.Document.PositionToOffset(e.LogicalPosition))
            If expResult.Region.IsEmpty Then
                expResult.Region = New ICSharpCode.SharpDevelop.Dom.DomRegion(e.LogicalPosition.Line + 1, e.LogicalPosition.Column + 1)
            End If
            Dim txtArea As ICSharpCode.TextEditor.TextArea = txtCode.ActiveTextAreaControl.TextArea
            Dim resolver As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryResolver(ctlCode.myContent.Language)
            Dim rr As ICSharpCode.SharpDevelop.Dom.ResolveResult = resolver.Resolve(expResult, ctlCode.parseInfo, txtArea.MotherTextEditorControl.Text)
            Dim toolTipText As String = GetText(rr)
            If Not String.IsNullOrEmpty(toolTipText) Then
                e.ShowToolTip(toolTipText)
            End If
        End If
    End Sub
    Public Sub New(myControl As ctlVBCodeEditor, myCodeText As ICSharpCode.TextEditor.TextEditorControl)
        Me.ctlCode = myControl
        Me.txtCode = myCodeText
    End Sub
    Public Shared Sub Attach(theControl As ctlVBCodeEditor, theEditor As ICSharpCode.TextEditor.TextEditorControl)
        Dim tp As New ToolTipProvider(theControl, theEditor)
        AddHandler theEditor.ActiveTextAreaControl.TextArea.ToolTipRequest, AddressOf tp.OnToolTipRequest
    End Sub
End Class

Private Const DummyFileName As String = "dummy.vb"

Private pcREG As ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
Private myContent As ICSharpCode.SharpDevelop.Dom.DefaultProjectContent
Private parseInfo As ICSharpCode.SharpDevelop.Dom.ParseInformation
Private lastCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
Private parserThread As Threading.Thread
Private CurrentLanguageProperties As ICSharpCode.SharpDevelop.Dom.LanguageProperties

Private Sub InitializeControl()
    parseInfo = New ICSharpCode.SharpDevelop.Dom.ParseInformation
    CurrentLanguageProperties = ICSharpCode.SharpDevelop.Dom.LanguageProperties.VBNet
    txtCode.SetHighlighting("VBNET")

    HostCallbackImplementation.Register(Me)
    CodeCompletionKeyHandler.Attach(Me, txtCode)
    ToolTipProvider.Attach(Me, txtCode)
    pcREG = New ICSharpCode.SharpDevelop.Dom.ProjectContentRegistry
    'pcREG.ActivatePersistence(IO.Path.Combine(My.Computer.FileSystem.SpecialDirectories.Temp, "test"))
    myContent = New ICSharpCode.SharpDevelop.Dom.DefaultProjectContent()
    myContent.Language = CurrentLanguageProperties
End Sub

Private Function ConvertCompilationUnit(cu As ICSharpCode.NRefactory.Ast.CompilationUnit) As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
    Dim converter As New ICSharpCode.SharpDevelop.Dom.NRefactoryResolver.NRefactoryASTConvertVisitor(myContent)
    cu.AcceptVisitor(converter, Nothing)
    Return converter.Cu
End Function

Private Sub ParseStep()
    Dim code As String = String.Empty
    Invoke(New MethodInvoker(Sub() code = txtCode.Text))
    Dim txtReader As IO.TextReader = New IO.StringReader(code)
    Dim newCompUnit As ICSharpCode.SharpDevelop.Dom.ICompilationUnit
    Dim supportedLanguage As ICSharpCode.NRefactory.SupportedLanguage = ICSharpCode.NRefactory.SupportedLanguage.VBNet
    Using p As ICSharpCode.NRefactory.IParser = ICSharpCode.NRefactory.ParserFactory.CreateParser(supportedLanguage, txtReader)
        'we only need to parse types and method definitions, no method bodies
        p.ParseMethodBodies = False
        p.Parse()
        newCompUnit = ConvertCompilationUnit(p.CompilationUnit)
    End Using
    'Remove information from lastCompilationUnit and add from newCompilationUnit.
    myContent.UpdateCompilationUnit(lastCompUnit, newCompUnit, DummyFileName)
    lastCompUnit = newCompUnit
    parseInfo.SetCompilationUnit(newCompUnit)
End Sub

Private Sub BackgroundParser()
    BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading Visual Basic..."))
    myContent.AddReferencedContent(pcREG.Mscorlib)

    'do one initial parser step to enable code-completion while other references are loading
    ParseStep()

    Dim refAssemblies As String() = {"System", _
                                     "System.Data", _
                                     "System.Drawing", _
                                     "System.Xml", _
                                     "System.Windows.Forms", _
                                     "Microsoft.VisualBasic"}
    For Each asmName As String In refAssemblies
        Dim asmNameCopy As String = asmName
        BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Loading " & asmNameCopy & "..."))
        Dim refContent As ICSharpCode.SharpDevelop.Dom.IProjectContent = pcREG.GetProjectContentForReference(asmName, asmName)
        myContent.AddReferencedContent(refContent)
        If TypeOf refContent Is ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent Then
            CType(refContent, ICSharpCode.SharpDevelop.Dom.ReflectionProjectContent).InitializeReferences()
        End If
    Next
    myContent.DefaultImports = New ICSharpCode.SharpDevelop.Dom.DefaultUsing(myContent)
    myContent.DefaultImports.Usings.Add("System")
    myContent.DefaultImports.Usings.Add("System.Text")
    myContent.DefaultImports.Usings.Add("Microsoft.VisualBasic")
    BeginInvoke(New MethodInvoker(Sub() lblInfo.Text = "Ready..."))
    'Parse the current file every 2 seconds
    While Not IsDisposed
        ParseStep()
        Threading.Thread.Sleep(2000)
    End While
End Sub

Protected Overrides Sub OnLoad(e As System.EventArgs)
    MyBase.OnLoad(e)

    If Not DesignMode Then
        parserThread = New Threading.Thread(AddressOf BackgroundParser)
        parserThread.IsBackground = True
        parserThread.Start()
    End If
End Sub

Public Sub New()

    ' This call is required by the designer.
    InitializeComponent()

    ' Add any initialization after the InitializeComponent() call.
    If Not DesignMode Then
        InitializeControl()
    End If
End Sub
End Class
4

0 回答 0