PUBLIC goForm
goForm = CREATEOBJECT("MyForm")
goForm.Show()
READ EVENTS
CLOSE ALL
CLEAR ALL
**********
DEFINE CLASS MyForm as Form
Width = 540
Height = 360
MinWidth = This.Width
MinHeight = This.Height
MaxWidth = This.Width
Caption = "Sorting data in grid"
AutoCenter = .T.
ShowTips = .T.
Themes = .F.
ADD OBJECT grdNames as grdBase WITH ;
RecordSource = "csrNames"
PROCEDURE grdNames.Init()
WITH This
.Column1.Header1.Caption = "N°"
.Column2.Header1.Caption = "Name"
.Column3.Header1.Caption = "Age"
.Column4.Header1.Caption = "G°"
.Column5.Header1.Caption = "City"
ENDWITH
ENDPROC
PROCEDURE grdNames.Refresh()
LOCAL lcDBClick as String, lcClick as String
lcDBClick = "DoubleClick header to reset order"
lcClick = "Click header to sort by "
DODEFAULT()
WITH This
.Column1.Header1.ToolTipText = IIF(ORDER() = "TNUMBER", lcDBClick, lcClick + "Number")
.Column2.Header1.ToolTipText = IIF(ORDER() = "TNAME", lcDBClick, lcClick + "Name")
.Column3.Header1.ToolTipText = IIF(ORDER() = "TAGE", lcDBClick, lcClick + "Age")
.Column4.Header1.ToolTipText = "Sorting by Gender not available"
.Column5.Header1.ToolTipText = IIF(ORDER() = "TCITY", lcDBClick, lcClick + "City")
ENDWITH
ENDPROC
PROCEDURE Load()
CREATE CURSOR csrNames (iRNumber I,cName C(20), iAge I, cGender C(1), cCity C(20))
INSERT INTO csrNames VALUES (3,'Sahra', 31, "F", "Bruxelles")
INSERT INTO csrNames VALUES (4,'Jeoffrey', 20, "M", "Paris")
INSERT INTO csrNames VALUES (6,'Jenny', 53, "F", "Den Haag")
INSERT INTO csrNames VALUES (1,'Toni', 44, "M", "Rome")
INSERT INTO csrNames VALUES (2,'Sophie', 76, "F", "Berlin")
INSERT INTO csrNames VALUES (7,'Jeremy', 67, "M", "New York")
INSERT INTO csrNames VALUES (8,'John', 19, "M", "Chicago")
INSERT INTO csrNames VALUES (9,'Marie-Josée', 28, "F", "Quebec")
INSERT INTO csrNames VALUES (10,'Karen', 62, "F", "Toronto")
INSERT INTO csrNames VALUES (11,'Abi', 56, "M", "Zurich")
INSERT INTO csrNames VALUES (12,'Bernhard', 42, "M", "Basel")
INSERT INTO csrNames VALUES (13,'Christiane', 26, "F", "Marseille")
INSERT INTO csrNames VALUES (14,'Doris', 29, "F", "Munich")
INSERT INTO csrNames VALUES (15,'Fred', 58, "M", "Wien")
INSERT INTO csrNames VALUES (16,'Georges', 40, "M", "Budapest")
INSERT INTO csrNames VALUES (17,'Juanita', 36, "F", "Mexico")
INSERT INTO csrNames VALUES (18,'Jane', 52, "F", "Los Angeles")
INSERT INTO csrNames VALUES (19,'Jan', 57, "M", "Amsterdam")
INSERT INTO csrNames VALUES (20,'Henrietta', 41, "F", "Baton Rouge")
INSERT INTO csrNames VALUES (5,'Mark', 54, "M", "Bern")
INDEX on iRNumber TAG TNumber
INDEX on cName TAG TName
INDEX on iAge TAG TAge
INDEX on cCity TAG TCity
SET ORDER TO
LOCATE
ENDPROC
PROCEDURE Init()
DODEFAULT()
This.DoBinds()
ENDPROC
PROCEDURE DoBinds()
LOCAL loCol, loObj
FOR EACH loCol IN This.grdNames.Columns
IF loCol.BaseClass = "Column"
UNBINDEVENTS(loCol)
BINDEVENT(loCol,"MouseMove", This,"GetColumnToolTipText")
ENDIF
FOR EACH loObj IN loCol.Objects
IF loObj.Baseclass == "Header"
UNBINDEVENTS(loObj)
BINDEVENT(loObj,"Click",This,"HeaderClick")
BINDEVENT(loObj,"DblClick",This,"HeaderTwiceClick")
BINDEVENT(loObj,"MouseMove", This,"GetHeaderToolTipText")
ENDIF
NEXT
NEXT
ENDPROC
PROCEDURE HeaderClick()
LOCAL ARRAY laEvents[1]
LOCAL lcOrderBy, loObject
AEVENTS(laEvents, 0)
*!* = MESSAGEBOX("Clicked: " + SYS(1272, laEvents[1]), 64, "Clicked Object", 1500)
loObject = laEvents[1]
lcOrderBy = SUBSTR(RIGHT(SYS(1272, loObject),9),1,1)
IF INLIST(lcOrderBy, "1", "2", "3", "5")
WITH This.grdNames
.SetAll("FontBold", .F., "Header")
.SetAll("FontItalic", .F., "Header")
.SetAll("BackColor", RGB(228, 228, 228), "Header")
ENDWITH
WITH loObject
.FontBold = .T.
.FontItalic = .T.
.Backcolor = RGB(0, 201, 201)
ENDWITH
ENDIF
DO CASE
CASE lcOrderBy = "1"
SET ORDER TO TNumber
CASE lcOrderBy = "2"
SET ORDER TO TName
CASE lcOrderBy = "3"
SET ORDER TO TAge
CASE lcOrderBy = "4"
= MESSAGEBOX("Sorting by Gender is not available", 64, "Setting Order", 2000)
CASE lcOrderBy = "5"
SET ORDER TO TCity
OTHERWISE
= MESSAGEBOX("Call developper", 16, "Setting Order", 5000)
ENDCASE
LOCATE
This.Refresh()
ENDPROC
PROCEDURE HeaderTwiceClick()
WITH This.grdNames
.SetAll("FontBold", .F., "Header")
.SetAll("FontItalic", .F., "Header")
.SetAll("BackColor", RGB(228, 228, 228), "Header")
ENDWITH
SET ORDER TO
LOCATE
This.Refresh()
ENDPROC
PROCEDURE GetHeaderToolTipText(nButton, nShift, nXCoord, nYCoord)
LOCAL laEvents[1]
LOCAL loObject
AEVENTS(laEvents,0)
loObject = laEvents[1]
This.grdNames.cToolTipText = loObject.ToolTipText
ENDPROC
*!* The procedure below AVOIDS the TTT to show when the mouse is hovering over columns
PROCEDURE GetColumnToolTipText(nButton, nShift, nXCoord, nYCoord)
*!* LOCAL laEvents[1]
*!* LOCAL loObject
*!*
*!* AEVENTS(laEvents,0)
*!*
*!* loObject = laEvents[1]
*!*
*!* This.grdNames.cToolTipText = loObject.Name
This.grdNames.cToolTipText = ""
ENDPROC
PROCEDURE Destroy()
ThisForm.Release()
CLEAR EVENTS
ENDPROC
ENDDEFINE
DEFINE CLASS grdBase as Grid
cToolTipText = ""
Top = 6
Left = 6
Width = 540 - 12
Height = 360 - 12
Anchor = 15
BackColor = RGB(0, 246, 246)
ColumnCount = -1
PROCEDURE ToolTipText_Access()
RETURN This.cToolTipText
ENDPROC
ENDDEFINE
**********