Intellisense w/Syntax Highlighting

Category: Controls - RichEdit

Date: 03-28-2012

Return to Index


 
'One of the more useful features of a modern day editor is the ability to give
'the users suggestions/options for the text they are about to type - syntax
'information, function arguments, and member information.  This is called
'Intellisense by Microsoft.
 
'An additional feature would be simply 'word completion', where the editor provides
'suggested spelling/text for completing a started word - essentially an automatic
'letter-by-letter spell-check with suggestions for completing the word being typed.
 
'This snippet deals with Intellisense, where the suggestions are for what follows
'a word that has just been typed.
 
'Primary Code:
'For length reasons, the primary code is given only once in the compilable example
'below. But a general description of the process is provided here.
 
'As each letter is typed the letters to the left are scanned for the presence of up
'to 3 words, corresponding to the maximum number of words in a multipleword
'PowerBASIC statement.
 
'However, the scanning only takes place when the character to the left of the cursor
'is one of several marker characters - a space, open parenthesis, period, or close
'parenthesis. These four characters mark the possible start/end of a PowerBASIC
'word or phrase that Intellisense will recognize. The presence of any other character
'closes any visible Intellisense display of information.
 
'When a marker charater is found and the (up to) 3 words to the left are scanned,
'a prioritized list of 5 searches is made to determine if the words are found in
'the Intellisense libraries.
 
'There are two types of words/phrases - those that will simply be followed by a
'list of arguments (the 'syntax') or those which will be followed by optional members.
'The 5 libraries are:
'   - single word Keywords             - single word Keywords with Members
'   - dual word Keyword phrases        - dual word Keyword phrases with Members
'   - triple word Keyword phrases
 
'These correspond to the PowerBASIC statements, which consist of 1-3 keywords that
'preceed an argument list or 1-2 keywords which preceed member options.
 
'If a word/phrase is found that supports trailing arguments (syntax), the argument list
'is presented in a small label just below the cursor.
 
'If a word/phrase is found that supports trailing members, the member list is presented
'in a listbox just below the cursor.
 
'When a word/phrase with members is found, the members are displayed in a popup
'listobx.  If the word/phrase has syntax, the syntax is shown in a popup label.
 
'With an Intellisense listbox or label shown, the user may use the following keys to
'take action.
'    ESC    -  hide the label/listbox
'    TAB    -  insert the argument list or selected member at the cursor
'    ENTER  - insert the argument list or selected member and move cursor to a new line
 
'In addition to the code in the callback and subclassed window procedures, there are
'several different subroutines which combine to provide the Intellisense features. The
'list of procedures is shown below.
 
'The Intellisense implementation in the compilable example below has the
'following limitations, which may be different than some implementations of
'Intellisense available in other editors.
 
'1. Dim x as MyType
'This snippet cannot automatically (at run time) determine MyType members
'unless they have been manually placed in the reference files.  Variables
'dimensioned as structure types are not recognized, i.e., popup member lists
'are not presented.
 
'2. ListBox
'Once the listbox is displayed, a selection must be mode by pressing
'TAB or Enter,  or else the ESC can be used to removed the listbox from view.
'Pressing letter keys will select an item from the list but the typed letters
'will not appear in the edit control.
 
'3. Argument Highlighting
'As arguments to a keyword/phrase are typed, Microsoft Intellisense changes
'the content of the popup syntax label - bolding the argument currently being
'typed.  The snippet below do not provide the bolding feature.
 
'Here are the primary procedures of the syntax highlighting code
'Credit: Borje Hagsten
'1. RichEdit control           - allows character size/font/color formatting
'2  Sub synInitilaize RWords   - uses DATA statements to create upper/lower/mixed keyword arrays
'3. Subclassed RichEdit        - to capture %WM_KeyUp
'4. Sub synApplySyntax         - calls TurnOffColor, ScanLine, handles mouse pointer
'5. Sub TurnOffColor           - sets entire control to black & white (a fast of erase syntax highlighting)
'6. Sub ScanLine               - primary parsers that identifies keywords, strings, comments
'7. Function setRichTextColor  - sets color of selection (keywords, strings, comments)
'8. Sub SetFont                - picks an easy to read font (Comic Sans MS)
 
