Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Grid Border Color
Message
From
03/10/2018 11:53:13
 
 
To
03/10/2018 10:22:08
Walter Meester
HoogkarspelNetherlands
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 9 SP2
OS:
Windows 10
Database:
MS SQL Server
Miscellaneous
Thread ID:
01662372
Message ID:
01662464
Views:
48
i added one line to your code making it working as expected.test corrected code and feed back.
*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
Previous
Reply
Map
View

Click here to load this message in the networking platform