Qredit Inc

'File source from Holyguard.net
TYPE QREdit EXTENDS QRichEdit
  RichFont AS QFont
  Syntaxes(100) AS STRING       '-- Better way could be to use a ListBox
  MaxSyntax AS INTEGER
  HiLightColor AS INTEGER
  ComentColor AS INTEGER

  SUB HiLight
  '-- HiLight first time, call this whenever you insert line(s), or you
  '-- load a file.

    DIM TempStart AS INTEGER
    DIM I AS INTEGER, N AS INTEGER

    WITH QREdit
      TempStart = .SelStart
      .SelStart = 0
      .SelLength = LEN(.Text)
      .SelAttributes = .RichFont
      FOR I = 1 TO .MaxSyntax
        N = INSTR(UCASE$(.Text), UCASE$(.Syntaxes(I)))-1
        WHILE N >= 0
          .SelStart = N
          .RichFont.Color = .HiLightColor
         ' .RichFont.AddStyles(fsBold)
          .SelLength = LEN(.Syntaxes(I))
          .SelAttributes = .RichFont
           N = INSTR(N+.SelLength, UCASE$(.Text), UCASE$(QREdit.Syntaxes(I)))-1
        WEND
        .SelLength = 0
        .RichFont.Color = 0
        .Font = .RichFont
        .SelStart = TempStart
      NEXT I

      TempStart = .SelStart
      .SelStart = 0
      N = INSTR(.Text, "'")
      WHILE N > 0
        .SelStart = N - 1
        '.RichFont.AddStyles(fsItalic)
        .RichFont.Color = .ComentColor
        .SelLength = INSTR( N , .Text, Chr$(10)) - N
        .SelAttributes = .RichFont
        N = INSTR(N + 1, .Text,"'")
      WEND
      .SelLength = 0
      '.RichFont.DelStyles(fsItalic)
      .RichFont.Color = 0
      .Font = .RichFont
      .SelStart = TempStart

    END WITH
  END SUB

  SUBI AddSyntaxes(...)
    DIM I AS INTEGER

    WITH QREdit
      FOR I = 1 TO ParamStrCount
        .Syntaxes(I+.MaxSyntax) = ParamStr$(I)
      NEXT
      .MaxSyntax = .MaxSyntax + ParamStrCount
    END WITH
  END SUBI

  EVENT OnKeyUp (Key AS WORD, Shift AS INTEGER)
    '' Don't want to re-hilight everything, try to isolate a keyword
    '' If you type too fast, this event might be skipped :)
    '' Also beware when the user splits up two words with a space,
    '' that condition isn't handled here.

    DIM I AS INTEGER, EndStr AS INTEGER, StartStr AS INTEGER
    DIM TempStart AS INTEGER, N AS INTEGER
    DIM Token AS STRING
    DIM T1 AS INTEGER, T2 AS INTEGER

    T1 = QREdit.SelStart
    T2 = QREdit.SelLength

    IF Key < 46 AND Key <> 8 THEN     '' Ignore arrows, pageup/down, etc.
      EXIT EVENT
    END IF

    WITH QREdit
      '' Isolate a token, separated by a space (but that's not always the case)
      FOR I = .SelStart TO LEN(.Text)
        IF MID$(.Text, I, 1) = " " OR MID$(.Text, I, 1) = CHR$(13) OR MID$(.Text, I, 1) = CHR$(10) THEN
          EXIT FOR
        END IF
      NEXT I
      EndStr = I
      FOR I = .SelStart TO 1 STEP -1
        IF MID$(.Text, I, 1) = " " OR MID$(.Text, I, 1) = CHR$(10) OR MID$(.Text, I, 1) = CHR$(13) THEN
          EXIT FOR
        END IF
      NEXT I
      StartStr = I+1
      Token = RTRIM$(LTRIM$(MID$(.Text, StartStr, EndStr - StartStr)))

      TempStart = .SelStart
      .SelStart = StartStr-1
      .SelLength = LEN(Token)
      .SelAttributes = .RichFont
      FOR I = 1 TO .MaxSyntax
        IF UCASE$(Token) = UCASE$(.Syntaxes(I)) THEN
          .SelStart = StartStr-1
        '  .RichFont.AddStyles(fsBold)
          .RichFont.Color = .HiLightColor
          .SelLength = LEN(.Syntaxes(I))
          .SelAttributes = .RichFont
        END IF
      NEXT I
      .SelLength = 0
      .SelStart = TempStart
     ' .RichFont.DelStyles(fsBold)
      .RichFont.Color = 0
      .Font = .RichFont
    END WITH

    QREdit.SelStart = T1
    QREdit.SelLength= T2
  END EVENT

  CONSTRUCTOR
   ' PlainText = True
    RichFont.Name = "Courier"
    MaxSyntax = 0
    HiLightColor = &HAA0000
    ComentColor = &H00AA00
    Font = QREdit.RichFont
  END CONSTRUCTOR
END TYPE