'Here are the primary procedures of the Intellisense code
'1. Intellisense             -coordinates all of the other routines
'2. CharToLeftOfCursor       -returns the single character to the left of the cursor
'3. TestLeftChar             -takes action depending on what CharToLeftOfCursor Returns
'4. WordsToLeft              -returns the (up to) 3 words preceeding the cursor
'5. CloseIntellisense        -hide label/listbox, reset all flags
'6. InsertText               -place the label/listbox text into the RichEdit control
'7. LoadRef                  -loads the reference files
'8. BinaryRefSearch          -common routine to search all 5 reference files
'9. Modify Syntax            -modifies how syntax is displayed, depending on context of user input
'10. DisplaySyntaxLabel      -shows argument list (syntax) for the preceeding 1-3 words/phrase
'11. DisplaySyntaxListBox    -shows available Members for the preceeding 1-2 words/phrase
'12. NewListBoxProc          -detexts pressing RETURN, ESC, and TAB keys in ListBox
'13. NewRichEditProc         -detects pressing RETURN key in RichEdit control
 
'In addition to the source code below, the following text data files are required.
'Just put these files into the same folder as the EXE. These are now included as
'part of the gbSnippets distribution.
 
'  http://www.garybeene.com/files/word3_short.txt
'  http://www.garybeene.com/files/word2_short.txt
'  http://www.garybeene.com/files/word1_short.txt
'  http://www.garybeene.com/files/members1.txt
'  http://www.garybeene.com/files/members2.txt
'  http://www.garybeene.com/files/powerbasic.syn
 
'Compiler Comments:
'This code is written to compile with PBWin10. To compile with PBWin9,
'add this line:
#Include "CommCtrl.inc"
 
'Compilable Example:
#Compiler PBWin 10
#Compile EXE
#Dim All
#Include "win32api.inc
#Include "richedit.inc"
Global LWords() As String, UWords() As String, MWords() As String
 
Global hRichEdit As DWord, hDlg As DWord, OrigRichEditProc&, CodeCase&
Global Ref_MemTerm1() As String,  Ref_MemMember1() As String
Global Ref_MemTerm2() As String,  Ref_MemMember2() As String
Global Ref_Term1() As String, Ref_Desc1() As String, Ref_Syntax1() As String
Global Ref_Term2() As String, Ref_Desc2() As String, Ref_Syntax2() As String
Global Ref_Term3() As String, Ref_Desc3() As String, Ref_Syntax3() As String
Global hDlg as DWord, hRichEdit as DWord, LabelVisible&, ListBoxVisible&, hListBox As DWord
Global OldListBoxProc&, PI As CharRange, OldRichEditProc&, CancelIntellisense&, cp as Long
%ID_RichEdit = 501 : %ID_Label = 502 : %ID_ListBox = 503 : %ID_Button = 504 : %ID_Button2 = 505
 
