On 2016-02-03 12:58, Kurt Wendt wrote:
Thanks Tracy - that's a good idea about the Escape key. I will Definitely try this out if I notice this crashing issue happening again - and may just Set Escape on in advance - just in case...
You're using VFP9SP2 latest patch, right?
Another issue related to this SubClassed Grid. IN the Init of the Form in which the Grid exists - I'm updating things for this grid - like the column header names & formatting of the headers. This is also where I set the RecordSource. So - while I'm updating the Headers - I want to then update the Click or DoubleClick method to contain the code that will allow resorting of the data based upon that column/field. But, at runtime - can I push code into something like the Click Method of the Grid Column? I'm getting errors in VFP when trying to do so. I'm not sure if it's possible to do - or I'm just doing it wrong?
At this moment - as snippet of the code is as such: WITH Thisform.Cash_Grid .Column4.Header1.DblClick = .Data_resort(.Column4.ControlSource)
Create a custom method and call that instead. That's cleaner. Also, that grid class iirc sets the column names for you if you set lSetColumns = .T.
For sorting, here's a method in my frmBase form class called from the column.Header1.Click event:
PARAMETERS toColumn
this.cOrder = toColumn.Name && mjb 05-02-14
*** mjb 04/14/14 - took from HDIRT's frmbase togglesortorder method LOCAL loException as Exception, lnRegColor as Integer, lnSelColor as Integer, lcCmd as String, lnOldArea as Integer, liNumTags as Integer, ; lcTagName as String, lcSeekValue as String, oColumn as Column, lcCursor as String, loGrid as Grid, lcAscDesc as String LOCAL ARRAY laTags[1] lnOldArea = SELECT() && save current work area lnRegColor = RGB(0,0,0) && could make this meta-data later too lnSelColor = RGB(0,0,255) lcOrder = toColumn.tag IF this.lCreateTagOnFly AND EMPTY(lcOrder) THEN lcOrder = toColumn.Name toColumn.Tag = lcOrder ENDIF loGrid = toColumn.Parent lcCursor = loGrid.RecordSource IF !EMPTY(lcOrder) AND !EMPTY(lcCursor) THEN SELECT (lcCursor) TRY *** mjb 08/09/2012 - see if index exists and add it on-the-fly if necessary liNumTags = ATAGINFO(laTags) IF LEN(lcOrder) > 10 OR GETWORDCOUNT(lcOrder) > 1 THEN IF NOT USED("TagsCursor") THEN CREATE CURSOR TagsCursor (cCursor C(50), cOrder C(75), cTag C(10)) INDEX on cCursor + cOrder TAG MyOrder ENDIF lcSeekValue = PADR(lcCursor,50) + PADR(lcOrder,75) IF SEEK(lcSeekValue,"TagsCursor","MyOrder") THEN && grab tag name lcTagName = ALLTRIM(TagsCursor.cTag) ELSE && not found yet...create tag and add to cursor lcTagName = SYS(2015) INSERT INTO TagsCursor VALUES (lcCursor,lcOrder,lcTagName) ENDIF && SEEK(..) ELSE && ok length..use fieldname passed lcTagName = lcOrder ENDIF && LEN(lcOrder) > 10
IF ASCAN(laTags,UPPER(lcTagName)) = 0 THEN && tag doesn't exist...create it on the fly IF GETWORDCOUNT(lcOrder) = 1 THEN && just simple tag lcCmd = "INDEX ON " + lcOrder + " TAG " + lcTagName + [ ASCENDING] ELSE && expression built * set lcTagName to be LAST word in command which is tag name lcTagName = GETWORDNUM(lcOrder,GETWORDCOUNT(lcOrder)) IF INLIST(UPPER(lcTagName),'ASCENDING','DESCENDING','ASC','DESC') THEN && get word prior lcTagName = GETWORDNUM(lcOrder,GETWORDCOUNT(lcOrder)-1) ENDIF && INLIST(UPPER(lcTagName),'ASCENDING','DESCENDING','ASC','DESC') THEN && get word prior * need to update TagsCursor since redefining tag name set there earlier IF SEEK(PADR(lcCursor,50) + PADR(lcOrder,75),"TagsCursor","MyOrder") THEN REPLACE cTag WITH lcTagName IN TagsCursor ELSE SET STEP ON * shouldn't happen ENDIF lcCmd = lcOrder ENDIF SELECT (lcCursor) &lcCmd ENDIF && ASCAN(laTags,UPPER(lcTagName)) = 0
SET ORDER TO (lcTagName) IN (lcCursor) && mjb 12-18-14
*** mjb 05/17/2014 - grabbed from ToggleSortOrder as it wasn't toggling asc/desc as I expected IF ORDER() = ALLTRIM(UPPER(lcTagName)) THEN IF this.Visible THEN IF this.cAscDesc = 'ASCENDING' THEN SET ORDER TO (lcTagName) IN (lcCursor) DESCENDING this.cAscDesc = "DESCENDING" ELSE SET ORDER TO (lcTagName) IN (lcCursor) ASCENDING this.cAscDesc = "ASCENDING" ENDIF && DESCENDING() ELSE IF NOT EMPTY(this.cAscDesc) THEN lcAscDesc = ALLTRIM(this.cAscDesc) SET ORDER TO (lcTagName) IN (lcCursor) &lcAscDesc this.cAscDesc = 'ASCENDING' ENDIF && NOT EMPTY(this.cAscDesc) ENDIF && this.visible ENDIF && ORDER() = ALLTRIM(UPPER(lcTagName))
SELECT (lcCursor) LOCATE && mjb 03-01-05 send to top when changing order
FOR EACH oColumn IN loGrid.Columns oColumn.Header1.FontBold = LOWER(oColumn.Tag) = LOWER(lcOrder) IF oColumn.Header1.FontBold THEN && make backcolor use different color to show selected order column (mjb 08-16-05) oColumn.Header1.ForeColor = lnSelColor ELSE oColumn.Header1.ForeColor = lnRegColor ENDIF ENDFOR loGrid.refresh()
CATCH TO loException WHEN loException.ErrorNo = 1683 && no index tag with this name...ignore IF _vfp.StartMode = 0 THEN MESSAGEBOX(loException.Message,16,"Problem") ENDIF
CATCH TO loException MESSAGEBOX(loException.Message,16,"Problem") SET STEP ON ENDTRY ENDIF && !EMPTY(lcOrder) SELECT (lnOldArea) && restore previous work area