Real Time Syntax Highlightning aber wie?

  • VB.NET

Es gibt 6 Antworten in diesem Thema. Der letzte Beitrag () ist von ~Revolt~.

    Real Time Syntax Highlightning aber wie?

    Ich versuche die ganze Zeit ein erfolgreichen Syntax Highlighting zu bauen das nicht hängt
    Hat jemand eine Idee was an diese Code falsch sein könnte

    VB.NET-Quellcode

    1. Public Class SyntaxRTB
    2. Inherits System.Windows.Forms.RichTextBox
    4. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    5. (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, _
    6. ByVal lParam As Integer) As Integer
    7. Private Declare Function LockWindowUpdate Lib "user32" _
    8. (ByVal hWnd As Integer) As Integer
    10. Private _SyntaxHighlight_CaseSensitive As Boolean = False
    12. 'Contains Windows Messages for the SendMessage API call
    13. Private Enum EditMessages
    14. LineIndex = 187
    15. LineFromChar = 201
    16. GetFirstVisibleLine = 206
    17. CharFromPos = 215
    18. PosFromChar = 1062
    19. End Enum
    21. Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
    22. ColorVisibleLines()
    23. End Sub
    25. Private Words As New DataTable
    27. Public Sub New()
    28. Dim MyRow As DataRow
    29. Dim arrKeyWords() As String, strKW As String
    30. Dim arrKeyWords2() As String, strKW2 As String
    32. Me.AcceptsTab = True
    34. ''Load all the keywords and the colors to make them
    35. Words.Columns.Add("Word")
    36. Words.PrimaryKey = New DataColumn() {Words.Columns(0)}
    37. Words.Columns.Add("Color")
    39. arrKeyWords = New String() {"Imports", "insert", "delete", _
    40. "truncate", "from", "where", "into", "inner", "update", _
    41. "outer", "on", "is", "declare", "set", "use", "values", "as", _
    42. "order", "by", "drop", "view", "go", "trigger", "cube", _
    43. "binary", "varbinary", "image", "char", "varchar", "text", _
    44. "datetime", "smalldatetime", "decimal", "numeric", "float", _
    45. "real", "bigint", "int", "smallint", "tinyint", "money", _
    46. "smallmoney", "bit", "cursor", "timestamp", "uniqueidentifier", _
    47. "sql_variant", "table", "nchar", "nvarchar", "ntext", "left", _
    48. "right", "like", "and", "all", "in", "null", "join", "not", "or"}
    50. arrKeyWords2 = New String() {"//", "'"}
    52. For Each strKW In arrKeyWords
    53. MyRow = Words.NewRow()
    54. MyRow("Word") = strKW
    55. MyRow("Color") = Color.Blue.Name
    56. Words.Rows.Add(MyRow)
    57. Next
    59. For Each strKW2 In arrKeyWords2
    60. MyRow = Words.NewRow()
    61. MyRow("Word") = strKW2
    62. MyRow("Color") = Color.Green.Name
    63. Words.Rows.Add(MyRow)
    64. Next
    65. End Sub
    67. Sub ColorRtb()
    68. Dim FirstVisibleChar As Integer
    69. Dim i As Integer = 0
    71. While i < Me.Lines.Length
    72. FirstVisibleChar = GetCharFromLineIndex(i)
    73. ColorLineNumber(i, FirstVisibleChar)
    74. i += 1
    75. End While
    76. End Sub
    78. Public Sub ColorVisibleLines()
    79. Dim FirstLine As Integer = FirstVisibleLine()
    80. Dim LastLine As Integer = LastVisibleLine()
    81. Dim FirstVisibleChar As Integer
    82. Dim i As Integer = FirstLine
    84. If (FirstLine = 0) And (LastLine = 0) Then
    85. ' If there is no text in the control, it will run an error
    87. ' So, if there isn't any text, just exit
    89. Exit Sub
    90. Else
    91. While i < LastLine
    93. FirstVisibleChar = GetCharFromLineIndex(FirstLine)
    95. ColorLineNumber(FirstLine, FirstVisibleChar)
    97. FirstLine += 1
    98. i += 1
    99. End While
    100. End If
    101. End Sub
    103. Public Sub ColorLineNumber(ByVal LineIndex As Integer, ByVal lStart As Integer)
    104. Dim i As Integer = 0
    105. Dim Instance As Integer = 0
    106. Dim LeadingChar = "", TrailingChar As String = ""
    107. Dim SelectionAt As Integer = Me.SelectionStart
    108. Dim MyRow As DataRow
    109. Dim Line() As String, MyI As Integer, MyStr As String
    111. ' Lock the update
    112. LockWindowUpdate(Me.Handle.ToInt32)
    114. MyI = lStart
    116. If CaseSensitive Then
    117. Line = Split(Me.Lines(LineIndex).ToString, " ")
    118. Else
    119. Line = Split(Me.Lines(LineIndex).ToLower, " ")
    120. End If
    122. For Each MyStr In Line
    123. Me.SelectionStart = MyI
    124. Me.SelectionLength = MyStr.Length
    126. If Words.Rows.Contains(MyStr) Then
    127. MyRow = Words.Rows.Find(MyStr)
    128. If (Not CaseSensitive) Or (CaseSensitive And MyRow("Word") = MyStr) Then
    129. Me.SelectionColor = Color.FromName(MyRow("Color"))
    130. End If
    131. Else
    132. Me.SelectionColor = Color.Black
    133. End If
    135. MyI += MyStr.Length + 1
    136. Next
    138. 'Kommentarsyntaxerkenner
    139. Dim LineKommentar As String = Me.Lines(LineIndex).ToLower
    140. Dim Kommentarzeichen1 As Integer
    141. Dim Kommentarzeichen2 As Integer
    143. 'Kommentare
    144. Kommentarzeichen1 = InStr(LineKommentar, "'")
    145. Kommentarzeichen2 = InStr(LineKommentar, "//")
    147. If Kommentarzeichen1 <> 0 Then
    148. Me.SelectionStart = (lStart + Kommentarzeichen1 - 1)
    149. Me.SelectionLength = (LineKommentar.Length - Kommentarzeichen1 + 1)
    150. Me.SelectionColor = Color.Green
    151. End If
    153. If Kommentarzeichen2 <> 0 Then
    154. Me.SelectionStart = (lStart + Kommentarzeichen2 - 1)
    155. Me.SelectionLength = (LineKommentar.Length - Kommentarzeichen2 + 1)
    156. Me.SelectionColor = Color.Green
    157. End If
    159. If Kommentarzeichen1 = 1 Then
    160. Me.SelectionStart = SelectionAt
    161. Me.SelectionLength = 0
    162. LockWindowUpdate(0)
    163. Exit Sub
    164. End If
    166. If Kommentarzeichen1 = 1 Then
    167. Me.SelectionStart = SelectionAt
    168. Me.SelectionLength = 0
    169. LockWindowUpdate(0)
    170. Exit Sub
    171. End If
    173. 'Position suchen
    174. Me.SelectionStart = SelectionAt
    175. Me.SelectionLength = 0
    176. Me.SelectionColor = Color.Black
    178. 'Update freigeben
    179. LockWindowUpdate(0)
    180. End Sub
    182. Public Function GetCharFromLineIndex(ByVal LineIndex As Integer) As Integer
    183. Return SendMessage(Me.Handle, EditMessages.LineIndex, LineIndex, 0)
    184. End Function
    186. Public Function FirstVisibleLine() As Integer
    187. Return SendMessage(Me.Handle, EditMessages.GetFirstVisibleLine, 0, 0)
    188. End Function
    190. Public Function LastVisibleLine() As Integer
    191. Dim LastLine As Integer = FirstVisibleLine() + (Me.Height / Me.Font.Height)
    193. If LastLine > Me.Lines.Length Or LastLine = 0 Then
    194. LastLine = Me.Lines.Length
    195. End If
    197. Return LastLine
    198. End Function
    200. Public Property CaseSensitive() As Boolean
    201. Get
    202. Return _SyntaxHighlight_CaseSensitive
    203. End Get
    204. Set(ByVal Value As Boolean)
    205. _SyntaxHighlight_CaseSensitive = Value
    206. End Set
    207. End Property
    209. End Class


    Wie gesagt diese Syntax RTB soll schnell laufen (Real time ohne zeitverzug) :)
    Danke im Voraus

    ...
    Keine dumme Kommentare!

    ~Revolt~ schrieb:

    dll = :thumbdown:

    Dann solltest Du zunächst Deine Meinung ändern und dann wieder im Forum nachfragen.
    Falls Du diesen Code kopierst, achte auf die C&P-Bremse.
    Jede einzelne Zeile Deines Programms, die Du nicht explizit getestet hast, ist falsch :!:
    Ein guter .NET-Snippetkonverter (der ist verfügbar).
    Programmierfragen über PN / Konversation werden ignoriert!

    Hier meine Lösung^^

    VB.NET-Quellcode

    1. Imports System.Text.RegularExpressions
    3. Public Class SyntaxRTB
    4. Inherits System.Windows.Forms.RichTextBox
    6. #Region "Dateien"
    8. Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
    9. Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWnd As Integer) As Integer
    10. Private _SyntaxHighlight_CaseSensitive As Boolean = False
    11. Private Words As New DataTable
    12. Dim MyRow As DataRow
    13. Dim Kommentarzeichen1, Kommentarzeichen2 As Integer
    14. Dim Stringzeichen As Integer
    16. #End Region
    18. #Region "Windows API"
    20. Private Enum EditMessages
    21. LineIndex = 187
    22. LineFromChar = 201
    23. GetFirstVisibleLine = 206
    24. CharFromPos = 215
    25. PosFromChar = 1062
    26. End Enum
    28. #End Region
    30. #Region "Textchange-Event"
    32. Protected Overrides Sub OnTextChanged(ByVal e As System.EventArgs)
    33. ColorVisibleLines()
    34. End Sub
    36. #End Region
    38. #Region "Syntax Loader"
    40. Public Sub New()
    41. 'Wordloader Hier wird ein kleine Datenbank erstellt :P
    42. Words.Columns.Add("Word")
    43. Words.PrimaryKey = New DataColumn() {Words.Columns(0)}
    44. Words.Columns.Add("Color")
    45. 'Erste Syntaxreihe (Farbe blau)
    46. Dim Wordsblue() As String, KWblue As String
    47. Wordsblue = New String() {"Imports", "Module", "End", "Main", "Sub"}
    48. For Each KWblue In Wordsblue
    49. MyRow = Words.NewRow()
    50. MyRow("Word") = KWblue
    51. MyRow("Color") = Color.Blue.Name
    52. Words.Rows.Add(MyRow)
    53. Next
    54. 'Zweite Syntaxreihe (Farbe cyan)
    55. Dim Wordscyan() As String, KWcyan As String
    56. Wordscyan = New String() {"Program1", "App", "Main()", "Cmd"}
    57. For Each KWcyan In Wordscyan
    58. MyRow = Words.NewRow()
    59. MyRow("Word") = KWcyan
    60. MyRow("Color") = Color.DarkCyan.Name
    61. Words.Rows.Add(MyRow)
    62. Next
    63. End Sub
    65. #End Region
    67. #Region "Textcontroller"
    69. Public Sub ColorVisibleLines()
    70. Dim FirstLine As Integer = FirstVisibleLine()
    71. Dim LastLine As Integer = LastVisibleLine()
    72. Dim FirstVisibleChar As Integer
    73. Dim i As Integer = FirstLine
    74. 'Textkontroller (Falls Text vorhanden -> Färben sonst -> nichts)
    75. If (FirstLine = 0) And (LastLine = 0) Then
    76. Exit Sub
    77. Else
    78. While i < LastLine
    79. FirstVisibleChar = GetCharFromLineIndex(FirstLine)
    80. ColorLineNumber(FirstLine, FirstVisibleChar)
    81. FirstLine += 1
    82. i += 1
    83. End While
    84. End If
    85. End Sub
    87. #End Region
    89. Public Sub ColorLineNumber(ByVal LineIndex As Integer, ByVal lStart As Integer)
    90. Dim SelectionAt As Integer = Me.SelectionStart
    91. Dim Line() As String, MyI As Integer, MyStr As String
    93. 'Update verhindern
    94. LockWindowUpdate(Me.Handle.ToInt32)
    96. MyI = lStart
    98. If CaseSensitive Then 'Zeichen werden hier gesplittert (z. B. Main_Text statt Main_Text)
    99. Line = Split(Me.Lines(LineIndex).ToString, "_")
    100. Else
    101. Line = Split(Me.Lines(LineIndex).ToLower, "_")
    102. End If
    104. For Each MyStr In Line
    105. Me.SelectionStart = MyI
    106. Me.SelectionLength = MyStr.Length
    108. If Words.Rows.Contains(MyStr) Then
    109. MyRow = Words.Rows.Find(MyStr)
    110. If (Not CaseSensitive) Or (CaseSensitive And MyRow("Word") = MyStr) Then
    111. Me.SelectionColor = Color.FromName(MyRow("Color"))
    112. End If
    113. Else
    114. Me.SelectionColor = Color.Black
    115. End If
    117. MyI += MyStr.Length + 1
    118. Next
    120. 'Kommentarsyntaxerkenner
    121. Dim LineKommentar As String = Me.Lines(LineIndex).ToLower
    122. 'Kommentarzeichen
    123. Kommentarzeichen1 = InStr(LineKommentar, "'")
    124. Kommentarzeichen2 = InStr(LineKommentar, "//")
    125. If Kommentarzeichen1 <> 0 Then
    126. Me.SelectionStart = (lStart + Kommentarzeichen1 - 1)
    127. Me.SelectionLength = (LineKommentar.Length - Kommentarzeichen1 + 1)
    128. Me.SelectionColor = Color.Green
    129. End If
    131. If Kommentarzeichen2 <> 0 Then
    132. Me.SelectionStart = (lStart + Kommentarzeichen2 - 1)
    133. Me.SelectionLength = (LineKommentar.Length - Kommentarzeichen2 + 1)
    134. Me.SelectionColor = Color.Green
    135. End If
    137. 'Position suchen
    138. Me.SelectionStart = SelectionAt
    139. Me.SelectionLength = 0
    140. Me.SelectionColor = Color.Black
    142. 'Update freigeben
    143. LockWindowUpdate(0)
    144. End Sub
    146. Public Function GetCharFromLineIndex(ByVal LineIndex As Integer) As Integer
    147. Return SendMessage(Me.Handle, EditMessages.LineIndex, LineIndex, 0)
    148. End Function
    150. Public Function FirstVisibleLine() As Integer
    151. Return SendMessage(Me.Handle, EditMessages.GetFirstVisibleLine, 0, 0)
    152. End Function
    154. Public Function LastVisibleLine() As Integer
    155. Dim LastLine As Integer = FirstVisibleLine() + (Me.Height / Me.Font.Height)
    157. If LastLine > Me.Lines.Length Or LastLine = 0 Then
    158. LastLine = Me.Lines.Length
    159. End If
    161. Return LastLine
    162. End Function
    164. Public Property CaseSensitive() As Boolean
    165. Get
    166. Return _SyntaxHighlight_CaseSensitive
    167. End Get
    168. Set(ByVal Value As Boolean)
    169. _SyntaxHighlight_CaseSensitive = Value
    170. End Set
    171. End Property
    173. End Class


    Kleines Problem: Ich kann nur z. B Imports_System und nicht Imports.System da split nur ein Zeichen "wegsplittert" aber der Code ist perfekt
    wenn man unter Split(Me.Lines(LineIndex).ToString, "_") zu Split(Me.Lines(LineIndex).ToString, ".") ändert kann man es gut für VB.net verwenden^^ (Ausser strings und chars leider :/) <-daran wird gearbeitet

    VB.NET-Quellcode

    1. If CaseSensitive Then 'Zeichen werden hier gesplittert (z. B. Main_Text statt Main_Text)
    2. Line = Split(Me.Lines(LineIndex).ToString, ".")
    3. Else
    4. Line = Split(Me.Lines(LineIndex).ToLower, ".")
    5. End If

    Bedanken bitte