Function PBMain() As Long
   'create some sample content for the RichEdit control
   Dim Content$
   Content$ = "Function Example" + $CrLf + "Select Case MyVar" + $CrLf + "Case 12 '1st case" + $CrLf + "End Select" + $CrLf + "End Function"
   Content$ = Content$ + $CrLf + "For i = 1 to 10" + $CrLf + "Incr i" + $CrLf + "Next i"
   Content$ = Content$ + $CrLf + "If x = 2 Then" + $CrLf + "'do nothing" + $CrLf + "End If"
   Dialog New Pixels, 0, "Syntax Test",300,300,300,400, %WS_OverlappedWindow To hDlg
   Dim Ref_Term1(0), Ref_Desc1(0), Ref_Syntax1(0)
   Dim Ref_Term2(0), Ref_Desc2(0), Ref_Syntax2(0)
   Dim Ref_Term3(0), Ref_Desc3(0), Ref_Syntax3(0)
   Dim Ref_MemTerm1(0), Ref_MemMember1(0)
   Dim Ref_MemTerm2(0), Ref_MemMember2(0)
   LoadRef "word1_short.txt", Ref_Term1(), Ref_Syntax1()
   LoadRef "word2_short.txt", Ref_Term2(), Ref_Syntax2()
   LoadRef "word3_short.txt", Ref_Term3(), Ref_Syntax3()
   LoadRef "members1.txt", Ref_memTerm1(), Ref_memMember1()
   LoadRef "members2.txt", Ref_memTerm2(), Ref_memMember2()
   cp = 1
 
   'create RichEdit and subclass (to intercept %WM_KeyUp actions)
   LoadLibrary("riched32.dll")
   InitCommonControls
   Control Add Option, hDlg, 201, "Upper", 10, 10, 50, 20
   Control Add Option, hDlg, 202, "Lower", 90, 10, 50, 20
   Control Add Option, hDlg, 203, "Mixed", 170, 10, 50, 20
   Control Add "RichEdit", hDlg, %ID_RichEdit, Content$, 10, 40, 150, 100, _
      %WS_Child Or %WS_Visible Or %ES_MultiLine Or %WS_VScroll Or %ES_AutoHScroll _
      Or %WS_HScroll Or %ES_AutoVScroll Or %ES_WantReturn Or %ES_NoHideSel, _
      %WS_Ex_ClientEdge
   Control Handle hDlg, %ID_RichEdit To hRichEdit
   SetFont
   OrigRichEditProc& = SetWindowLong(GetDlgItem(hDlg, %ID_RichEdit), %GWL_WndProc, CodePTR(NewRichEditProc))
   SendMessage hRichEdit, %EM_SETEVENTMASK, 0, %ENM_SELCHANGE Or %ENM_CHANGE Or %ENM_Link Or %ENM_KeyEvents
 
   Control Add Label, hDlg, %ID_Label, "tooltip",60,60,100,15, %WS_Border
   Control Set Color hDlg, %ID_Label, %Black, %RGB_LightYellow
   Control Add ListBox, hDlg, %ID_ListBox, ,60,60,100,100, %WS_Border
   Control Handle hDlg, %ID_ListBox To hListBox
 
   Dialog Show Modal hDlg Call DlgProc
End Function
 
