Date: 02-16-2022
Return to Index
created by gbSnippets
'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: (Jose Includes)
#Compiler PBWin 10
#Compile EXE
#Dim All
%Unicode=1
#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 Long) As 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, wParam, lParam)
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.syn" For 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 Long) As 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 = "REM" Then '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 String) As 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 Long) As 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, Msg, wParam, lParam)
End Function
'gbs_00404
'Date: 03-10-2012
http://www.garybeene.com/sw/gbsnippets.htm