*a line control per header simulates a border in each grid column *problem: when mousemove on any header the lines disappear entirely *this is a solution: simply in method showHearline() add a line of code: *oline.top=oLine.top *to send oline on front.very simple but annoying. PUBLIC oform1 oform1=NEWOBJECT("form1") oform1.Show RETURN *- DEFINE CLASS form1 AS form Top = 0 Left = 0 Height = 265 Width = 500 Caption = "Form1" Name = "Form1" ADD OBJECT gridborder1 AS gridborder WITH ; Anchor = 15, ; Height = 204, ; Left = 12, ; Top = 12, ; Width = 485, ; bordercolor = (RGB(192,192,192)), ; selectedbordercolor = (RGB(255,128,0)), ; Name = "Gridborder1" ADD OBJECT text1 AS textbox WITH ; Top = 228, ; Left = 312, ; Height = 27, ; Width=40 ,; Anchor = 12, ; Name = "text1" ADD OBJECT command1 AS commandbutton WITH ; Top = 228, ; Left = 412, ; Height = 27, ; Width = 72, ; Anchor = 12, ; Caption = "Close", ; Name = "Command1" ADD OBJECT command2 AS commandbutton WITH ; Top = 228, ; Left = 12, ; Height = 27, ; Width = 144, ; Anchor = 4, ; Caption = "Set inactive border color", ; Name = "Command2" ADD OBJECT command3 AS commandbutton WITH ; Top = 228, ; Left = 168, ; Height = 27, ; Width = 132, ; Anchor = 4, ; Caption = "Set Active Bordercolor", ; Name = "Command3" PROCEDURE Load Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs Readwrite ENDPROC PROCEDURE command1.Click THISFORM.Release ENDPROC PROCEDURE command2.Click THIS.Parent.gridborder1.bordercolor = GETCOLOR() THIS.Parent.gridborder1.Setbordercolor(THIS.Parent.gridborder1.bordercolor) ENDPROC PROCEDURE command3.Click THIS.Parent.gridborder1.selectedbordercolor = GETCOLOR() THIS.Parent.gridborder1.ResizeBorders() ENDPROC ENDDEFINE *- DEFINE CLASS gridborder AS grid Height = 200 Width = 320 selectedbordercolor = 255 *-- Specifies the border color of an object. bordercolor = (RGB(255,255,0)) Name = "gridborder" PROCEDURE setup LOCAL oObject, oColumn, nColor oObject = THIS cName = THIS.Name nColor = THIS.bordercolor IF PEMSTATUS(oObject.Parent, cName+"_T", 5) = .F. oObject.Parent.ADDOBJECT(cName+"_T", "Line") oObject.Parent.ADDOBJECT(cName+"_L", "Line") oObject.Parent.ADDOBJECT(cName+"_R", "Line") oObject.Parent.ADDOBJECT(cName+"_B", "Line") oObject.Parent.ADDOBJECT(cName+"_H", "Line") WITH GETPEM(oObject.Parent, cName+"_T") .bordercolor = nColor .VISIBLE = .T. ENDWITH WITH GETPEM(oObject.Parent, cName+"_L") .bordercolor = nColor .VISIBLE = .T. ENDWITH WITH GETPEM(oObject.Parent, cName+"_R") .bordercolor = nColor .VISIBLE = .T. ENDWITH WITH GETPEM(oObject.Parent, cName+"_B") .bordercolor = nColor .VISIBLE = .T. ENDWITH WITH GETPEM(oObject.Parent, cName+"_H") .bordercolor = nColor && RGB(255,255,255) .VISIBLE = oObject.HEADERHEIGHT > 0 ENDWITH ENDIF BINDEVENT(oObject, "Resize", THIS, "ResizeBorders") BINDEVENT(oObject, "Moved", THIS, "ResizeBorders") BINDEVENT(oObject, "HeaderHeight", THIS, "ResizeBorders") BINDEVENT(oObject, "Visible", THIS, "ResizeBorders") BINDEVENT(oObject, "Valid", THIS, "ObjectLostFocus",1) BINDEVENT(oObject, "Refresh", THIS, "ObjectRefresh") FOR EACH oColumn IN oObject.COLUMNS FOXOBJECT IF oColumn.Objects.Count > 0 BINDEVENT(oColumn.Objects(1), "MouseMove", THIS, "ShowHeaderLine") BINDEVENT(oColumn.Objects(1), "MouseMove", THIS, "ShowHeaderLine",1) ENDIF ENDFOR THIS.ResizeBorders() ENDPROC PROCEDURE ResizeBorders LOCAL oLine, oObject oObject = THIS TRY oLine = GETPEM(oObject.Parent, oObject.Name+"_T") oLine.MOVE(oObject.Left, oObject.Top, oObject.Width, 0) oLine.VISIBLE = oObject.VISIBLE oLine.ZORDER(0) oLine = GETPEM(oObject.Parent, oObject.Name+"_L") oLine.MOVE(oObject.Left, oObject.Top, 0, oObject.Height, 0) oLine.VISIBLE = oObject.VISIBLE oLine.ZORDER(0) oLine = GETPEM(oObject.Parent, oObject.Name+"_R") oLine.MOVE(oObject.Left+oObject.Width -1, oObject.Top, 0, oObject.Height, 0) oLine.VISIBLE = oObject.VISIBLE oLine.ZORDER(0) oLine = GETPEM(oObject.Parent, oObject.Name+"_B") oLine.MOVE(oObject.Left, oObject.Top+oObject.Height -1, oObject.Width, 0) oLine.VISIBLE = oObject.VISIBLE oLine.ZORDER(0) oLine = GETPEM(oObject.Parent, oObject.Name+"_H") oLine.MOVE(oObject.Left+1, oObject.Top+oObject.HEADERHEIGHT, oObject.Width - SYSMETRIC(5) - 3,0) oLine.VISIBLE = oObject.VISIBLE oLine.ZORDER(0) CATCH ENDTRY ENDPROC PROCEDURE showheaderline LPARAMETERS nButton, nShift, nX, nY LOCAL oLine, aEvn[1], oObject AEVENTS(aEvn,0) oObject = aEvn[1] IF nButton = 0 oLine = GETPEM(oObject.Parent.Parent.Parent, oObject.Parent.Parent.Name+"_H") oLine.ZORDER(0) oLine.Top=oLine.Top &&correction made here to make lines always appear ENDIF RETURN ENDPROC PROCEDURE objectrefresh LOCAL oLine THIS.ResizeBorders() oLine = GETPEM(THIS.Parent, THIS.Name+"_H") IF oLine.Top <> THIS.Top+THIS.HEADERHEIGHT THIS.ResizeBorders() ENDIF RETURN ENDPROC PROCEDURE Setbordercolor LPARAMETERS nColor LOCAL oLine, oObject oObject = THIS TRY oLine = GETPEM(oObject.Parent, oObject.Name+"_T") oLine.bordercolor = nColor oLine = GETPEM(oObject.Parent, oObject.Name+"_L") oLine.bordercolor = nColor oLine = GETPEM(oObject.Parent, oObject.Name+"_R") oLine.bordercolor = nColor oLine = GETPEM(oObject.Parent, oObject.Name+"_B") oLine.bordercolor = nColor oLine = GETPEM(oObject.Parent, oObject.Name+"_H") oLine.bordercolor = nColor ENDTRY RETURN ENDPROC PROCEDURE lostfocus UNBINDEVENT(THISFORM, "Paint", THIS, "LostFocus") THIS.Setbordercolor(THIS.bordercolor) ENDPROC PROCEDURE gotfocus THIS.Setbordercolor(THIS.selectedbordercolor) ENDPROC PROCEDURE Init THIS.setup() ENDPROC PROCEDURE Valid BINDEVENT(THISFORM, "Paint", THIS, "LostFocus",1) ENDPROC PROCEDURE Refresh THIS.objectrefresh() ENDPROC PROCEDURE When THIS.gotfocus() ENDPROC PROCEDURE objectlostfocus ENDPROC ENDDEFINE