CallBack Function DlgProc() As Long
   Local P as CharRange
   Select Case CB.Msg
      Case %WM_InitDialog
         CodeCase& = 1        'upper lower mixed
         Control Set Option hDlg, 201, 201, 203
         synInitializeRWords
         synApplySyntax
         OldListBoxProc& = SetWindowLong(GetDlgItem(hDlg, %ID_ListBox), %GWL_WndProc, CodePTR(NewListBoxProc))
         CloseIntellisense
      Case %WM_Size
         Dim w As Long, h As Long
         Dialog Get Client CB.Hndl To w,h
         Control Set Size CB.Hndl, %ID_RichEdit, w-20, h-20
      Case %WM_NEXTDLGCTL
         Select Case GetFocus
            Case hRichEdit        'captures TAB in RichEdit
               If LabelVisible& Or ListBoxVisible& Then
                  InsertText : Function = 1 : Exit Function
               End If
         End Select
      Case %WM_Notify
         Select Case CB.NmID
            Case %ID_RichEdit
               Select Case CB.Nmcode
                  Case %EN_SelChange
                     TestLeftChar
               End Select
         End Select
      Case %WM_Command
         Select Case CB.Ctl
            Case 201 : CodeCase& = 1 : synApplySyntax
            Case 202 : CodeCase& = 2 : synApplySyntax
            Case 203 : CodeCase& = 3 : synApplySyntax
            Case %ID_RichEdit
               Select Case CB.Ctlmsg
                  Case %EN_SetFocus
                     P.cpmin = 0 : P.cpmax = 0 : SendMessage hRichedit, %EM_EXSETSEL, 0, VarPTR(P)   'highlight none
               End Select
            Case 100
               If CB.Ctlmsg = %BN_Clicked Then
                  Local iResult1&, iResult2&
                  TurnOffCol
                  ScanLine(0, SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
               End If
            Case %IdCancel    'pressing Escape
               Select Case GetFocus    'gets the control which has the focus
                  Case hRichEdit : If LabelVisible& Or ListBoxVisible& Then CloseIntellisense  'ESC pressed in RichEdit
               End Select
         End Select
   End Select
End Function
 
Function NewRichEditProc(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case wMsg
      Case %WM_KeyUp         'trap key up, for syntax color check while editing
         Local CurLine As Long
         CurLine = SendMessage(hRichEdit, %EM_EXLINEFROMCHAR, 0, -1)
         ScanLine(CurLine, CurLine)               'check current line only
         Dialog Redraw hDlg
         Function = 0 : Exit Function                  'return zero
      Case %WM_KeyDown
         Select Case wParam
            Case %VK_Return
               If LabelVisible& Or ListBoxVisible& Then InsertText   'allow to continue processing
         End Select
   End Select
   NewRichEditProc = CallWindowProc(OrigRichEditProc&, hWnd, wMsg, wParamlParam)
End Function
 
Sub synApplySyntax()
   MousePTR 11                   'Scan all lines
   TurnOffCol
   ScanLine(0, SendMessage(hRichEdit, %EM_GETLINECOUNT, 0, 0) - 1)
   MousePTR 0
   SetFocus hRichEdit
End Sub
 
Sub synInitializeRWords
   Local temp$, i As Long
   ReDim UWords(1000), LWords(1000), MWords(1000)
   'read the language file
   Open Exe.Path$ + "powerbasic.synFor Input As #1
   While IsFalse Eof(1)
      Line Input #1, temp$
      If Len(Trim$(temp$)) Then
         MWords(i) = temp$
         UWords(i) = UCase$(MWords(i))
         LWords(i) = LCase$(MWords(i))
         Incr i
      End If
   Wend
   Close #1
   ReDim Preserve UWords(i-1), LWords(i-1), MWords(i-1)
End Sub
 
Function setRichTextColor( ByVal NewColor As LongAs Long
   ' setRichTextColor sets the textcolor for selected text in a Richedit control.
   ' &HFF - read, &HFF0000 - blue, &H008000 - dark green, &H0 is black, etc.
   Local cf As CHARFORMAT
   cf.cbSize      = Len(cf)       'Length of structure
   cf.dwMask      = %CFM_COLOR    'Set mask to colors only
   cf.crTextColor = NewColor      'Set the new color value
   SendMessage(hRichEdit, %EM_SETCHARFORMAT, %SCF_SELECTION, VarPTR(cf))
End Function
 
Sub TurnOffCol
   ' Set all text to black - faster this way
   Local cf As CHARFORMAT, xEvent As Long
   xEvent = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)         'Get eventmask
   SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)            'Disable eventmask
   MousePTR 11                                                'Hourglass
   cf.cbSize      = Len(cf)                                   'Length of structure
   cf.dwMask      = %CFM_COLOR                                'Set mask to colors only
   cf.crTextColor = &H0                                       'Set black color value
   SendMessage(hRichEdit, %EM_SETCHARFORMAT, -1, VarPTR(cf)) '%SCF_ALL = -1
   If xEvent Then
      SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvent)     'Enable eventmask
   End If                                                     'Arrow
   MousePTR 0
   SendMessage(hRichEdit, %EM_SETMODIFY, %FALSE, 0)          'reset modify flag
End Sub
 
