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
_______________________________________________
Post Messages to: [email protected]
Subscription Maintenance: http://mail.leafe.com/mailman/listinfo/profox
OT-free version of this list: http://mail.leafe.com/mailman/listinfo/profoxtech
Searchable Archive: http://leafe.com/archives/search/profox
This message:
http://leafe.com/archives/byMID/profox/[email protected]
** All postings, unless explicitly stated otherwise, are the opinions of the
author, and do not constitute legal or medical advice. This statement is added
to the messages for those lawyers who are too stupid to see the obvious.
