vfp 智能感知拓展应用

*======================================================================================== * * Version: 2010-02Feb-20 * *======================================================================================== * * This program implements partial IntelliSense in VFP 6-9. To enable * IntelliSenseX, simply execute this program at any time when using * Visual FoxPro or put it into your startup program. * * To configure ISX please see the section just below the comment block. * * To stop IntelliSenseX run this program again and pass "QUIT" as a * parameter. Alternatively, you can simply remove the ON KEY LABEL * macros for the ALT+I and the "." key. * * Currently only IntelliSense for variable names is implemented. This * means that whenever you enter "m." in a MODIFY COMMAND window or * in a Method edit window, you get a list of all variables declared * in the current procedure. ISX doesn't parse the entire sourcecode * for memory variables, but only the current procedure or method and * only those variables listed in a LOCAL, PRIVATE, PUBLIC, LPARAMETER * and PARAMETER statement. ALT+I can be used to trigger this list. * * ALT+RIGHTARROW triggers a universal autocomplete function that tries to determine the * type of what you have entered and offers a list of all possible values. * * Please note that I haven't written this program as an excercise for * good coding styles , rather as an excercise to see if * IntelliSense is possible within Visual FoxPro itself. Therefore * you won't find the Assertions you would otherwise find in my code. * *======================================================================================== * * Acknowledgements * * Thanks to George Tasker for his really helpful documentation on the * FoxTools.Fll. You can download his ToolHelp.Hlp file from the * UniversalThread and the CompuServe MSDEVAPP forum. George also made * some suggestions to improve this program. * * Also thanks to Ken Levy, who couldn't implement an inline Intelli- * Sense feature in his SuperCls and thereby convinced me that there * must be a way to do it, even only for the purpose of doing * something that Ken Levy couldn't do. * * Thanks to all the folks that posted me bug reports, especially * Frank Cazabon. Thanks to Gerry Hughes for correcting the typos in * my comments. * * Louis D. Zelus added a nifty feature to my version to make ISX * even more useful. Thanks for that! The code based on his work is * marked with "LDZ:". * * Sietse Wijnkler added a lot of new cool features: He added the * ability to distinguish different types that all are triggered by * a period and the code to display variables, object properties and * field names. Code based on his work is marked with "SW:". * * J黵gen "wOOdy" Wondzinski pointed out that special characters like * "�" are valid variable names and IsAlpha() returns .T. for them. * Therefore any of these characters is detected by ISX, as well. * * Tamar E. Granor and Peter Steinke, both requested the list DEFINE * features which is why I finally added it. * * Thanks to Eddy Maue for his contributions: * * Ce qu'ile fait de plus maintenant * - Alt-Q pour arr阾er Isx * - Alt-Q pour redemarrer Isx * - Ouvre automatiquements : * -Les tables pr閟entes dans les r閜ertoires courants et de recherches * (set path to) * -Les vues pr閟entes dans le projet actif * -Les query pr閟ents dans les r閜ertoires courants et de recherches * (set path to) * Petit point � ne pas n間liger. Le curseur produit par le fichier * MyQuery.qpr doit 阾re du m阭e nom que le fichier * * In English: * * - ALT+Q enables/disables ISX * - files are opened automatically: * - tables available in the current directory or the search path (SET PATH TO) * - Views available in the current project * - Queries available in the current directory or the search path (SET PATH TO) * Minor, but important restriction: The cursor created by the query program * must have the same alias as the filename. * Mike Yearwood added supported for maximized editing windows which caused a lot * of flickering everytime the popup came up. * * Thanks to all those who pointed out bugs in ISX's releases: * * - Nina Schwanzer * - Del Lee * - Pamela Thalacker * - Christophe Chenavier * - Aragorn Rockstroh * - Claude Hebert * - Jens Kippnich * - Stefan W黚be * *======================================================================================== * * This program has been written in 1999-2005 by Christof Wollenhaupt * and is placed into Public Domain. You can use the entire * code or parts of it as you like in any private or commercial * application. None of the contributors to this programm can be hold * liable for any damage or problems, using this program may cause. * * If you added a new feature, please let me know. If you want I add * your feature to my master copy of ISX to let others use your * feature, as well. Please note that since the entire program is * placed into Public Domain, this places your code into Public * Domain, as well. Of course, your contributions are acknlowdeged in * the comment at the beginning of this file. * *======================================================================================== * * Known problems: * * - So far ISX has not been tested with different Display appearance * settings, like wider scrollbars or form borders, large fonts and * the like. Some values are hardcoded and might be wrong for non- * standard Windows settings. * * - When you enter a period into a textbox, the cursor is set to the first character of * the textbox and then the period entered. If SelectOnEntry is true, everything is * replaced by the period. This is caused by a bug in VFP that makes all ON KEY LABEL * behave this way. You can disable this behavior by commenting out the lines starting * with "ON KEY LABEL .". In this case, you must use ALT+I or ALT+RIGHTARROW do expand * the variable. * *======================================================================================== *======================================================================================== * Configuration. * * Over the time I got many enhanced versions of ISX, many of which include new hotkeys. * To give everyone control over the hotkey assignment and to disable/enable particular * features, I added the following configuration section. By commenting out a #DEFINE, you * disable a particular feature. Changing the value changes the hotkey. * *======================================================================================== #DEFINE EXPAND_VARIABLE ALT+I #DEFINE DOT_ACTIVATION . #DEFINE LIST_ALL ALT+RIGHTARROW #DEFINE TOGGLE_ISX ALT+Q *======================================================================================== * Main program *======================================================================================== Lparameters tcAction, tcParam, tcParam2 Do Case Case Vartype(m.tcAction) == "L" InstallISX() Case Upper(Alltrim(m.tcAction)) == "AUTOCOMPLETE" Push Key Clear AutoComplete( m.tcParam, m.tcParam2 ) Pop Key Case Upper(Alltrim(m.tcAction)) == "QUIT" UninstallISX() Endcase Return *======================================================================================== * Activates the hotkeys. *======================================================================================== Procedure InstallISX Local lcISXProgram lcISXProgram = ["] + Sys(16,Program(-1)-1) + ["] #IFDEF EXPAND_VARIABLE On Key Label EXPAND_VARIABLE Do &lcISXProgram With "AUTOCOMPLETE", "VAR", "" #ENDIF #IFDEF DOT_ACTIVATION On Key Label DOT_ACTIVATION Do &lcISXProgram With "AUTOCOMPLETE", "VAR,OBJ,TABLE", "." #ENDIF #IFDEF LIST_ALL On Key Label LIST_ALL Do &lcISXProgram With "AUTOCOMPLETE", "", "" #ENDIF #IFDEF TOGGLE_ISX On Key Label TOGGLE_ISX Do &lcISXProgram With "QUIT" Wait Window Nowait [ISX up and running... TOGGLE_ISX to quit] #ELSE Wait Window nowait "ISX up and running..." #ENDIF EndProc *==================================================================== * Deactivates the hotkeys. *==================================================================== Procedure UninstallISX Local lcISXProgram lcISXProgram = ["] + Sys(16,Program(-1)-1) + ["] #IFDEF EXPAND_VARIABLE On Key Label EXPAND_VARIABLE #ENDIF #IFDEF DOT_ACTIVATION On Key Label DOT_ACTIVATION #ENDIF #IFDEF LIST_ALL On Key Label LIST_ALL #ENDIF #IFDEF TOGGLE_ISX On Key Label TOGGLE_ISX Do &lcISXProgram Wait Window Nowait [ISX terminated... TOGGLE_ISX to restart] #ELSE Wait Window nowait "ISX terminated..." #ENDIF EndProc *======================================================================================== * Provides a generic autocomplete function. AutoComplete checks all content providers * if they have something to add to the global list and displays the list as a popup *======================================================================================== Procedure AutoComplete Lparameters tcProviders, tcInvocation *-------------------------------------------------------------------------------------- * The list of providers can be limited. This speeds up program execution if one knows * from the context that only few content providers actually fit. *-------------------------------------------------------------------------------------- Local lcProviders If Empty(m.tcProviders) lcProviders = "VAR,DEFINE,TABLE,OBJ" Else lcProviders = Upper(m.tcProviders) EndIf *----------------------------------------------------------------- * Make sure, FoxTools.Fll is loaded. *----------------------------------------------------------------- If not "FOXTOOLS.FLL" $ Upper(Set("Library")) Set Library to (Home()+"FoxTools.Fll") Additive Endif *----------------------------------------------------------------- * Get the current window and verify that it is a valid window. *----------------------------------------------------------------- Local lnWHandle lnWHandle = GetCurrentWindow() If lnWHandle == 0 If not Empty(m.tcInvocation) Clear TypeAhead Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain Endif Return Endif *----------------------------------------------------------------- * Verify that the current window is indeed an edit window. *----------------------------------------------------------------- Local lnEditSource lnEditSource = GetEditSource(m.lnWHandle) If not InList( m.lnEditSource, 1, 8, 10, 12 ) If not Empty(m.tcInvocation) Clear TypeAhead Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain Endif Return EndIf *-------------------------------------------------------------------------------------- * Fill an object with details about the current context. We determine what the user * has entered so far and what's left from that Position. *-------------------------------------------------------------------------------------- Local loISX loISX = CreateObject("Relation") loISX.AddProperty("nWHandle",m.lnWHandle) loISX.AddProperty("nEditSource",m.lnEditSource) loISX.AddProperty("aList[1]") loISX.AddProperty("nCount",0) loISX.AddProperty("cTextLeft",GetLineLeftFromCursor(m.lnWHandle)) loISX.AddProperty("cName","") loISX.AddProperty("cEntity","") loISX.AddProperty("cInvocation",m.tcInvocation) *-------------------------------------------------------------------------------------- * Determine the part of the name that has been entered so far. This code has been * kindly provided by Louis D. Zelus. *-------------------------------------------------------------------------------------- Local lcLine, lcChar If Empty(m.tcInvocation) Do While Len(m.loISX.cTextLeft) > 0 lcChar = Right( m.loISX.cTextLeft, 1 ) If IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar == "_" loISX.cTextLeft = Left( m.loISX.cTextLeft, Len(m.loISX.cTextLeft)-1 ) loISX.cName = m.lcChar + m.loISX.cName Else Exit Endif Enddo EndIf *-------------------------------------------------------------------------------------- * Determines the name of the entity. This code is courtesy of Sietse Wijnkler. *-------------------------------------------------------------------------------------- Do While Len(m.loISX.cTextLeft) > 0 lcChar = Right( m.loISX.cTextLeft, 1 ) If IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar == "_" or m.lcChar == "." loISX.cTextLeft = Left( m.loISX.cTextLeft, Len(m.loISX.cTextLeft)-1 ) loISX.cEntity = m.lcChar + m.loISX.cEntity Else Exit Endif EndDo If Right(loISX.cEntity,1) == "." loISX.cEntity = Left( m.loISX.cEntity, Len(m.loISX.cEntity)-1 ) EndIf *-------------------------------------------------------------------------------------- * This array lists all the providers *-------------------------------------------------------------------------------------- Local laProvider[4,2] laProvider = "" laProvider[1,1] = "VAR" laProvider[1,2] = "CP_Variables" laProvider[2,1] = "DEFINE" laProvider[2,2] = "CP_Defines" laProvider[3,1] = "TABLE" laProvider[3,2] = "CP_Tables" laProvider[4,1] = "OBJ" laProvider[4,2] = "CP_Objects" *-------------------------------------------------------------------------------------- * Get data from each provider and merge it into the list *-------------------------------------------------------------------------------------- Local laAll[1], lnAll, laRequest[1], lnRequest, lnProvider lnAll = 0 For lnRequest=1 to ALines(laRequest,Chrtran(m.lcProviders,",",Chr(13)+Chr(10)),.T.) For lnProvider=1 to Alen(laProvider,1) If Upper(Alltrim(laRequest[m.lnRequest])) == laProvider[m.lnProvider,1] loISX.nCount = 0 Dimension loISX.aList[1] loISX.aList = "" &laProvider[m.lnProvider,2](m.loISX) If m.loISX.nCount > 0 Dimension laAll[m.lnAll+m.loISX.nCount] Acopy(m.loISX.aList,laAll,1,m.loISX.nCount, m.lnAll+1) lnAll = m.lnAll + m.loISX.nCount EndIf EndIf EndFor EndFor *-------------------------------------------------------------------------------------- * If there's anything in the list, display the popup *-------------------------------------------------------------------------------------- If m.lnAll == 0 If not Empty(m.tcInvocation) Clear TypeAhead Keyboard "{Mouse}{Mouse}"+m.tcInvocation Plain Endif Else If not Empty(m.tcInvocation) InsertText( m.lnWHandle, m.tcInvocation ) EndIf loISX.nCount = m.lnAll Dimension loISX.aList[loISX.nCount] Acopy(laAll,loISX.aList) DisplayPopup(loISX) EndIf EndProc *======================================================================================== * Determines all include files that fit in the current situation and adds them to the * list. *======================================================================================== Procedure CP_Defines Lparameters toISX Local loFile If Type("_VFP.ActiveProject") == "O" For each loFile in _VFP.ActiveProject.Files If Upper(JustExt(loFile.Name)) == "H" ReadDefines(m.toISX,loFile.Name) EndIf EndFor Else ReadDefines(m.toISX,Home()+"FoxPro.H") EndIf EndProc *======================================================================================== * Adds all constants from an include file to the array. *======================================================================================== Procedure ReadDefines LParameter toISX, tcFile *-------------------------------------------------------------------------------------- * File must exist. *-------------------------------------------------------------------------------------- If not File(m.tcFile) Return EndIf *-------------------------------------------------------------------------------------- * To increase performance, we cache files if possible. *-------------------------------------------------------------------------------------- Local laDefine[1], lnItem, lnCount If not IsInCache( "DEFINE", m.toISX, m.tcFile ) If Version(4) >= "07.00" lnCount = AProcInfo(laDefine,m.tcFile) Else lnCount = X6_AProcInfo(@laDefine,m.tcFile) EndIf For lnItem=1 to m.lnCount If laDefine[m.lnItem,3] == "Define" toISX.nCount = toISX.nCount + 1 Dimension toISX.aList[toISX.nCount] toISX.aList[toISX.nCount] = laDefine[m.lnItem,1] EndIf EndFor AddToCache( "DEFINE", m.toISX, m.tcFile ) EndIf EndProc *======================================================================================== * The cache is an array in _SCREEN that holds the name of the file, the time stamp, the * provider ID and the contents of the array. *======================================================================================== Procedure IsInCache LParameter tcProvider, toISX, tcFile If Type("_Screen.ISXCache[1,1]") == "U" Return .F. EndIf Local lnLine If Version(4) >= "07.00" lnLine = Ascan( _Screen.ISXCache, m.tcFile+"?"+m.tcProvider, -1, -1, 1, 1+2+4+8 ) Else Local lnCurLine lnLine = 0 For lnCurLine=1 to Alen(_Screen.ISXCache,1) If Type(_Screen.ISXCache[m.lnCurLine]) == "C" If Upper(m.tcFile+"?"+m.tcProvider) == Upper(_Screen.ISXCache[m.lnCurLine]) lnLine = lnCurLine Exit EndIf EndIf EndFor EndIf If m.lnLine == 0 Return .F. EndIf If Fdate(m.tcFile,1) # _Screen.ISXCache[m.lnLine,2] Return .F. EndIf toISX.nCount = _Screen.ISXCache[m.lnLine,3] ALines( toISX.aList, _Screen.ISXCache[m.lnLine,4] ) Return .T. *======================================================================================== * Adds the current entry to the cache. *======================================================================================== Procedure AddToCache LParameter tcProvider, toISX, tcFile If Type("_Screen.ISXCache[1,1]") == "U" _Screen.AddProperty("ISXCache[1,4]") EndIf Local lnLine If Version(4) >= "07.00" lnLine = Ascan( _Screen.ISXCache, m.tcFile+"?"+m.tcProvider, -1, -1, 1, 1+2+4+8 ) Else Local lnCurLine lnLine = 0 For lnCurLine=1 to Alen(_Screen.ISXCache) If Upper(m.tcFile+"?"+m.tcProvider) == Upper(_Screen.ISXCache[m.lnCurLine]) lnLine = lnCurLine Exit EndIf EndFor EndIf If m.lnLine == 0 lnLine = Alen(_Screen.ISXCache,1) + 1 Dimension _Screen.ISXCache[m.lnLine,Alen(_Screen.ISXCache,2)] EndIf Local lnItem _Screen.ISXCache[m.lnLine,1] = m.tcFile+"?"+m.tcProvider _Screen.ISXCache[m.lnLine,2] = Fdate(m.tcFile,1) _Screen.ISXCache[m.lnLine,3] = toISX.nCount _Screen.ISXCache[m.lnLine,4] = "" For lnItem=1 to toISX.nCount _Screen.ISXCache[m.lnLine,4] = _Screen.ISXCache[m.lnLine,4] + ; toISX.aList[m.lnItem] + Chr(13)+Chr(10) EndFor EndProc *==================================================================== * SW: Fills an array with all PEMs for the objectname typed in * Returns the number of PEMs. The object has to exist to work *==================================================================== Procedure CP_Objects Lparameters toISX LOCAL lnVarCount If TYPE(toISX.cEntity) = [O] If Version(4) >= "07.00" If Upper(toISX.cEntity) == "_SCREEN" or Upper(toISX.cEntity) == "_VFP" ; OR Upper(toISX.cEntity) = "_VFP." Return EndIf EndIf Local laMembers[1] toISX.nCount = AMEMBERS(laMembers, Evaluate(toISX.cEntity), 1) Dimension toISX.aList[m.toISX.nCount] FOR m.lnCount = 1 TO toISX.nCount toISX.aList[m.lnCount] = PROPER(laMembers[m.lnCount,1]) NEXT EndIf EndProc *==================================================================== * SW: Fills an array with all Fields for the cursor typed in. * Returns the number of Fields. The cursor has to be open to work *==================================================================== Procedure CP_Tables Lparameters toISX LOCAL lnCount, lcName lcName = JustStem(toISX.cEntity) * November 11, 2004 Modified by Eddy Maue If Occurs(".",toISX.cEntity)==0 And !"m." == LOWER(toISX.cEntity+".") AND ; IIF(Used(m.lcName),.t.,; IIF(File(m.lcName+".dbf"),OpenTable(m.lcName),; IIF(File(m.lcName+".qpr"),ExecQuery(m.lcName),OpenView(m.lcName)))) toISX.nCount = FCOUNT(m.lcName) DIMENSION toISX.aList[toISX.nCount] FOR m.lnCount = 1 TO toISX.nCount toISX.aList[m.lnCount] = PROPER(FIELD(m.lnCount, m.lcName)) NEXT ENDIF EndProc *==================================================================== * Open the table * Eddy Maue * November 11, 2004 *==================================================================== Procedure OpenTable Lparameters lcName Use (m.lcName) In 0 Return Used(m.lcName) ENDPROC *==================================================================== * Open a query *==================================================================== * Eddy Maue * November 11, 2004 *==================================================================== Procedure ExecQuery Lparameters lcName Do (lcName+".qpr") Return Used(lcName) ENDPROC *==================================================================== * Open a view *==================================================================== * Eddy Maue * November 11, 2004 *==================================================================== Procedure OpenView Lparameters lcName,lcSafety,lcConsol If Type("_vfp.ActiveProject")="U" .OR. EMPTY(DBC()) Return .F. ENDIF m.lcSafety = "Set Safety "+Set("safety") Set Safety Off List Views To FILE _view.tmp NOCONSOLE If ":"+ALLTRIM(Lower(lcName))+"(" $ STRTRAN(Lower(Filetostr("_view.tmp"))," ","") Use (lcName) In 0 Endif &lcSafety RETURN USED(m.lcName) *======================================================================================== * Displays a popup with all the values from taList, lets the user incrementally approach * the desired item and inserts it into the editor. *======================================================================================== Procedure DisplayPopup LParameter toISX Local loPopupForm If toISX.nCount > 0 loPopupForm = CreateObject( "isxForm", toISX ) If VarType(m.loPopupForm) == "O" loPopupForm.Show() Endif loPopupForm = NULL EndIf Clear Class isxForm EndProc *==================================================================== * Determines the source of the window identified by the passed * WHandle. It returns the following values: * * -1 The window is not an edit window * 0 Command Window * 1 MODIFY COMMAND window * 2 MODIFY FILE window * 8 Menu Designer code window * 10 Method Edit Window in Class or Form Designer * 12 MODIFY PROCEDURE window * * This procedure uses _EdGetEnv() from the FoxTools.Fll to determine * the edit source. Passing an invalid handle causes an exception in * VFP 5 and VFP 3. In VFP 6 this raises an error 2028 (API function * caused an exception). Therefore we return -1 in this case, too. *==================================================================== Procedure GetEditSource LParameter tnWHandle Local laEnv[25], lnSource, lnOK, lcError lcError = On( "Error" ) On Error lnOK = 0 lnOK = _EdGetEnv( m.tnWHandle, @laEnv ) On Error &lcError If m.lnOK == 0 lnSource = -1 Else lnSource = laEnv[25] Endif Return m.lnSource *==================================================================== * Returns the WHandle of the current edit window or 0, if no edit * window is available. *==================================================================== Procedure GetCurrentWindow Local lnWindowOnTop lnWindowOnTop = _WOnTop() If m.lnWindowOnTop <= 0 Return 0 Endif If GetEditSource( m.lnWindowOnTop ) == -1 lnWindowOnTop = 0 Endif Return m.lnWindowOnTop *==================================================================== * Returns the current cursor position in the edit window identified * by the WHandle. On error -1 is returned. *==================================================================== Procedure GetFileCursorPos Lparameters tnWHandle Local lnCursorPos lnCursorPos = _EdGetPos( m.tnWHandle ) Return m.lnCursorPos *==================================================================== * Changes the current cursor position in the edit window identified * by the WHandle. *==================================================================== Procedure SetFileCursorPos LParameter tnWHandle, tnPosition _EdSetPos( m.tnWHandle, m.tnPosition ) EndProc *==================================================================== * Returns the current line of the edit window identified by the * WHandle. The line number is zero based. On Error -1 is returned. *==================================================================== Procedure GetCurrentLine LParameters tnWHandle Local lnCursorPos, lnLineNo lnCursorPos = GetFileCursorPos( m.tnWHandle ) If lnCursorPos < 0 lnLineNo = -1 Else lnLineNo = _EdGetLNum( m.tnWhandle, m.lnCursorPos ) Endif Return m.lnLineNo *==================================================================== * Returns the cursor position within the current line of the edit * window identified by the WHandle. The cursor position is 0 based. * On error -1 is returned. *==================================================================== Procedure GetCurrentCol Lparameters tnWHandle Local lnCursorPos, lnLineNo, lnColumn, lnLineStart lnCursorPos = GetFileCursorPos( m.tnWHandle ) If m.lnCursorPos < 0 Return -1 Endif lnLineNo = GetCurrentLine( m.tnWHandle ) If m.lnLineNo < 0 Return -1 Endif lnLineStart = GetLineStart( m.tnWHandle, m.lnLineNo ) lnColumn = m.lnCursorPos - m.lnLineStart Return m.lnColumn *==================================================================== * Returns the beginning of the specific line in the edit window * identified by WHandle. Returns -1 on error. *==================================================================== Procedure GetLineStart LParameter tnWHandle, tnLineNo Local lnLineStart lnLineStart = _EdGetLPos( m.tnWHandle, m.tnLineNo ) Return m.lnLineStart *==================================================================== * Returns the text of the specified line in the edit window * identified by the WHandle. A terminating carriage return is * removed. Returns an empty string on error. The line must be zero * based. *==================================================================== Procedure GetLine Lparameters tnWHandle, tnLine Local lnStartPos, lnEndPos, lcString lnStartPos = GetLineStart( m.tnWHandle, m.tnLine ) lnEndPos = GetLineStart( m.tnWHandle, m.tnLine+1 ) If m.lnStartPos == m.lnEndPos lcString = "" Else lnEndPos = m.lnEndPos - 1 lcString = _EdGetStr( m.tnWHandle, m.lnStartPos, m.lnEndPos ) lcString = Chrtran( m.lcString, Chr(13), "" ) Endif Return m.lcString *==================================================================== * Returns the text in the current line that is to the left of the * cursor in the edit window identified by the WHandle. Returns "" on * error. *==================================================================== Procedure GetLineLeftFromCursor Lparameters tnWHandle Local lnCurLine, lnCurCol, lcLine lnCurLine = GetCurrentLine( m.tnWHandle ) If m.lnCurLine < 0 Return "" Endif lnCurCol = GetCurrentCol( m.tnWHandle ) If m.lnCurCol < 0 Return "" Endif If m.lnCurCol == 0 lcLine = "" Else lcLine = GetLine( m.tnWHandle, m.lnCurLine ) lcLine = Left( m.lcLine, m.lnCurCol ) Endif Return m.lcLine *==================================================================== * Inserts text in the edit window identified by WHandle. The text is * stored in tcText, the position is optional. tcOptions can contains * a combination of the following values: * * R The current selection is replaced * B The cursor is positioned at the beginning of the inserted * text. * E (default) The cursor is positioned at the end of the inserted * text. * H The inserted text is highlighted. *==================================================================== Procedure InsertText Lparameters tnWHandle, tcText, tnPosition, tcOptions *----------------------------------------------------------------- * Normalize options *----------------------------------------------------------------- Local lcOptions If Vartype(m.tcOptions) == "C" lcOptions = Upper( Alltrim(m.tcOptions) ) Else lcOptions = "" Endif *----------------------------------------------------------------- * If a position is passed, Change the current cursor position * accordingly. *----------------------------------------------------------------- If Vartype(m.tnPosition) == "N" SetFileCursorPos( m.tnWHandle, m.tnPosition ) Endif *----------------------------------------------------------------- * Insert the Text at the current position. If the "R" option is * used, delete the current selection. *----------------------------------------------------------------- Local lnStartPosition, lnEndPosition If "R" $ m.lcOptions _EdDelete( m.tnWHandle ) Endif lnStartPosition = GetFileCursorPos( m.tnWHandle ) _EdInsert( m.tnWHandle, m.tcText, Len(m.tcText) ) lnEndPosition = GetFileCursorPos( m.tnWHandle ) *----------------------------------------------------------------- * Set the cursor accordingly. "E" is the default of VFP. We don't * need any action for that. *----------------------------------------------------------------- Do Case Case "B" $ m.lcOptions SetFileCursorPos( m.tnWHandle, m.lnStartPosition ) Case "H" $ m.lcOptions _EdSelect( m.tnWHandle, m.lnStartPosition, m.lnEndPosition ) Endcase EndProc *======================================================================================== * Fills an array with all variable declarations in the current procedure of the edit * window identified by the WHandle. Variable declarations are only searched backward from * the current position. Returns the number of variables. * *! 2004-10Oct-19 ChrisW * Added support for variables with non-english characters such as "�". * In VFP 9 the array limitation has been lifted. *======================================================================================== Procedure CP_Variables Lparameters toISX *-------------------------------------------------------------------------------------- * Check if the current entity is a variable *-------------------------------------------------------------------------------------- Local llIsVariable DO Case Case Upper(toISX.cEntity)=="M" llIsVariable = .T. Case Empty(m.toISX.cEntity) If Empty(toISX.cInvocation) llIsVariable = .T. Else llIsVariable = .F. EndIf Otherwise llIsVariable = .F. EndCase If not m.llIsVariable Return EndIf *----------------------------------------------------------------- * Get the current line as a starting point. We start with the line * before that line. *----------------------------------------------------------------- Local lnEnd lnEnd = GetCurrentLine( toISX.nWHandle ) If lnEnd <= 0 Return Else lnEnd = m.lnEnd - 1 Endif *----------------------------------------------------------------- * Because GetLine() is quite slow with large program files, we * read the entire program up to the line before the current line * into an array and parse that. Since an array can only contain * up to 65000 lines, we make sure that we don't read more than * that into the laText array. *----------------------------------------------------------------- Local lnLineCount, laText[1], lnStart If m.lnEnd >= 65000 and Version(4) < "09.00" lnStart = m.lnEnd - 65000 Else lnStart = 0 Endif lnLineCount = AGetLines(m.toISX.nWHandle,@laText,m.lnStart,m.lnEnd) *-------------------------------------------------------------------------------------- * Parse all lines backwards for the following keywords: LOCAL, * PUBLIC, PROCEDURE, FUNCTION. We add all variables in the * LOCAL and PUBLIC lines and stop parsing when we find PROCEDURE * or FUNCTION. *-------------------------------------------------------------------------------------- Local lnCurrentLine, lcLine, lnPos, lcCommand, lcValidCmds For lnCurrentLine = m.lnLineCount to 1 Step -1 lcLine = NormalizeLine( laText[m.lnCurrentLine] ) If Len(m.lcLine) < 4 Loop EndIf If Version(4) >= "07.00" lcCommand = GetWordNum(m.lcLine,2) Else lcCommand = X6_GetWordNum(m.lcLine,2) EndIf If m.lcCommand == "=" Loop EndIf If Version(4) >= "07.00" lcCommand = GetWordNum(m.lcLine,1) Else lcCommand = X6_GetWordNum(m.lcLine,1) EndIf lcValidCmds = ; "LOCAL,PUBLIC,LPARAMETERS,PARAMETERS,PRIVATE,PROCEDURE,FUNCTION,PROTECTED," + ; "HIDDEN" If not IsFoxProCommand(m.lcCommand,m.lcValidCmds) Loop EndIf lnPos = At( " ", m.lcLine ) If m.lnPos == 0 or m.lnPos == Len(m.lcLine) Loop Endif lcLine = Alltrim( Substr(m.lcLine,m.lnPos) ) If IsFoxProCommand(m.lcCommand,"LOCAL") If Version(4) >= "07.00" lcCommand = GetWordNum(m.lcLine,1) Else lcCommand = X6_GetWordNum(m.lcLine,1) EndIf If IsFoxProCommand(m.lcCommand,"ARRAY") lnPos = At( " ", m.lcLine ) If m.lnPos == 0 or m.lnPos == Len(m.lcLine) Loop Endif lcLine = Alltrim( Substr(m.lcLine,m.lnPos) ) EndIf EndIf If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION,PROTECTED,HIDDEN" ) lnPos = At( "(", m.lcLine ) If m.lnPos == 0 or m.lnPos == Len(m.lcLine) Exit EndIf lcLine = Substr(m.lcLine,m.lnPos+1) EndIf lnCurrentLine = m.lnCurrentLine - ; CP_VariablesAdd( m.toISX, m.lcLine, m.lnCurrentLine, @laText ) If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION,PROTECTED,HIDDEN" ) Exit Endif Endfor EndProc *======================================================================================== * *======================================================================================== Procedure CP_VariablesAdd LParameter toISX, tcLine, tnCurrentLine, taText Local lcLine, lnLineOffset, lnCurrentVar, laDeclarations[1], lcCurrentVar, ; lnPosInVar, lcChar, lnPos lcLine = m.tcLine lnLineOffset = 0 Do While .T. lcLine = Chrtran( m.lcLine, ",", Chr(13) ) For lnCurrentVar = 1 to ALines( laDeclarations, lcLine ) lcCurrentVar = Alltrim( laDeclarations[m.lnCurrentVar] ) If Empty( m.lcCurrentVar ) Loop Endif If not IsAlpha( m.lcCurrentVar ) ; and not Left(m.lcCurrentVar,1) == "_" Loop Endif lnPos = At( " ", m.lcCurrentVar ) If m.lnPos == 0 lnPos = Len( m.lcCurrentVar ) Else lnPos = m.lnPos - 1 Endif lcCurrentVar = Left( m.lcCurrentVar, m.lnPos ) If LEFT(LOWER(m.lcCurrentVar),2)=='m.' lcCurrentVar = SUBSTR(m.lcCurrentVar,3) EndIf For m.lnPosInVar = 2 to Len(m.lcCurrentVar) lcChar = SubStr(m.lcCurrentVar,m.lnPosInVar,1) If not (IsAlpha(m.lcChar) or IsDigit(m.lcChar) or m.lcChar="_") lcCurrentVar = Left( m.lcCurrentVar, m.lnPosInVar-1 ) Exit Endif Endfor toISX.nCount = m.toISX.nCount + 1 Dimension toISX.aList[m.toISX.nCount] toISX.aList[m.toISX.nCount] = m.lcCurrentVar Endfor If Right(m.lcLine,1) # ";" Exit Endif lnLineOffset = m.lnLineOffset + 1 If m.tnCurrentLine + m.lnLineOffset > Alen(taText,1) Exit Endif lcLine = NormalizeLine( ; taText[m.tnCurrentLine+m.lnLineOffset] ; ) Enddo Return m.lnLineOffset *======================================================================================== * Returns .T., when the first string is a FoxPro command. *======================================================================================== Procedure IsFoxProCommand LParameter tcCommand, tcCommandList Local laList[1], lnLine, llFound llFound = .F. For lnLine=1 to ALines(laList,Chrtran(m.tcCommandList,",",Chr(13)+Chr(10))) If Left(Upper(laList[m.lnLine]),Len(m.tcCommand)) == Upper(m.tcCommand) llFound = .T. Exit Endif EndFor Return m.llFound *==================================================================== * Normalizes a line. This means: All tabs are converted to single * blanks, leading or trailing blanks are removed. Comments starting * with && are removed. *==================================================================== Procedure NormalizeLine Lparameters tcLine Local lcLine, lnPos lcLine = Chrtran( m.tcLine, Chr(9), " " ) If "&"+"&" $ m.lcLine lnPos = At( "&"+"&", m.lcLine ) lcLine = Left( m.lcLine, m.lnPos-1 ) Endif lcLine = Alltrim(m.lcLine) Return m.lcLine *==================================================================== * GetKeyLabel takes the parameters passed to the KeyPress event and * returns the label name that can be used for KEYBOARD or ON KEY * LABEL, etc. *==================================================================== Procedure GetKeyLabel LParameter tnKeyCode, tnSAC Local lcLabel Do Case Case Between(m.tnKeyCode,33,126) lcLabel = Chr(m.tnKeyCode) Case Between(m.tnKeyCode,128,255) lcLabel = Chr(m.tnKeyCode) Case m.tnSAC == 2 and Between(m.tnKeyCode,1,26) Do Case Case m.tnKeyCode == 2 lcLabel = "CTRL+RIGHTARROW" Case m.tnKeyCode == 8 lcLabel = "" Case m.tnKeyCode == 10 lcLabel = "CTRL+ENTER" Case m.tnKeyCode == 23 lcLabel = "CTRL+END" Case m.tnKeyCode == 26 lcLabel = "CTRL+LEFTARROW" Otherwise lcLabel = "CTRL+" + Chr(m.tnKeyCode+64) Endcase Case m.tnSAC == 0 and m.tnKeyCode < 0 lcLabel = "F" + Alltrim(Str(Abs(m.tnKeyCode)+1)) Case m.tnSAC == 0 and m.tnKeyCode == 22 lcLabel = "INS" Case m.tnSAC == 1 and m.tnKeyCode == 22 lcLabel = "SHIFT+INS" Case m.tnSAC == 0 and m.tnKeyCode == 1 lcLabel = "HOME" Case m.tnSAC == 0 and m.tnKeyCode == 7 lcLabel = "DEL" Case m.tnSAC == 0 and m.tnKeyCode == 28 lcLabel = "F1" Case m.tnSAC == 0 and m.tnKeyCode == 6 lcLabel = "END" Case m.tnSAC == 0 and m.tnKeyCode == 18 lcLabel = "PGUP" Case m.tnSAC == 0 and m.tnKeyCode == 3 lcLabel = "PGDN" Case m.tnSAC == 0 and m.tnKeyCode == 5 lcLabel = "UPARROW" Case m.tnSAC == 0 and m.tnKeyCode == 28 lcLabel = "F1" Case m.tnSAC == 0 and m.tnKeyCode == 24 lcLabel = "DNARROW" Case m.tnSAC == 0 and m.tnKeyCode == 4 lcLabel = "RIGHTARROW" Case m.tnSAC == 0 and m.tnKeyCode == 19 lcLabel = "LEFTARROW" Case m.tnSAC == 0 and m.tnKeyCode == 27 lcLabel = "ESC" Case m.tnSAC == 0 and m.tnKeyCode == 13 lcLabel = "ENTER" Case m.tnSAC == 0 and m.tnKeyCode == 127 lcLabel = "BACKSPACE" Case m.tnSAC == 0 and m.tnKeyCode == 9 lcLabel = "TAB" Case m.tnSAC == 0 and m.tnKeyCode == 32 lcLabel = "SPACEBAR" Case m.tnSAC == 1 and m.tnKeyCode == 13 lcLabel = "SHIFT+ENTER" Case m.tnSAC == 1 and m.tnKeyCode == 127 lcLabel = "SHIFT+BACKSPACE" Case m.tnSAC == 1 and m.tnKeyCode == 15 lcLabel = "SHIFT+TAB" Case m.tnSAC == 1 and m.tnKeyCode == 32 lcLabel = "SHIFT+SPACEBAR" Case m.tnSAC == 2 and m.tnKeyCode == 29 lcLabel = "CTRL+HOME" Case m.tnSAC == 2 and m.tnKeyCode == 31 lcLabel = "CTRL+PGUP" Case m.tnSAC == 2 and m.tnKeyCode == 30 lcLabel = "CTRL+PGDN" Case m.tnSAC == 2 and m.tnKeyCode == 128 lcLabel = "CTRL+BACKSPACE" Case m.tnSAC == 2 and m.tnKeyCode == 32 lcLabel = "CTRL+SPACEBAR" Otherwise lcLabel = "" Endcase Return m.lcLabel *==================================================================== * Fills an array with all lines between nStart and nEnd. *==================================================================== Procedure AGetLines LParameter tnWHandle, raText, tnStart, tnEnd *----------------------------------------------------------------- * Copy the text between nStart and nEnd into a string variable. *----------------------------------------------------------------- Local lnStartPos, lnEndPos, lcString lnStartPos = GetLineStart( m.tnWHandle, m.tnStart ) lnEndPos = GetLineStart( m.tnWHandle, m.tnEnd+1 ) - 1 lcString = _EdGetStr( m.tnWHandle, m.lnStartPos, m.lnEndPos ) *----------------------------------------------------------------- * And parse this into an array *----------------------------------------------------------------- Local lnCount lnCount = ALines( raText, m.lcString ) Return m.lnCount *==================================================================== * The FoxTools function _AGetEnv() doesn't return proper font infor- * mation. Instead it claims that "MS Sans Serif", 8 pt. is the * current font. This function returns font information for the speci- * fied window by accessing the GDI. *==================================================================== Procedure WGetFontInfo LParameter tnWHandle, rcFontName, rnFontSize, rnStyle *----------------------------------------------------------------- * In addition to the window handle of this window we also need * the HWND of the child window that contains the actual editor. * The GetClientWindow() function retrieves this window handle. *----------------------------------------------------------------- Local lnHWND lnHWND = GetClientWindow( m.tnWHandle ) If m.lnHWND == 0 Return .F. Endif *----------------------------------------------------------------- * Using this HWND we can then get a Device Context. *----------------------------------------------------------------- Local lnHWND, lnHDC Declare LONG GetDC in Win32API LONG lnHDC = GetDC( m.lnHWND ) If m.lnHDC == 0 Return .F. Endif *----------------------------------------------------------------- * With this device context we can now get an object handle to the * currently selected font. *----------------------------------------------------------------- Local lnHFONT Declare LONG GetCurrentObject in Win32API LONG, LONG lnHFONT = GetCurrentObject( m.lnHDC, 6 ) && OBJ_FONT If m.lnHFONT == 0 Return .F. Endif *----------------------------------------------------------------- * The HFONT handle to the current font can be used to obtain more * detailled information about the selected font. We need to rename * the API function GetObject(), because it interferes with VFP's * GETOBJECT() function *----------------------------------------------------------------- Local lcLogFont Declare Integer GetObject in Win32API as GDI_GetObject ; LONG, Integer, String@ lcLogFont = Replicate( Chr(0), 1024 ) If GDI_GetObject( m.lnHFONT, 1024, @lcLogFont ) == 0 Return .F. Endif *----------------------------------------------------------------- * Now to extract the font information from the LOGFONT structure. *----------------------------------------------------------------- Local lnSize, lcName, lnStyle lnSize = Abs( FromInt(Left(m.lcLogFont,4)) - 2^32 ) lcName = SubStr( m.lcLogFont, 29 ) lcName = Left( m.lcName, At(Chr(0),m.lcName)-1 ) lnStyle = 0 If FromInt(SubStr(m.lcLogFont,17,4)) == 700 lnStyle = m.lnStyle + 1 Endif If FromInt(SubStr(m.lcLogFont,21,4)) # 0 lnStyle = m.lnStyle + 2 Endif *----------------------------------------------------------------- * We now have the height of the font in pixels but what we need * are points. *----------------------------------------------------------------- Local lnResolution Declare Integer GetDeviceCaps in Win32API Integer, Integer lnResolution = GetDeviceCaps( m.lnHDC, 90 ) && LOGPIXELSY lnSize = m.lnSize / m.lnResolution * 72 lnSize = Round( m.lnSize, 0 ) *----------------------------------------------------------------- * Finally release the device context *----------------------------------------------------------------- Declare Integer ReleaseDC In Win32API LONG, LONG ReleaseDC( m.lnHWND, m.lnHDC ) *----------------------------------------------------------------- * And pass the values pack as parameters *----------------------------------------------------------------- rcFontName = m.lcName rnFontSize = m.lnSize rnStyle = m.lnStyle Return .T. *==================================================================== * The editor only works on the editor window and you can only get the * HWND of this window using the Window Handle. For many Windows ope- * rations, however, you need the HWND of the child window that con- * tains the actual editor area. This function returns the HWND of * this window. It's not that easy, because Method snippet windows * actually have two child windows, one for the text editor and one * with the method and object dropdown combos. *==================================================================== Procedure GetClientWindow LParameter tnWHandle *----------------------------------------------------------------- * Convert the Window Handle into a HWND *----------------------------------------------------------------- Local lnHWND lnHWND = _WhToHWND( m.tnWHandle ) *----------------------------------------------------------------- * FindWindowEx returns all child windows of a given parent window. * We use it to find a child of the edit window that doesn't have * another child window, because method edit windows have a second * which we can identify since it has another child window. *----------------------------------------------------------------- Local lnChild Declare Integer FindWindowEx in Win32API ; Integer, Integer, String, String lnChild = 0 Do While .T. lnChild = FindWindowEx( m.lnHWND, m.lnChild, NULL, NULL ) If m.lnChild == 0 Exit Endif If FindWindowEx( m.lnChild, 0, NULL, NULL ) == 0 Exit Endif Enddo Return m.lnChild *==================================================================== * Returns the position of the text cursor (caret) in _SCREEN coordi- * nates. If the window identified by the passed window handle doesn't * have the focus, or the position can't be determined, this function * returns .F. *==================================================================== Procedure GetCaretPosition LParameter tnWHandle, rnTop, rnLeft *----------------------------------------------------------------- * Check whether this window has got the focus. *----------------------------------------------------------------- Declare Integer GetFocus in Win32API If GetFocus() # _WhToHWND( m.tnWHandle ) Return .F. Endif *----------------------------------------------------------------- * Determine the cursor position. This position is relative to the ** OK * client area of the editing subwindow of the actual editing win- * dow. *----------------------------------------------------------------- Local lnLeft, lnTop, lcPOINT Declare Integer GetCaretPos in Win32API String@ lcPOINT = Space(8) If GetCaretPos( @lcPOINT ) == 0 lnLeft = MCol(3) lnTop = MRow(3) Else lnLeft = Asc(Left(m.lcPOINT,1))+256*Asc(SubSTr(m.lcPOINT,2,1)) lnTop = Asc(SubSTr(m.lcPOINT,5,1))+256*Asc(SubStr(m.lcPOINT,6,1)) Endif *----------------------------------------------------------------- * To convert this postion to _SCREEN coordinates, we have to * determine the position of the client window relative to the * desktop window and correlate this with the absolute position of * the _SCREEN window. Hence, we need first the HWNDs of both * windows. *----------------------------------------------------------------- Local lnChild, lnScreen Declare Integer GetParent in Win32API Integer lnChild = GetClientWindow( m.tnWHandle ) If m.lnChild == 0 Return .F. Endif lnScreen = GetParent( _WhToHWND(m.tnWHandle) ) If m.lnScreen == 0 Return .F. Endif *----------------------------------------------------------------- * Now we can determine the position of both windows. *----------------------------------------------------------------- Local lnChildTop, lnChildLeft, lnScreenTop, lnScreenLeft, lcRect lcRect = Replicate( Chr(0), 16 ) Declare Integer GetWindowRect in Win32API Long, String@ GetWindowRect( m.lnChild, @lcRect ) lnChildLeft = FromInt( Left(m.lcRect,4) ) lnChildTop = FromInt( SubSTr(m.lcRect,5,4) ) GetWindowRect( m.lnScreen, @lcRect ) lnScreenLeft = FromInt( Left(m.lcRect,4) ) lnScreenTop = FromInt( SubSTr(m.lcRect,5,4) ) *----------------------------------------------------------------- * Now combine the position of the edit window and the cursor * position. *----------------------------------------------------------------- rnLeft = m.lnLeft + m.lnChildLeft - m.lnScreenLeft rnTop = m.lnTop + m.lnChildTop - m.lnScreenTop EndProc Procedure FromInt Parameter tcString Private nValue, nT nValue =0 For nT = 1 to Len(tcString) nValue = nValue + Asc(SubStr(tcString,nT,1))*256^(nT-1) Endfor Return nValue *==================================================================== * The following class displays a popup window at the current cursor * position and lets the user continue to type. * * The characters a-z, A-Z, 0-9 and _ are inserted into the active * edit window as the user types. The previous position is saved in * order to restore the text if necessary. * * ESC terminates the popup and doesn't change the text. * * TAB inserts the current selection and terminates the popup. * * SPACEBAR inserts the current selection, adds a blank and terminates * the popup. * * Any other key terminates the popup and is repeated so it is handled * properly by VFP. If the user enters the first character that * doesn't match an item in the list, or entered a full item where * none exists that has the same name, but additional characters, the * list is terminated as well. * *==================================================================== Define CLASS isxForm as Form AlwaysOnTop = .T. WindowType = 1 TitleBar = 0 BorderStyle = 0 nWHandle = 0 nCurrentPos = 0 cSearchString = "" cVarString = "" Dimension aItems[1,2] lScrolled = .F. *Mike Yearwood - these support reducing screen caption flicker cScreenCaption = "" cWindowCaption = "" lMaximized = .F. Add Object isxList as Listbox with ; ColumnCount = 2, ; ColumnLines = .F., ; IncrementalSearch = .F. PROCEDURE Load this.lMaximized = wmaximum() IF THIS.lMaximized THIS.cWindowCaption = LOWER(WTITLE()) THIS.cScreenCaption = _screen.Caption ENDIF RETURN DODEFAULT() ENDPROC PROCEDURE Show *==================================================================== * Mike Yearwood * When the edit window is maximized, the screen caption reads * currentedit.prg * - current vfp system window caption * When this window goes active, the screen caption changes * which causes a flicker. To stop that flicker, set the screen * caption to what it was before. *==================================================================== IF THIS.lMaximized _Screen.Caption = this.cWindowCaption + " * - " + this.cScreenCaption ENDIF ENDPROC PROCEDURE Destroy *Mike Yearwood *Prevent screen caption flicker. IF THIS.lMaximized _Screen.Caption = this.cScreenCaption ENDIF ENDPROC *==================================================================== * When the form is initialized, we have to determine its position * and get a handle to the current edit window. Pass an array to this * form that contains all possible values the user can enter. *==================================================================== Procedure Init LParameter toISX With This *----------------------------------------------------------------- * Get the handle for the current window. *----------------------------------------------------------------- .nWHandle = toISX.nWHandle .nCurrentPos = GetFileCursorPos( .nWHandle ) *----------------------------------------------------------------- * Copy the array and sort it case-insensitive *----------------------------------------------------------------- Local laValues[1], lnValue If Version(4) >= "07.00" Asort( toISX.aList, -1, -1, 0, 1 ) Else Dimension laValues[toISX.nCount,2] For lnValue = 1 to toISX.nCount laValues[m.lnValue,1] = Upper(toISX.aList[m.lnValue]) laValues[m.lnValue,2] = m.lnValue EndFor Asort( laValues, 1 ) EndIf *-------------------------------------------------------------------------------------- * Fill the listbox with all possible values. *-------------------------------------------------------------------------------------- Local lcValue, lnWidth, lnMaxWidth, lnValue, lcVarString, lnAvgCharWidth lnMaxWidth = 0 lcVarString = "" Dimension .aItems[toISX.nCount,2] lnAvgCharWidth = Fontmetric(6,.isxList.FontName,.isxList.FontSize) For lnValue = 1 to toISX.nCount If Version(4) >= "07.00" lcValue = toISX.aList[m.lnValue] Else lcValue = toISX.aList[laValues[m.lnValue,2]] EndIf .aItems[m.lnValue,1] = Upper(m.lcValue) .aItems[m.lnValue,2] = m.lcValue lcVarString = m.lcVarString + ":" + Padr(Upper(m.lcValue),128) lnWidth = Txtwidth(m.lcValue,.isxList.FontName,.isxList.FontSize) * m.lnAvgCharWidth lnMaxWidth = Max( m.lnMaxWidth, m.lnWidth ) EndFor .cVarString = m.lcVarString lnMaxWidth = m.lnMaxWidth + 30 With .isxList .ColumnWidths = "0," + Alltrim(Str(m.lnMaxWidth)) .RowSource = "Thisform.aItems" .RowSourceType = 5 .Requery() .Move( 0, 0, m.lnMaxWidth, 110 ) If .ListCount < 6 .Height = .ListCount*16 + 14 Endif EndWith .Width = m.lnMaxWidth .Height = .isxList.Height *----------------------------------------------------------------- * The original version of the following few code blocks has been * kindly provided by Louis D. Zelus. I've modified it to match the * rest of the code here. The purpose is to simulate a behavior * in VB. If the variable is inserted via ALT+I, everything already * typed is used to position the list and if the already entered * parts are sufficient to uniquely identify the variablem it's * inserted without displaying the popup at all. All blocks based * on his code start with LDZ. *----------------------------------------------------------------- *----------------------------------------------------------------- * LDZ: If a variable name has been entered, we highlight it in the * edit window. *----------------------------------------------------------------- Local lnStartPos, lnEndPos, lcInput lcInput = toISX.cName If Len(m.lcInput) > 0 lnEndPos = GetFileCursorPos( .nWHandle ) lnStartPos = m.lnEndPos - Len(m.lcInput) _EdSelect( .nWHandle, m.lnStartPos, m.lnEndPos ) Endif *----------------------------------------------------------------- * LDZ: Try to find this variable name in the list of variables we * assembled above. If we find it, we select this entry and save * what has been entered so far. *----------------------------------------------------------------- Local lnIndex If Len(m.lcInput) > 0 lnIndex = At( ":"+Upper(m.lcInput), .cVarString ) If m.lnIndex == 0 .isxlist.ListIndex = 0 Else .isxlist.ListIndex = (m.lnIndex/129) + 1 Endif .cSearchString = m.lcInput Endif *----------------------------------------------------------------- * LDZ: If there's no second instance of this start, accept it * immediately without displaying the popup. The full variable name * is inserted with the proper case at the current position * replacing the selection. *----------------------------------------------------------------- If Len(m.lcInput) > 0 If At( ":"+Upper(m.lcInput), .cVarString, 2 ) == 0 ; and not m.lnIndex == 0 InsertText( .nWHandle, "", , "R" ) InsertText( .nWHandle, .isxList.List[.isxList.ListIndex,2] ) Return .F. Endif Endif *----------------------------------------------------------------- * Determine the cursor position in _SCREEN coordinates *----------------------------------------------------------------- Local lnLeft, lnTop If not GetCaretPosition( .nWHandle, @lnTop, @lnLeft ) Return .F. Endif *----------------------------------------------------------------- * As we position the popup BELOW the current line, we need to * know the height of this line in pixels. *----------------------------------------------------------------- Local lnLineHeight, lnAvgCharWidth, lcFontName, lnFontSize If not WGetFontInfo( .nWHAndle, @lcFontName, @lnFontSize ) Return .F. Endif lnLineHeight = FontMetric( 1, m.lcFontName, m.lnFontSize ) lnAvgCharWidth = FontMetric(6,m.lcFontName,m.lnFontSize) *----------------------------------------------------------------- * We make sure that the popup doesn't move below the VFP window to * keep it visible all the time. If it doesn't fit into the area * below the cursor, we move it upwards. *----------------------------------------------------------------- If m.lnTop + .Height + m.lnLineHeight > _Screen.Height lnTop = m.lnTop - .Height Else lnTop = m.lnTop + m.lnLineHeight Endif .Top = m.lnTop *------------------------------------------------------------------ * As for the height of the VFP window, we do the same for the * width. If the popup won't fit into the VFP _Screen, we flip * it horizontally. *------------------------------------------------------------------ If m.lnLeft + .Width + lnAvgCharWidth > _Screen.Width lnLeft = m.lnLeft - .Width Else lnLeft = m.lnLeft + lnAvgCharWidth EndIf .Left = m.lnLeft Endwith EndProc *======================================================================================== * If we don't hide the popup before releasing it, the focus might not go back to the * edit window. This happens when we have a Data Session window docked on one side and * a code editing window maximized. In this case the focus switches to the datasession * window and Aliases listbox disappears. *======================================================================================== Procedure Release This.Hide() EndProc Procedure isxList.KeyPress LParameter tnKeyCode, tnSAC With This *----------------------------------------------------------------- * If the Up or Down Arrow has been pressed, we do nothing, but * remember that the user scrolled in the list, because this acti- * vates the enter key. *----------------------------------------------------------------- Local llScrolled If m.tnSAC == 0 and InList( m.tnKeyCode, 5, 24 ) .Parent.lScrolled = .T. Return Endif llScrolled = .Parent.lScrolled .Parent.lScrolled = .F. *----------------------------------------------------------------- * Determines whether a name qualifier has been entered. *----------------------------------------------------------------- Local llQualifier llQualifier = .F. If m.tnSAC == 0 and Between(m.tnKeyCode,Asc("a"),Asc("z")) llQualifier = .T. Endif If m.tnSAC == 1 and Between(m.tnKeyCode,Asc("A"),Asc("Z")) llQualifier = .T. Endif If m.tnSAC == 0 and Between(m.tnKeyCode,Asc("0"),Asc("9")) llQualifier = .T. Endif If m.tnSAC == 1 and m.tnKeyCode == Asc("_") llQualifier = .T. Endif *----------------------------------------------------------------- * If a qualifier has been entered, we insert the character into * the current edit window. We also perform an incremental search * on the Text being inserted. *----------------------------------------------------------------- Local lcSearch, lnIndex If m.llQualifier lcSearch = .Parent.cSearchString + Chr(m.tnKeyCode) Endif *----------------------------------------------------------------- * BACKSPACE deletes the last character. *----------------------------------------------------------------- If m.tnSAC == 0 and m.tnKeyCode == 127 If Len(.Parent.cSearchString) > 0 lcSearch = .Parent.cSearchString lcSearch = Left( m.lcSearch, Len(m.lcSearch)-1 ) llQualifier = .T. Endif Endif *----------------------------------------------------------------- * Now that we handled BACKSPACE, we can update the variable name * in the edit window. *----------------------------------------------------------------- If m.llQualifier InsertText( .Parent.nWHandle, m.lcSearch, , "RH" ) lnIndex = At( ":"+Upper(m.lcSearch), .Parent.cVarString ) If m.lnIndex == 0 .ListIndex = 0 Else .ListIndex = (m.lnIndex/129) + 1 Endif .Parent.cSearchString = m.lcSearch NoDefault Return Endif *----------------------------------------------------------------- * The following flags determine how to procede. *----------------------------------------------------------------- Local lcTextToInsert, llResendKey, llClearInput lcTextToInsert = "" llResendKey = .T. llClearInput = .F. Do Case *----------------------------------------------------------------- * If TAB has been pressed, insert the current selection and * release the popup *----------------------------------------------------------------- Case m.tnSAC == 0 and m.tnKeyCode == 9 and .ListIndex > 0 lcTextToInsert = .List[.ListIndex,2] llResendKey = .F. llClearInput = .T. *----------------------------------------------------------------- * If ENTER has been pressed after the user made a selection with * the arrow keys, we insert the current selection and release the * popup, because after scrolling the user has the feeling of using * a plain listbox where enter performs a selection. *----------------------------------------------------------------- Case m.tnSAC == 0 ; and m.tnKeyCode == 13 ; and .ListIndex > 0 ; and m.llScrolled lcTextToInsert = .List[.ListIndex,2] llResendKey = .F. llClearInput = .T. *----------------------------------------------------------------- * Several keys insert the current selection plus the typed * character and release the popup. These are usually keys that * directly follow a variable name. *----------------------------------------------------------------- Case InList(m.tnKeyCode, ; Asc(" "), Asc(")"), Asc("["), Asc("."), Asc("="), ; Asc("+"), Asc("-"), Asc("*"), Asc("/"), Asc("%"), ; Asc(","), Asc("]") ; ) and .ListIndex > 0 lcTextToInsert = .List[.ListIndex,2] llClearInput = .T. *----------------------------------------------------------------- * If ESC has been pressed, the text is unselected. *----------------------------------------------------------------- Case m.tnSAC == 0 and m.tnKeyCode == 27 llResendKey = .F. *----------------------------------------------------------------- * terminate the popup for any other key and leave the text. *----------------------------------------------------------------- Otherwise Endcase *----------------------------------------------------------------- * If the currently entered Text should be deleted, insert an empty * string using the replace option. Insert text afterwards. *----------------------------------------------------------------- If m.llClearInput InsertText( .Parent.nWHandle, "", , "R" ) Else SetFileCursorPos( ; .Parent.nWHandle, ; .Parent.nCurrentPos + Len(.Parent.cSearchString) ; ) Endif If not Empty( m.lcTextToInsert ) InsertText( .Parent.nWHandle, m.lcTextToInsert ) Endif *----------------------------------------------------------------- * Close the form. *----------------------------------------------------------------- NoDefault Thisform.Release() *----------------------------------------------------------------- * And repeat the keystroke if necessary *----------------------------------------------------------------- Local lcKey If m.llResendKey lcKey = GetKeyLabel( m.tnKeyCode, m.tnSAC ) If not Empty(m.lcKey) Clear TypeAhead If Len(m.lcKey) == 1 Keyboard m.lcKey Else Keyboard "{"+m.lcKey+"}" Endif Endif Endif Endwith EndProc *==================================================================== * Double-clicking is the same as TAB. *==================================================================== Procedure isxList.DblClick Clear TypeAhead Keyboard "{Tab}" Plain EndProc EndDefine *======================================================================================== * VFP 6: Returns a specific word in a string *======================================================================================== Function X6_GetWordNum LParameter tcString, tnWord, tcDelimiter Local lcString, lcDelimiter, lnWord, laWords[1], lnFound, lcWord If Vartype(m.tcDelimiter) == "C" lcDelimiter = m.tcDelimiter Else lcDelimiter = Chr(9)+Chr(32) EndIf lcString = Chrtran(m.tcString,m.lcDelimiter,Replicate(Chr(13),Len(m.lcDelimiter))) lnFound = 0 lcWord = "" For lnWord = 1 to ALines(laWords,m.lcString) If not Empty(laWords[m.lnWord]) lnFound = lnFound + 1 If m.lnFound == m.tnWord lcWord = laWords[m.lnWord] Exit EndIf EndIf EndFor Return m.lcWord *======================================================================================== * VFP 6: Returns a list of all defines *======================================================================================== Procedure X6_AProcInfo LParameter taArray, tcFile Local laLines[1], lnLine, lnFound lnFound = 0 For lnLine = 1 to ALines(laLines,FileToStr(m.tcFile)) If Upper(X6_GetWordNum(laLines[m.lnLine],1)) == "#DEFINE" lnFound = lnFound + 1 Dimension taArray[m.lnFound,3] taArray[m.lnFound,1] = X6_GetWordNum(laLines[m.lnLine],2) taArray[m.lnFound,3] = "Define" EndIf EndFor Return m.lnFound

相关内容推荐