Sub ScanLine(ByVal Line1 As Long, ByVal Line2 As Long)
   ' Syntax color parser for received line numbers
   Local pd As CHARRANGE, Oldpd As CHARRANGE, tBuff As TEXTRANGE
   Local xWord As String, Buf As String
   Local Aspect As Long, xEvents As Long, I As Long , J As Long, stopPos As Long
   Local lnLen As Long, Result As Long, wFlag As Byte, Letter As Byte Ptr
 
   SendMessage(hRichEdit, %EM_EXGETSEL, 0, VarPTR(Oldpd)) 'Original position
   '(so we can reset it later)
   'Disable the event mask, for better speed
   xEvents = SendMessage(hRichEdit, %EM_GETEVENTMASK, 0, 0)
   SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, 0)
 
   'Turn off redraw for faster and smoother action
   SendMessage(hRichEdit, %WM_SETREDRAW, 0, 0)
 
   If Line1 <> Line2 Then                                  'if multiple lines
      MousePTR 11
   Else                                                                     'editing a line
      pd.cpMin = SendMessage(hRichEdit, %EM_LINEINDEX, Line1, 0)                'line start
      pd.cpMax = pd.cpMin + SendMessage(hRichEdit, %EM_LINELENGTH, pd.cpMin, 0) 'line end
      SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))                  'select line
      setRichTextColor &H0                                             'set black
   End If
 
   For J = Line1 To Line2
      Aspect = SendMessage(hRichEdit, %EM_LINEINDEX, J, 0)       'line start
      lnLen  = SendMessage(hRichEdit, %EM_LINELENGTH, Aspect, 0) 'line length
 
      If lnLen Then
         Buf = Space$(lnLen + 1)
         tBuff.chrg.cpMin = Aspect
         tBuff.chrg.cpMax = Aspect + lnLen
         tBuff.lpstrText = StrPTR(Buf)
         lnLen = SendMessage(hRichEdit, %EM_GETTEXTRANGE, 0, ByVal VarPTR(tBuff)) 'Get line
 
         CharUpperBuff(ByVal StrPTR(Buf), lnLen)        'Make UCASE
         'I always use this one, since it handles characters > ASC(127) as well.. ;-)
 
         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         ' Loop through the line, using a pointer for better speed
         '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
         Letter = StrPTR(Buf) : wFlag = 0
         For I = 1 To Len(Buf)
            Select Case @Letter 'The characters we need to inlude in a word
               Case 97 To 122, 65 To 90, 192 To 214, 216 To 246, 248 To 255, _
                     35 To 38, 48 To 57, 63, 95
                  If wFlag = 0 Then
                     wFlag = 1 : stopPos = I
                  End If
 
               Case 34 ' string quotes -> "
                  stopPos = Instr(I + 1, Buf, Chr$(34)) 'Find match
                  If stopPos Then
                     pd.cpMin = Aspect + I
                     pd.cpMax = Aspect + stopPos - 1
                     SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                     setRichTextColor &HFF
                     StopPos = (StopPos - I + 1)
                     I = I + StopPos
                     Letter = Letter + StopPos
                     wFlag = 0
                  End If
 
               Case 39 ' uncomment character -> '
                  pd.cpMin = Aspect + I - 1
                  pd.cpMax = Aspect + lnLen
                  SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                  setRichTextColor &H00008000&
                  wFlag = 0
                  Exit For
 
               Case Else  'word is ready
                  If wFlag = 1 Then
                     xWord = Mid$(Buf, stopPos, I - stopPos)  'Get word
 
                     If xWord = "REMThen  'extra for the uncomment word, REM
                        pd.cpMin = Aspect + I - Len(xWord) - 1
                        pd.cpMax = Aspect + lnLen
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        setRichTextColor &H00008000&
                        wFlag = 0
                        Exit For
                     End If
                     Array Scan UWords(0), = xWord, To Result  'Is it in the array?
                     If Result Then
                        pd.cpMin = Aspect + stopPos - 1
                        pd.cpMax = Aspect + I - 1
                        '---------------------------------upper/lower/mixed handled here-----------
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        If CodeCase& Then
                           xWord = Choose$(CodeCase&, UWords(Result-1), LWords(Result-1), MWords(Result-1))
                           Control Send hDlg, %ID_RichEdit, %EM_ReplaceSel, %True, StrPTR(xWord)
                        End If
                        '----------------------------------------------------------------------
                        SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(pd))
                        setRichTextColor(&HFF0000)       'set blue color
                     End If
                     wFlag = 0
                  End If
            End Select
 
            Incr Letter
         Next I
      End If
   Next J
 
   'Reset original caret position
   SendMessage(hRichEdit, %EM_EXSETSEL, 0, VarPTR(Oldpd))
 
   'Turn on Redraw again and refresh - this one causes some flicker in Richedit..
   SendMessage hRichEdit, %WM_SETREDRAW, 1, 0
   InvalidateRect hRichEdit, ByVal %NULL, 0 : UpdateWindow hRichEdit
 
   'Reset the event mask
   If xEvents Then SendMessage(hRichEdit, %EM_SETEVENTMASK, 0, xEvents)
