ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Isx2c.prg ajout de fonctionnalités

	Description
Retour à la liste L'auteur eddymaue Canada Membre Simple # 0000000075 enregistré le 26/10/2004 Maue Eddy j8j 8j8 Gatineau de la société Formatek Fiche personnelle Note des membres 18/20 2 votes	Contributions > 21 - Outils Isx2c.prg ajout de fonctionnalités # 0000000104 ajouté le 28/11/2004 18:37:25 et modifié le 18/01/2008 consulté 14288 fois Niveau expert Version(s) Foxpro : VFP 9.0 VFP 8.0 Télécharger le ZIP (15.95 Ko)
	Isx.prg reste un exellent complément à Intellisense de Vfp 8.0. Les modifications que je lui est apporté auguement notre confort d'aide à la programmation. Ce que Isx faisait avant Affiche dans un popup : - Les variables LOCAL, PRIVATE, PUBLIC, LPARAMETER and PARAMETER - Les champs de tables ouvertent - Alt-I les variable locaux LOCAL, PRIVATE, PUBLIC, LPARAMETER and PARAMETER - Alt-rightarrow Les #define Ce que fait de plus maintenant - Alt-Q pour arrêter Isx - Alt-Q pour redemarrer Isx - Ouvre automatiquements : -Les tables présentes dans le répertoire courant et de recherche(set path to) -Les vues présentes dans le projet actif -Les query présent dans le répertoire courant et de recherche(set path to) petit point à ne pas négliger. Le curseur produit par fichier MyQuery.qpr doit être du même nom que le fichier 20/6/05, Th N ISX2b supporte l'IDE localisée en Français. Redémarrer VFP pour recharger ISX complètement. 17/01/2008, Eddy Maue Correction d'un p'tit bug 17/01/2008, Eddy Maue En cette heure tardive "23:15" et avec beaucoup de retard, je viens d'appliqué les modif de Thierry
	Code source :
	======================================================================================== * Version: 2005-06-17 Dec-06-1 ISX Revision 002b * ======================================================================================== * This program implements partial IntelliSense in VFP 6. 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 <g>, 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. <bg> * * 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ürgen "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 que Isx fait de plus maintenant * - Alt-Q pour arrêter Isx * - Alt-Q pour redemarrer Isx * - Ouvre automatiquements : * -Les tables présentes dans les répertoires courants et de recherches * (set path to) * -Les vues présentes dans le projet actif * -Les query présents dans les répertoires courants et de recherches * (set path to) * Petit point à ne pas négliger. Le curseur produit par le fichier * MyQuery.qpr doit être du même nom que le fichier * * Fev,21,2005 -------------------------------------- * * Bug : J'ai noté un problème lorsqu'une table ou un objet se terminait par * un m comme thisform ou Do form ou TableItem. Lorsque j'appuyais sur * la Space Bar un conflit apparaissait entre Isx et l'Intellisense * Manager de vfp 8.0 * Voir "Modifié le 20 fevrier 2005" * * 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. * * June,17,2005, Thierry Nivelet -------------------------------------- * * Bug : Les constantes ne sont pas listée dans l'IDE VFP localisée en Français * Constants list pop-up don't appear with french localized version of VFP IDE * Voir/See "Modifié le 17 juin 2005" * * * Thanks to all those who pointed out bugs in ISX's releases: * * - Nina Schwanzer * - Del Lee * - Pamela Thalacker * - Christophe Chenavier * ======================================================================================== * This program has been written in 1999-2002 by Christof Lange * 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: * * - Variable declaration of the following variations are not parsed * at all: * * PROCEDURE Name(var) * FUNCTION Name(var) * * - 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 Local lcISXProgram lcISXProgram = JUSTPATH(SYS(16)) Do Case Case Vartype(m.tcAction) == "L" InstallISX() Case Upper(Alltrim(m.tcAction)) == "AUTOCOMPLETE" Push Key Clear * Activate Screen Autocomplete( m.tcParam, m.tcParam2 ) && "VAR,OBJ,TABLE", "." Pop Key Case Upper(Alltrim(m.tcAction)) == "QUIT" UninstallISX() Endcase Return ======================================================================================== Activates the hotkeys. ======================================================================================== Procedure InstallISX Lparameters 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 Lparameters 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 && "VAR,OBJ,TABLE", "." -------------------------------------------------------------------------------------- * 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 = "DEFINE,VAR,TABLE,OBJ" Else && Dot_Activation 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() Activate Screen * ? lnWHandle, m.tcInvocation If lnWHandle == 0 If Not Empty(m.tcInvocation) If m.tcInvocation == "." And Type("_vfp.ActiveForm.ActiveControl")=="O" And Inlist(_vfp.ActiveForm.ActiveControl.BaseClass,"Textbox","Combobox","Listbox") Newobject("tmrTask",["] + Sys(16,Program(-1)-1) + ["],"",_vfp.ActiveForm.ActiveControl.SelStart) Else Clear Typeahead Keyboard "{Mouse}"+m.tcInvocation Plain Endif 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}"+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}"+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 Upper(laDefine[m.lnItem,3]) $ "DEFINE,DEFINIR,DÉFINIR" && Modifié le 17 juin 2005, Th N 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) == "_SCREEN" Return Endif Endif Local laMembers[1] toISX.nCount = Amembers(laMembers, Evaluate(toISX.cEntity), 1) *************************************************************************** * Modifié le 20 fevrier 2005 **************************************************************************** ! FOR m.lnCount = 1 TO toISX.nCount ! toISX.aList[m.lnCount] = PROPER(laMembers[m.lnCount,1]) ! NEXT * debut If m.toISX.nCount = 0 Return Endif Dimension toISX.aList[m.toISX.nCount] For m.lnCount = 1 To toISX.nCount toISX.aList[m.lnCount] = Proper(laMembers[m.lnCount,1]) Next * fin 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 * December 15, 2004 * Contribution of Thierry * Before use (m.lcName) in 0 * After Use (m.lcName) AGAIN In 0 ==================================================================== Procedure OpenTable Lparameters lcName Use (m.lcName) Again 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, laDeclarations[1], lcCommand, ; lnCurrentVar, lcCurrentVar, lnPosInVar, lnLineOffset, ; lcChar For lnCurrentLine = m.lnLineCount To 1 Step -1 lcLine = NormalizeLine( laText[m.lnCurrentLine] ) If Len(m.lcLine) < 4 Loop Endif lcCommand =Iif(Version(4) >= "07.00",; Getwordnum(m.lcLine,2), X6_GetWordNum(m.lcLine,2)) If m.lcCommand == "=" Loop Endif lcCommand = Iif(Version(4) >= "07.00",; Getwordnum(m.lcLine,1) ,X6_GetWordNum(m.lcLine,1)) !* 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 **************************************************************************** ! Contribution of Thierry Nivelet **************************************************************************** ! If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION" ) ! Exit ! Endif ! If Not IsFoxProCommand(m.lcCommand,"LOCAL,PUBLIC,LPARAMETERS,PARAMETERS,PRIVATE") ! Loop ! Endif **************************************************************************** * Modifié le 3 mars 2005 **************************************************************************** If IsFoxProCommand (m.lcCommand, "PROCEDURE,FUNCTION,HIDDEN,PROTECTED") Exit Endif If Not IsFoxProCommand(m.lcCommand,"LOCAL,PUBLIC,PRIVATE,LPARAMETERS,PARAMETERS") Loop Endif If m.lcCommand =="LOCAL" ; AND Iif(Version(4) >= "07.00", Getwordnum(m.lcLine, 2), X6_GetWordNum(m.lcLine,2)) == "ARRAY" m.lcLine = Strtran(m.lcLine, "ARRAY") Endif * fin de la modification 3 mars 2005 **************************************************************************** lnPos = At( " ", m.lcLine ) If m.lnPos == 0 Or m.lnPos == Len(m.lcLine) Loop Endif lnLineOffset = 0 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 lnLineOffset = 0 lcLine = Alltrim( Substr(m.lcLine,m.lnPos) ) Endif Endif 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 ) 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.lnCurrentLine + m.lnLineOffset > Alen(laText,1) Exit Endif lcLine = NormalizeLine( ; laText[m.lnCurrentLine+m.lnLineOffset] ; ) Enddo Endfor Endproc ======================================================================================== 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))+256Asc(Substr(m.lcPOINT,2,1)) lnTop = Asc(Substr(m.lcPOINT,5,1))+256Asc(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. Add Object isxList As ListBox With ; ColumnCount = 2, ; ColumnLines = .F., ; IncrementalSearch = .F. ==================================================================== * 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 = .ListCount16 + 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, lcFontName, lnFontSize If Not WGetFontInfo( .nWHandle, @lcFontName, @lnFontSize ) Return .F. Endif lnLineHeight = Fontmetric( 1, 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 lnLeft = m.lnLeft + Fontmetric(6,m.lcFontName,m.lnFontSize) .Top = m.lnTop .Left = m.lnLeft Endwith 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("_") If m.tnSAC == 0 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 /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ tmrTask As Timer * / Eddy Maue a+ -- Créer le : 2008-01-17 Define Class tmrTask As Timer Enabled = .T. Interval = 50 oCtrl = "" ctxt = "" nPos = 0 oThis = "" Procedure Init Lparameters tnPos This.oThis = This This.nPos = tnPos+1 * /¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ timer * / Eddy Maue a+ -- Créer le : 2008-01-17 Procedure Timer() With This .Enabled = .F. Activate Screen Local lcCliptextOld,oCtrl As TextBox, llSOE _vfp.ActiveForm.LockScreen = .T. oCtrl = _vfp.ActiveForm.ActiveControl m.llSOE = oCtrl.SelectOnEntry oCtrl.SelectOnEntry = .F. nPos = This.nPos Local lcCtrlProperty lcCtrlProperty = "oCtrl." + ; iif(Pemstatus(m.oCtrl,"DisplayValue",5); , "DisplayValue" ; , Iif(Pemstatus(m.oCtrl,"Value",5) ; , "Value" ; , "" ; )) Try lcTxt = Left(&lcCtrlProperty,nPos-1)+"."+Substr(&lcCtrlProperty,nPos) &lcCtrlProperty= lcTxt Catch To oe Set Step On Endtry oCtrl.SelLength = 0 oCtrl.SetFocus() oCtrl.SelStart = nPos oCtrl.SelectOnEntry = llSOE _vfp.ActiveForm.LockScreen = .F. Release This Endwith Endproc && timer Enddefine && ¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯¯ tmrTask As Timer
	Commentaires
	le 15/12/2004, Thierry a écrit : Merci Eddy, j'utilise ISX avec l'ouverture automatique des tables. Il y a un problème lorqu'on a préalablement ouvert une table avec un nom d'alias. Exemple : use client alias client1 puis dans un PRG : client. --> ERREUR dans ISX. Je propose donc cette petite modification : Procedure OpenTable Lparameters lcName Use (m.lcName) AGAIN In 0 Return Used(m.lcName) ENDPROC le 21/12/2004, Luc a écrit : IsX est un super complément (c'est étonnant que ces fonctionnalités ne soient pas implantées d'origine dans Fox). J'ai eu un problème avec les variables comportant des caractères accentués, qiIsX tronque malheureusement pour les variables francophones. Je propose de modifier lcValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_" en : lcValidChars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890_" + Upper("éùèçàù") dans la procédure CP_Variables. le 21/12/2004, Luc a écrit : Encore une petite chose pour que IsX fonctionne avec les instructions #Define en version française : Dans "Procedure ReadDefines", on peut remplacer If laDefine[m.lnItem,3] == "Define" par If laDefine[m.lnItem,3] == "Define" ; .or. laDefine[m.lnItem,3] == "Definir" le 02/03/2005, FoxInCloud (Th. Nivelet) a écrit : Salut Eddy, J'ai apporté des modifications à la procédure CP_Variables pour - gérer les procédures HIDDEN et PROTECTED - inclure les tableaux déclarés par LOCAL ARRAY à la liste des variables. Peux-tu les intégrer ? Remplacer * ======================== If IsFoxProCommand( m.lcCommand, "PROCEDURE,FUNCTION" ) Exit Endif If Not IsFoxProCommand(m.lcCommand,"LOCAL,PUBLIC,LPARAMETERS,PARAMETERS,PRIVATE") Loop Endif * ======================== par * ======================== If IsFoxProCommand (m.lcCommand, "PROCEDURE,FUNCTION,HIDDEN,PROTECTED") Exit ENDIF If not IsFoxProCommand(m.lcCommand,"LOCAL,PUBLIC,PRIVATE,LPARAMETERS,PARAMETERS") Loop Endif IF m.lcCommand =="LOCAL" ; AND Iif(Version(4) >= "07.00", GetWordNum(m.lcLine, 2), X6_GetWordNum(m.lcLine,2)) == "ARRAY" m.lcLine = Strtran(m.lcLine, "ARRAY") ENDIF * ======================== Merci Th N, www.abaqueinside.com le 30/09/2005, Thierry a écrit : Pour une compatibilté avec le clavier AZERTY. (touche _ ) Remplacer dans la procédure isxList.KeyPress : If m.tnSAC == 1 And m.tnKeyCode == Asc("_") par : If m.tnSAC == 0 And m.tnKeyCode == Asc("_") le 30/09/2005, Thierry a écrit : Pour pouvoir utiliser les touches Page Up/Down dans la selection des noms, remplacer dans la procédure isxList.KeyPress : If m.tnSAC == 0 And Inlist( m.tnKeyCode, 5, 24 ) par : If m.tnSAC == 0 And Inlist( m.tnKeyCode, 5, 24, 3, 18 )

Isx2c.prg ajout de fonctionnalités

Contributions > 21 - Outils