End Sub
 
Sub SetFont
   Dim hFont As DWord
   Font New "Comic Sans MS", 10, 1 To hFont
   Control Set Font hDlg, %ID_RichEdit, hFont
End Sub
 
Sub TestLeftChar
   Local temp$
   temp$ = CharToLeftOfCursor
   If temp$ = $spc Then
      Intellisense $spc
   ElseIf temp$ = "(Then
      Intellisense "("
   ElseIf temp$ = ")Then
      If LabelVisible& Or ListBoxVisible& Then CloseIntellisense
   ElseIf temp$ = ".Then
      Intellisense "."
   Else
      CloseIntellisense
   End If
End Sub
 
Function CharToLeftOfCursor() As String
   Local P As CharRange, buf$, T as TextRange
   SendMessage(hRichEdit, %EM_EXGetSel, 0, VarPTR(P))                     'caret position
   T.Chrg.cpmin = P.cpmin-1 : T.Chrg.cpmax = P.cpmax : buf$ = " "
   T.lpstrText = StrPTR(Buf$)
   SendMessage hRichEdit, %EM_GetTextRange, ByVal 0, VarPTR(T)  'get text, specified char range or from selection
   Function = buf$
End Function
 
Function WordsToLeft(w3$, w2$, w1$) As Long
   Local iLine As Long, buf$, iStartPos&, iLineLength&, P As CharRange, iLeft&, iCount&
   SendMessage(hRichEdit, %EM_EXGetSel, 0, VarPTR(P))                     'caret position
   Decr p.cpmin
   iLine = SendMessage(hRichEdit, %EM_ExLineFromChar, 0, -1)              'current line#
   iStartPos& = SendMessage(hRichEdit, %EM_LineIndex, iLine, 0)            'position of 1st char in current line
   iLineLength& = SendMessage(hRichEdit, %EM_LineLength, iStartPos&, 0)   'length of specified line
   buf$ = Space$(iLineLength&)
   SendMessage(hRichEdit, %EM_GetLine, iLine, StrPTR(buf$))    'text of current line
   w3$ = Mid$(buf$,1,P.cpmin-iStartPos&)                          'text to left of caret
   w3$ = Retain$(w3$, Any Chr$(65 to 90, 97 to 122, 48 to 57, $Spc, "$&#%?!"))
   iCount& = ParseCount(w3$, " ")
   w1$ = Parse$(w3$," ",iCount&)
   w2$ = Parse$(w3$," ",iCount&-1)
   w3$ = Parse$(w3$," ",iCount&-2)
End Function
 
Sub Intellisense(sChar$)
   If CancelIntellisense& Then Exit Sub
 
   Local sWord$, sSyntax$, iReturn&, w3$, w2$, w1$
   SendMessage(hRichEdit, %EM_EXGetSel, 0, VarPTR(PI))                     'caret position at start of intellisense
   WordsToLeft(w3$, w2$, w1$)
 
   If Len(w3$) AND BinaryReferenceSearch(Build$(w3$,$spc,w2$,$spc,w1$), iReturn&, Ref_Term3(), Ref_Syntax3()) Then
      '3 word sequence was found
      sWord$ = Build$(w3$,$spc,w2$,$spc,w1$)
      sSyntax$ = Ref_Syntax3(iReturn&)
      DisplaySyntaxLabel (sSyntax$)
   ElseIf Len(w2$) AND BinaryReferenceSearch(Build$(w2$,$spc,w1$), iReturn&, Ref_memTerm2(), Ref_memMember2()) Then
      '2 word sequence was found
      sWord$ = Build$(w2$,$spc,w1$)
      sSyntax$ = Ref_memMember2(iReturn&)
      DisplaySyntaxListbox (sSyntax$)
   ElseIf Len(w2$) AND BinaryReferenceSearch(Build$(w2$,$spc,w1$), iReturn&, Ref_Term2(), Ref_Syntax2()) Then
      '2 word sequence was found
      sWord$ = Build$(w2$,$spc,w1$)
      sSyntax$ = Ref_Syntax2(iReturn&)
      DisplaySyntaxLabel (sSyntax$)
   ElseIf Len(w1$) AND BinaryReferenceSearch(w1$, iReturn&, Ref_memTerm1(), Ref_memMember1()) Then
      '1 word sequence was found
      sWord$ = w1$
      sSyntax$ = Ref_memMember1(iReturn&)
      DisplaySyntaxListBox (sSyntax$)
   ElseIf Len(w1$) AND BinaryReferenceSearch(w1$, iReturn&, Ref_Term1(), Ref_Syntax1()) Then
      '1 word sequence was found
      sWord$ = w1$
      sSyntax$ = ModifySyntax(sChar$, Ref_Syntax1(iReturn&))
      DisplaySyntaxLabel (sSyntax$)
   Else
      'no matches were found
      If LabelVisible& Or ListBoxVisible& Then CloseIntellisense
   End If
End Sub
 
Function ModifySyntax (sChar$, ByVal sSyntax$) As String
   '    If sChar$ = " " AND Left$(sSyntax$,1) = "(" Then             'optional way to skip leading (
   '        sSyntax$ = Mid$(sSyntax$, 2, Len(sSyntax$)-2)
   If sChar$ = "(AND Left$(sSyntax$,1) = "(Then
      sSyntax$ = Mid$(sSyntax$, 2)         'do not allow ((
   ElseIf sChar$ = "(AND Left$(sSyntax$,1) <> "(Then
      sSyntax$ = ""                        'if sChar is (, then sSyntax must also start with (, otherwise, don't show sSyntax
   End If
   Function = sSyntax$
End Function
 
Sub CloseIntellisense
   Control Show State hDlg, %ID_Label, %SW_Hide : LabelVisible& = 0
   Control Show State hDlg, %ID_ListBox, %SW_Hide : ListBoxVisible& = 0
End Sub
 
Sub DisplaySyntaxLabel(sSyntax$)
   Local P as Point
   Control Set Text hDlg, %ID_Label, sSyntax$                      'put sSyntax in Label
   Control Send hDlg, %ID_RichEdit, %EM_PosFromChar, VarPTR(P), PI.cpmin   'get xy coordinates of caret
   Control Set Loc hDlg, %ID_Label, P.x+25, P.y+60                'assign position of label
   Control Set Size hDlg, %ID_Label, Len(sSyntax$)*7,15
   Control Show State hDlg, %ID_Listbox, %SW_Hide : ListBoxVisible& = 0   'hide listbox
   Control Show State hDlg, %ID_Label, %SW_Show : LabelVisible& = 1                'show label
End Sub
 
Sub DisplaySyntaxListBox(sMembers$)
   Local P as Point, i As Long
   ListBox Reset hDlg, %ID_ListBox
   Dim mList(ParseCount(sMembers$,".")-1) As String
   Parse sMembers$,mList(),"."
   For i = 0 to UBound(mList) : ListBox Insert hDlg, %ID_ListBox, 1, mList(i) : Next i
   Control Send hDlg, %ID_RichEdit, %EM_PosFromChar, VarPTR(P), PI.cpmin  'get xy coordinates of caret
   Control Set Loc hDlg, %ID_ListBox, P.x+25, P.y+60                'assign position of label
   Control Show State hDlg, %ID_Label, %SW_Hide : LabelVisible& = 0       'hide label
   Control Show State hDlg, %ID_ListBox, %SW_Show :ListBoxVisible& = 1       'show listbox
   Control Set Focus hDlg, %ID_ListBox
   ListBox Select hDlg, %ID_ListBox, 1
End Sub
 
Function BinaryReferenceSearch(ByVal sWord As String, iArrayPos&, ArrayTerm() As String, ArraySyntax() As StringAs Long
   Local Upper As Long, Lower As Long
   Lower = LBound(ArrayTerm) : Upper = UBound(ArrayTerm) : sWord = LCase$(sWord)
   'test boundary values
   If sWord = ArrayTerm(Lower) Then iArrayPos& = Lower : Function = 1 : Exit Function
   If sWord = ArrayTerm(Upper) Then iArrayPos& = Upper : Function = 1 : Exit Function
   If sWord < ArrayTerm(Lower) Then iArrayPos& = Lower - 1 : Function = 0 : Exit Function
   If sWord > ArrayTerm(Upper) Then iArrayPos& = Upper + 1 : Function = 0 : Exit Function
   'loop through remaining entries until searchterm found, or it's determined that term is not in the array
   Do Until (Upper <= (Lower+1))
      iArrayPos& = (Lower + Upper) / 2
      If sWord > ArrayTerm(iArrayPos&) Then
         Lower = iArrayPos&
      ElseIf sWord < ArrayTerm(iArrayPos&) Then
         Upper = iArrayPos&
      Else
         Function = 1 : Exit Function
      End If
   Loop
End Function
 
Sub LoadRef (sFile$, ArrayTerm() As String, ArraySyntax() As String)
   'load any of the 5 reference files - all use the same content format   sWord:::::sSyntax
   Local temp$, i As Long
   Open sFile$ For Binary as #1 : Get$ #1, Lof(1), temp$ : Close
   temp$ = RTrim$(temp$,$crlf)
   ReDim ArrayTerm(ParseCount(temp$,$crlf)-1) As String, ArraySyntax(UBound(ArrayTerm)) As String
   Parse temp$,ArrayTerm(),$crlf
   For i = 0 to UBound(ArrayTerm)
      ArraySyntax(i) = Parse$(ArrayTerm(i),":::::", 2)
      ArrayTerm(i) = Parse$(ArrayTerm(i),":::::", 1)
   Next i
End Sub
 
Sub InsertText
   Local temp$
   If LabelVisible& Then
      Control Get Text hDlg, %ID_Label To temp$                                 'get text
      temp$ = temp$ + " "
      Control Show State hDlg, %ID_Label, %SW_Hide : LabelVisible& = 0      'hide label
      SendMessage hRichEdit, %EM_ReplaceSel, 0, StrPTR(temp$)                'put text in RichEdit
   ElseIf ListBoxVisible& Then
      CancelIntellisense& = %True
      ListBox Get Text hDlg, %ID_ListBox To temp$                                'get text (selected item)
      temp$ = temp$ + " "
      Control Show State hDlg, %ID_ListBox, %SW_Hide : ListBoxVisible& = 0   'hide ListBox
      SetFocus hRichEdit
      SendMessage hRichEdit, %EM_EXSetSel, 0, VarPTR(PI)                       'set cursor to new position
      SendMessage hRichEdit, %EM_ReplaceSel, 0, StrPTR(temp$)                  'put text in RichEdit
      CancelIntellisense& = %False
   End If
End Sub
 
Function NewListBoxProc(ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As LongAs Long
   Select Case Msg
      Case %WM_GETDLGCODE                 'establish control by the RichEdit
         Function = %DLGC_WANTALLKEYS
         Exit Function
      Case %WM_KeyDown      'WM_Char
         Select Case wParam
            Case %VK_Return
               InsertText                            'richedit will now have focus
               keybd_event %VK_Return, 0, 0, 0   'send return key to hRichEdit
            Case %VK_Escape
               CancelIntellisense& = %True      'avoids firing Intellisense a second time before this loop is over
               CloseIntellisense
               SetFocus hRichEdit
               SendMessage (hRichEdit, %EM_EXSetSel, 0, VarPTR(PI))
               CancelIntellisense& = %False
            Case %VK_Tab
               InsertText
               TestLeftChar               'the inserted text may actually be a keyword itself
         End Select
   End Select
   Function = CallWindowProc(OldListBoxProc&, hWnd, MsgwParamlParam)
End Function
 
'gbs_00404
'Date: 03-10-2012


created by gbSnippets
http://www.garybeene.com/sw/gbsnippets.htm