Grid cosmetics part 3

Published on by Yousfi Benameur

      

[Post 278]
this post continues the previous one (part1 and part2).
its relative to vfp grid codes,as grid artificial borderwidth or bordercolor , vertical headers....

note: if want more grid cosmetics convert the relative cursor online to html and browse it in an embed 'shell.explorer.2' on the form with CSS styles wanted.(see previous post on beautifying tables).

the post might continue with future other relative codes.



Click on code to select [then copy] -click outside to deselect


*1*created on sunday 30 of september 2018
*this is a solution to simulate a grid border (native border  is vfp system window border and don't have any property to change the grid window color).
*include the grid in a container and adjust (procedure resize()).the bordercolor property of the container or picture can desserve this problem.
*can change the random grid border color by simple click on it here.
*can set a container image (as shipped in code ybg.png for ex. or any other)an empty image want to say "no picture)
*with this code can have a simple color border or an image colored border.All adjustable as wanted.
*(can also use a basic solution with  a simple shape (zorder(1) always to send it back the grid).here can use curvature to play with round rectangle corners.)

PUBLIC oform
oform1=NEWOBJECT("ygrid_border_color")
oform1.Show
read events
RETURN

*
DEFINE CLASS ygrid_border_color AS form
	Height = 296+40
	Width = 700
	ShowWindow = 2
	AutoCenter = .T.
	showtips=.T.
	scalemode=3
	Caption = "Click shapes to change random color, pîcture or container borderWidth.can resize the form/grid"
	Name = "Form1"

	ADD OBJECT container1 AS ycont WITH ;
		Anchor = 15, ;
		Top = 12, ;
		Left = 30, ;
		Width = 655, ;
		Height = 265, ;
		BackStyle = 0, ;
		BorderWidth = 4, ;
		MousePointer = 15, ;
		BorderColor = RGB(255,128,64), ;
		Name = "Container1"

	ADD OBJECT shape1 AS shape WITH ;
		Top = 300+14, ;
		Left = 50, ;
		Height = 13, ;
		Width = 13, ;
		Anchor = 768, ;
		Curvature = 99, ;
		MousePointer = 15, ;
		ToolTipText = "Change random border  color (or click on container border)", ;
		BackColor = RGB(255,0,0), ;
		Name = "Shape1"

	ADD OBJECT shape2 AS shape WITH ;
		Top = 300+14, ;
		Left = 70, ;
		Height = 13, ;
		Width = 13, ;
		Anchor = 768, ;
		Curvature = 99, ;
		MousePointer = 15, ;
		ToolTipText = "Change container picture(empty=no picture)", ;
		BackColor = RGB(0,0,255), ;
		Name = "Shape2"

	ADD OBJECT spinner1 AS spinner WITH ;
		Height = 24,;
		KeyboardHighValue = 20,;
		KeyboardLowValue = 0,;
		Left = 90,;
		SpinnerHighValue =  20.00,;
		SpinnerLowValue =   0.00,;
		Top = 295+14,;
		Width = 48,;
		Anchor=768,;
                Value=4,;
		ToolTipText="container borderwidth (px)",;
	       Name = "Spinner1"

	PROCEDURE shape1.Click
	rand(-1)
	thisform.container1.BorderColor=RGB(255*rand(),255*rand(),255*rand())
	ENDPROC

	PROCEDURE shape2.Click
	WITH thisform.container1
	.picture=getpict()
	.BackStyle=1
	thisform.resize()
	endwith
	ENDPROC

	PROCEDURE Init
	local m.myvar
	text to m.myvar pretext 13 noshow
	/9j/4AAQSkZJRgABAQEAYABgAAD/2wBDAAMCAgMCAgMDAwMEAwMEBQgFBQQEBQoHBwYIDAoMDAsKCwsNDhIQDQ4RDgsLEBYQERMUFRUVDA8XGBYUGBIUFRT/2wBDAQMEBAUEBQkFBQkUDQsNFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBQUFBT/wAARCALuADIDASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREAAgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYkNOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOEhYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwCxp7dK6bT26Vymnt0rptPbpX8/45bn43g47HV6e3Sum09ulcpp7dK6fT26V+d45as+5wcdjq9PbpXTac3SuU09uldNp7fdr87xy3PuMHHU3w3FFMVuBRXzVj3eU+H9PbpXTae3SuU09uldLp7dK/rDHLc/nnBx2Os09uldNpzdK5TTm6V0+nt0r87xy3PucHHY6rT26V0+nN0rlNPbpXT6a3K1+eY5as+5wcTpFb5RzRUat8oor5mx7XKfDWnt0rptPbpXKae3Sul09ulf1ljlufz5g47HWac3Sum09ulcpp7dK6fT26V+dY5bn3ODjsdVp7dK6jTG5WuS09uldTpbfMK/O8ctz7jCROmVvlFFRBuBRXzVj1uU+GLBuldNpzdK5TT26V02nt0r+sMctz8Awcdjq9PbpXTae3SuV09uldLp7dK/PMctz7nBx2Os09uldTpLfMK5HT26V1ekt0r88xy3Pt8LHQ6YNwKKav3RRXzNj0+U+EtPbpXTae3SuU09uldNp7dK/rDHLc/BcHHY6vT26V0+nt0rk9PbpXT6e3SvzvHLc+5wcdjq9PbpXWaQ3ArjtPbpXYaSeBX55jlufa4de6jpVb5RRTV+6KK+asenY+DtPbkV02nt0rlNPbpXTae3Sv6vxy3PwfBx2Or09uldPp7dK5TT26V02nt0r89xy3PucHHY6vTW5FdjpLdK4nTW+Za7PST0r86xy3PsqC91HTq3yiimr90UV8zY9Gx8E6e3Sum09ulcpYN0rptObpX9Y45bn4Xg47HWae3Sul09ulcrp7dK6bT26V+eY5bn3ODjsdZpjfMtdrpDfdrh9LbpXaaO3QV+eY5bn2FFHTq3AopF+6KK+Zsdlj4EsG6V02nN0rlNPbpXTae3Sv6vxy3PxPBx2Or09uldNp7dK5XT26V0unt0r88xy3PucHHY7DST0rttJPSuF0huRXb6S3Svz3HLc+soo6dW+UUUxW+UUV81Y7LHwDp7dK6bT26Vymnt0rptPbpX9XY5bn4tg47HV6e3Sun05q5PT26V0+nt0r88x63PucHHU7PSW5Wu10g9K4bST0rttIbpX57jlufUUkdQrfKKKarfKKK+asdlj8/NPbpXTae3SuU09uldNp7dK/q7HLc/G8HHY6zT26V0+mtytcnp7dK6fTD8y1+eY5bn3ODidtpDdK7bSW6Vw+knpXbaS3Svz3HLc+jpI6Zfuiimq3yiivmrHZY/PiwbpXTae3SuV09uldNp7dK/q3HLc/IMHHY6vT26V1Glt8y1yWnt0rqdKbpX55jlufb4SJ3Gkt0rt9IbpXC6QeldvpLdK/Psctz6Ckjp1J2iimK3yj6UV81Y7LH56WDdK6bTm6Vyunt0rptPbpX9W45bn5Lg47HVae3Sur0lulcfp7dK63SG6V+eY5as+1w0dDudJbpXb6S3SuG0k9K7XSD0r8+xy3Peoo6hW+Uc0UxfuiivmrHZY/PHT26V0unt0rldPbpXTae3Sv6txy3PyjBx2Oq09uldhpJ+7XF6a3Suy0lulfneOW59pQj7qO30duFrttIbpXD6S3Su20k9K/P8ctz26SOoVvlH0oqNW+UUV81Y7bH526e3Sul09ulcrp7dK6XT26V/VmOW5+WYOOx1umtytdlo7dK4jTG+YV2mkN0r88xy3PsaCO50luldtpLcCuG0luldvpLdK/P8ctz2aSOlVvlFFIp+UUV81Y7LH50ae3Sum09ulcpp7dK6bT26V/VmOW5+ZYOOx12lnpXaaQ3SuH0luldrpDdK/PMctz62ijutJPSu10duVrh9JbpXa6S3Svz/ABy3PYpI6hW4FFMVvlFFfNWO2x+cmnt05zXTae3SuU09uldNp7dK/qvHLc/NcHHY7DSD0rttIPSuH0luldtpLdK/Psctz6qkjudJPSu20k9K4bSW6V2ukt0r8/xy3PYpI6hW+UUUxW+UUV81Y7bH5wae3Sum09ulcpp7dK6bTW5Ff1VjlufnGDidrpLdK7XSD0rh9Ib7tdro7civz7HLc+mpI7nSD0rt9JPSuG0luldtpLdK/P8AHLc9iijp1+6KKjVvlFFfNWOyx+bunt0rp9Mb5lrk9PbpXUaWeRX9VY5bn57hIncaS33a7XR25WuH0k8Cu20g8Cvz7HLc+ipI7nSW6V2uknla4bR26V2+kt8y1+f45bnsUkdKrcCikDcDmivmrHbY/NfT26V1OlN0rkdPbpXV6S3Sv6pxy3PgMLHQ7jSG6V2+knpXC6R2rt9JPSvz/HLc96kjuNIbpXb6S3SuG0k9K7bSTwK/P8ctz2KKOnX7ooqNW+UUV81Y7LH5p2Dciuu0lulcbp7dK6/ST0r+qcctz4PDx91HcaQ3Su30lulcNpDfdrtdIPyrX5/jlue7SR3WknpXbaQfu1wukHpXb6Selfn+OW57FJHTK3Aopqt8oor5qx2WPzP09uRXY6SelcVprfMK7LSG6V/VOOW58Lh1odxpDdK7fSW+Za4bR25Wu20nqK/P8ctz2qKO50luldrpLdK4fSf4a7XRz92vz/HLc9ikjqFb5RRUa/dFFfNWO2x+Z2mt8wrs9JbpXEaW3zCu00hulf1TjlufDUUdzpJ6V2uktwK4jSW6V22kNwK/P8ctz2KSO40duBXbaS3K1w2kN0rttJPSvz/HLc9ikjpg3Aopq/dFFfNWOyx+Zekt81dtpJ6Vw2knpXa6Q3Sv6pxy3Ph6SO60g/drtNJPSuI0hvmFdtpLdK/P8ctz2KSO50luldrpLdK4fSTwK7bSD92vgMctz2KSOlVvlFFMDcCivmrHbY/MzST0rtdIbpXD6SeldrpJ6V/VGOW58NSR3Wkt0rttIPArhdJbpXbaS3SvgMctz2KSO50duldvpLdK4bSW+7Xa6Qfu1+fY5bns0UdQrfKPpRUatwKK+asdlj8zNJbGK7XSW6VxGmcNj3rtNJPSv6qxy3Ph6KO40duVrt9JPSuG0luldtpDfdr8/wActz2KSO50k8Cu10g9K4bSG+7Xb6S3Svz/ABy3PYpI6dfuiimK3yiivmrHZY/M6xbbNiuy0g9K461+WYV12j9q/qfGLQ+GorY7nST0rttHPArhtJbpXbaS3Svgcctz2aKO50k9K7bST0rhtJbpXa6S3Svz/HLc9iijqFb5RRTFb5RRXzNjssfmvDxIK6nSG+7XMrw3410mknpX9T4r4T4XDrQ7jSG6V2+kt0rhtJPArtdIbpXweOW57VFHdaT2rtdIPSuG0huVrttJbkV+fY5bnsUkdQp+UUUxW+UUV81Y7LH5xFe9bukNnFY2K19J7V/UeI+FnweHXuo7nSW6V2ukN0rh9JPSu10g9K+Fxy3PcpI7nSG5Wu30k8rXDaS3Su20luBX5/jluexRR0w6CimK3yjmivmbHZY/PHbWhpZw1U9tXNO+WSv6hrbM+Awux22kt0rttJbpXDaTwBXa6QelfEY5bn0FJHdaSeBXa6Q3SuG0g8rXb6S3Svz/ABy3PYpI6dSdoopit8o+lFfNWOyx+f8AtqezGJhTNtSQDEgr+m6mzPz3CbHXaQ3K12+kt0rhdIbpXb6SelfG45bn0VJHcaQ3Su30lvu1w2knpXa6Qelfn+OW57FJHTK3AopF+6KK+Zsdtj4O20qjDD60/bQOGFf0vU2PznBnSaS3Su20hulcNpB4FdtpB6V8ljlufS0kdzpLdK7bR25WuG0g8rXbaSeRX5/jluexRR1Abgc0VEDwKK+asdlj4e20hWpdvzCjbwa/pCofm2D6Gro/BWu30lulcNpJ2sBXbaS3SvmMctz6mkjuNJbpXbaQ3Arh9JPSu10g9K/P8ctz2KSOnVvlFFNU/KKK+Zsdtj4q20bal20ba/ouofmOD6FnTfvV2ekN0rjLHibFdjpLdK+exqPraKO40huldvpDfMtcNpLdK7bSTytfn+OW57NFHTq3AoqMdBRXzVjtsfHW2jb7VJto21/QtQ/K8H0FtRtmFdbo56VycY2yKa6rSW6V4OM+E+xoLY7nSD92u10hvu1w2kN0rttJbpXwWOW57VJHUK3yiimK3yiivmrHZY+SNtJtqbbSFea/fah+U4PoRqu1h9a6TSW6Vz23pW9pLcivGxXwn2WHWiO40g9K7fST0rhdJbpXb6Q3SvhMctz3KSOnX7oopqt8oor5mx22PlbbSbal20m32r94qH5Jg+hHtrX0njArM21o6WcNj3rycR8J9rhvhO40hvu12ukH7tcNpDdK7fSW6V8Pjlue7SR06k7RRTVb5RRXzVjssfMe2jbUm2jbX7jU2PyHB9CLbVzTuJKrlansxiQV5dbZn22FOz0c9K7bST0rh9JPArtdIbgV8XjlufQUkdQv3RRUat8oor5mx22PnTb7UbeRUm2jbX7bUPxvB9CLbUluNsimjbToxtcGvMq9T7jBnVaS3Su10luBXD6S3zCu10k9K+Pxy3PpKSOnVvlFFIv3RRXzVjtseA7aNtS7aay81+y1D8XwfQj2+1A4NSbaTbXmVD7nB7m7pDdK7fSW6Vw2k9q7bST0r5bHLc+mpI6dW+UUUxW+UUV8zY7LHiO2k21LtpGWv1+ofieD6Ee2kZc4qXbSba86ofc4PoaGktjArtdJbpXEaXw+K7XST0r5vHLc+rpI6ZW+UUU1W+UUV81Y7bHjxWjbUm2jbX6xUPw7B9CLbRtqTbRt9q8+ofcYPoSWPE1dnpLcCuNtVxMK67R26V8/jUfYUUdOv3RRSK3yiivmrHZY8s20hWpdvtRtr9TqH4Zg+hFtpNtS7aNtedUPt8H0GxDEi11OkN0rmVGGFdJpLdK8TFr3T7Kh8KOoVvlFFRr90UV4Fj0TzzbSbal28ik21+lVD8EwfQj2+1JtqXbRtrzah9zg+hERxW7pDfdrG21r6TwRXj4j4WfaYdaI6dW+UUU1fuiivDPUscTto21Lto21+h1D+fsH0IttJtqXbSFa82ofc4PoR7a0NL4aqe2ren8SCvLrfCz7bDHSK3yiimK3yiivHPROZ20beRUm2jbX3lQ/n/B9CLbRtqXbSba82ofcYPoR7ansxiambeRT4PllH1rzamzPuMIbqk7RRUY6CivI5T1TJ20m2pdtJtr7mofz3g+hHt5FG2pNtG2vOqH3GD6EW2lXhx9ak20BcEV5lQ+4wm5pK3yiio1+6KK889or7aTbUu3kUlfZ1D+dMH0I9tG2pMUm2vMqH3GD6ETLzRtqXbRtrzqh9zg9yVW+UUVFuorlPcP/2Q==
    endtext

   strtofile(strconv(m.myvar,14),"ybg.png")  &&copied in default folder
	this.resize
	ENDPROC

	PROCEDURE spinner1.InteractiveChange
	WITH thisform.container1
	.BorderWidth= this.value
	.parent.resize()
	endwith
	ENDPROC

	PROCEDURE resize
	WITH this.container1.grid1
	.Left=.parent.BorderWidth
	.Top=.parent.BorderWidth
	.Width=.parent.Width-2*.parent.BorderWidth
	.Height=.parent.Height-2*.parent.BorderWidth
	endwith
	ENDPROC

	PROCEDURE Load
	Close Data All
	Sele * From Home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	Sele ycurs
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ygrid_border_color
*
DEFINE CLASS ycont AS container
	Anchor = 15
	Top = 12
	Left = 10
	Width = 655
	Height = 265
	BackStyle = 0
	BorderWidth = 4
	MousePointer = 15
	BorderColor = RGB(255,128,64)
	Name = "Container1"

	ADD OBJECT grid1 AS grid WITH ;
		Anchor = 0, ;
		Height = 193, ;
		Left = 13, ;
		Top = 14, ;
		Width = 543, ;
		Name = "Grid1"

	PROCEDURE Click
	rand(-1)
	this.BorderColor=RGB(255*rand(),255*rand(),255*rand())
	ENDPROC

	PROCEDURE grid1.Init
	WITH this
	.recordsource="ycurs"
	.recordsourcetype=1
	.deletemark=.F.
	.recordmark=.F.
	.highlightStyle=2
	.gridlines=0
	.fontsize=11
	.fontname="Courier new"
	.SetAll("DynamicBackColor",  "IIF(MOD(RECNO(), 2) = 0, RGB(255, 255, 255), RGB(255, 255, 190) )","column")
	.refresh
	endwith
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ycont



Grid cosmetics part 3
Grid cosmetics part 3
Grid cosmetics part 3
Grid cosmetics part 3
Grid cosmetics part 3

Click on code to select [then copy] -click outside to deselect


*2*Created on friday 28 of september 2018.
*can set the grid header caption (horizontal (default) or vertical ) only with native functions.here grid.themes=.f. to benefit with headers colors....(if .f. no colors)
*(another method can build at runtime a temporarly header picture with gdiplus or gdiplusX)
*can dblclik on any header to set the header caption horizontal/vertical(can switch between these 2 states)
*Note : can try another solution  if set grid.headerHeight=0 can add a container with labels adjusted to the headers and benefits of label.rotation combined with container.height...

PUBLIC oform
oform=NEWOBJECT("ygrid_headers")
oform.Show
read events
RETURN


DEFINE CLASS ygrid_headers AS form
	Height = 454+5
	Width = 732+10
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "DBLclick on any header to switch:Horizontal/Vertical header caption-resize the grid headerHeight-click the grid border to change theme."
	ycl = .F.
	Name = "Form1"

	ADD OBJECT grid1 AS grid WITH ;
		Height = 408, ;
		Left = 20, ;
		Top = 6, ;
		Width = 706, ;
		Name = "Grid1"

	ADD OBJECT spinner1 AS spinner WITH ;
		Anchor = 768, ;
		Height = 24, ;
		Left = 276, ;
		ToolTipText = "Grid HeaderHeight (can adjust directly on left grid headers", ;
		Top = 421+12, ;
		Width = 72, ;
		Value = 200, ;
		Name = "Spinner1"

	ADD OBJECT shape1 AS shape WITH ;
		mousepointer=15,;
		Name="shape1"

	PROCEDURE my
*--- aevent create an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	thisform.ycl=iif(thisform.ycl=.F.,.T.,.F.)

	WITH loObject
	x=allt(.Caption)

	if thisform.ycl=.T.
	.Caption=""
	u=""
	for i=1 to len(m.x)
	m.u=m.u+substr(m.x,i,1)+chr(13)
	endfor
	.Caption=m.u

	else

	.Caption=""
	.Caption=strtran(m.x,chr(13),"")
	endi

	.fontsize=14
	.fontbold=.T.
	endwith
	ENDPROC

	PROCEDURE Load
	Close Data All
	Sele * From Home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	Sele ycurs
	Locate
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC

	PROCEDURE grid1.Init
	WITH This
	.Themes=.F.  &&for headers properties ...bug in vfp9sp2
	.RecordSource="ycurs"
	.DeleteMark=.F.
	.GridLines=2    &&0,1,2,3
	.fontsize=11
	.FontName="courier new"
	.RowHeight=19
	.allowHeaderSizing=.T.  &&can resize the header height manually at runtime
	.HeaderHeight=200    &&.parent.spinner1.value   &&or adjust header height with mousedown on
	.Anchor=15
	.fontbold=.T.
	.SetAll("fontsize",12,"header" )
	.SetAll("fontbold",.T.,"header" )
	.SetAll("forecolor",255,"header" )

	rand(-1)
	for j=1 to .columncount
	bindevent(.columns(j).header1,"dblclick",thisform,"my")
	.columns(j).header1.backcolor=rgb(255*rand(),255*rand(),255*rand())
	.columns(j).header1.picture=   Home(1)+"graphics\icons\traffic\trffc"+trans(9+j)+".ico"
	endfor
	.AutoFit()
	.Refresh
	endwith

	local m.x,m.y
	m.x=5
	m.y=5
	WITH thisform.shape1
	.Anchor=0
	.curvature=10
	.Left=.parent.grid1.Left-m.x
	.Top=.parent.grid1.Top-m.y
	.Width=.parent.grid1.Width+2*m.x
	.Height=.parent.grid1.Height+2*m.y
	.zorder(1)
	.backcolor=rgb(255,25,40)
	.borderwidth=0
	endwith
	ENDPROC

	PROCEDURE spinner1.UpClick
	WITH thisform.grid1
	.HeaderHeight=This.Value
	endwith
	ENDPROC

	PROCEDURE spinner1.DownClick
	WITH thisform.grid1
	.HeaderHeight=This.Value
	endwith
	ENDPROC

	PROCEDURE resize
	local m.x,m.y
	m.x=5
	m.y=5
	WITH thisform.shape1
	.Anchor=0
	.curvature=10
	.Left=.parent.grid1.Left-m.x
	.Top=.parent.grid1.Top-m.y
	.Width=.parent.grid1.Width+2*m.x
	.Height=.parent.grid1.Height+2*m.y
	.zorder(1)
	.backcolor=rgb(255,25,40)
	.borderwidth=0
	endwith
	ENDPROC

	PROCEDURE shape1.click
	rand(-1)
	This.backcolor=rgb(255*rand(),255*rand(),255*rand())
	ENDPROC

ENDDEFINE
*
*-- EndDefine:ygrid_headers


grid headerHeight can be adjusted manually(mousedown) or by spinner on the form.

grid headerHeight can be adjusted manually(mousedown) or by spinner on the form.

Click on code to select [then copy] -click outside to deselect


*3*Created on monday 1 of october 2018.
*can set the grid header multiline caption (horizontal (default) or vertical ) only with native functions(here with  chr(13) strings  separations)
*can dblclik on any header to set the header caption horizontal/ multiline vertical(can switch between these 2 states)
*here grid.themes=.f. to benefit with headers colors....(if .f. no colors)

PUBLIC oform
oform=NEWOBJECT("ygrid_multiline_headers")
oform.Show
read events
RETURN


DEFINE CLASS ygrid_multiline_headers AS form
	Height = 454+5
	Width = 732+10
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "DBLclick on any header to switch:Horizontal/Vertical multiline header caption-resize the grid headerHeight-click the grid border to change theme."
	ycl = .F.
	Name = "Form1"

	ADD OBJECT grid1 AS grid WITH ;
		Height = 408, ;
		Left = 20, ;
		Top = 6, ;
		Width = 706, ;
		Name = "Grid1"

	ADD OBJECT spinner1 AS spinner WITH ;
		Anchor = 768, ;
		Height = 24, ;
		Left = 276, ;
		ToolTipText = "Grid HeaderHeight (can adjust directly on left grid headers", ;
		Top = 421+12, ;
		Width = 72, ;
		Value = 200, ;
		Name = "Spinner1"

	ADD OBJECT shape1 AS shape WITH ;
		mousepointer=15,;
		Name="shape1"

	PROCEDURE my
*--- aevent creates an array laEvents
	Aevents( myArray, 0)
*--- reference the calling object
	loObject = myArray[1]
	thisform.ycl=iif(thisform.ycl=.F.,.T.,.F.)

	WITH loObject
	x=strtran(allt(.Caption)," ",chr(13))

	if thisform.ycl=.T.
	.Caption=m.x

	else

	.Caption=strtran(m.x,chr(13)," ")
	endi

	.fontsize=14
	.fontbold=.T.
	endwith
	ENDPROC

	PROCEDURE Load
	Close Data All
	Sele * From Home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	Sele ycurs
	Locate
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC

	PROCEDURE grid1.Init
	local m.myvar
	TEXT to m.myvar   pretext 7 noshow
	this is header1
	this is header2
	this is header3
	this is header4
	this is header5
	this is header6
	this is header7
	this is header8
	this is header10
	this is header11
	this is header12
	ENDTEXT

	WITH this
	.Themes=.F.  &&for headers properties ...bug in vfp9sp2
	.RecordSource="ycurs"
	.DeleteMark=.F.
	.GridLines=2    &&0,1,2,3
	.fontsize=11
	.FontName="courier new"
	.RowHeight=19
	.allowHeaderSizing=.T.  &&can resize the header height manually at runtime
	.HeaderHeight=200    &&.parent.spinner1.value   &&or adjust header height with mousedown on
	.Anchor=15
	.fontbold=.T.
	.SetAll("fontsize",12,"header" )
	.SetAll("fontbold",.T.,"header" )
	.SetAll("forecolor",255,"header" )

	for i=1 to .columncount
	.columns(i).header1.Caption=allt(mline(m.myvar,i))+" "+.columns(i).header1.Caption
	endfor


	rand(-1)
	for j=1 to .columncount
	bindevent(.columns(j).header1,"dblclick",thisform,"my")
	.columns(j).header1.backcolor=rgb(255*rand(),255*rand(),255*rand())
	.columns(j).header1.picture=   Home(1)+"graphics\icons\traffic\trffc"+trans(9+j)+".ico"
	endfor
	.AutoFit()
	.Refresh
	endwith

	local m.x,m.y
	m.x=5
	m.y=5
	WITH thisform.shape1
	.Anchor=0
	.curvature=10
	.Left=.parent.grid1.Left-m.x
	.Top=.parent.grid1.Top-m.y
	.Width=.parent.grid1.Width+2*m.x
	.Height=.parent.grid1.Height+2*m.y
	.zorder(1)
	.backcolor=rgb(255,25,40)
	.borderwidth=0
	endwith
	ENDPROC

	PROCEDURE spinner1.UpClick
	WITH thisform.grid1
	.HeaderHeight=this.Value
	endwith
	ENDPROC

	PROCEDURE spinner1.DownClick
	WITH thisform.grid1
	.HeaderHeight=this.Value
	endwith
	ENDPROC

	PROCEDURE resize
	local m.x,m.y
	m.x=5
	m.y=5
	WITH thisform.shape1
	.Anchor=0
	.curvature=10
	.Left=.parent.grid1.Left-m.x
	.Top=.parent.grid1.Top-m.y
	.Width=.parent.grid1.Width+2*m.x
	.Height=.parent.grid1.Height+2*m.y
	.zorder(1)
	.backcolor=rgb(255,25,40)
	.borderwidth=0
	endwith
	ENDPROC

	PROCEDURE shape1.click
	rand(-1)
	this.backcolor=rgb(255*rand(),255*rand(),255*rand())
	ENDPROC

ENDDEFINE
*
*-- EndDefine:ygrid_multiline_headers


A sdimple way to build multiline header in grid.

A sdimple way to build multiline header in grid.

Click on code to select [then copy] -click outside to deselect


*4*created on tuesday 2 of October 2018
*the code draws a simple colored border with the vfp function Box()
*this is a solution to simulate a grid border (native border  is vfp system window border and don't have any property to change borderWidth,Bordercolor).

PUBLIC oform
oform1=NEWOBJECT("ygrid_border_color")
oform1.Show
read events
RETURN
*
DEFINE CLASS ygrid_border_color AS form
	Height = 296+40
	Width = 700
	ShowWindow = 2
	AutoCenter = .T.
	showtips=.T.
	scalemode=3
	Caption = "draw a simple border on the grid.can resize the form/grid"
	Name = "Form1"

	ADD OBJECT grid1 AS grid WITH ;
		Anchor = 15, ;
		Height =310, ;
		Left =10, ;
		Top = 10, ;
		Width = 670, ;
		Name = "Grid1"

	PROCEDURE grid1.Init
	WITH this
	.recordsource="ycurs"
	.recordsourcetype=1
	.deletemark=.F.
	.recordmark=.F.
	.highlightStyle=2
	.gridlines=0
	.fontsize=11
	.fontname="Courier new"
	.SetAll("DynamicBackColor",  "IIF(MOD(RECNO(), 2) = 0, RGB(255, 255, 255), RGB(255, 255, 190) )","column")
	.refresh
	endwith
	ENDPROC


	PROCEDURE resize  &&draw a simple rectangle bounding the grid with any choosen color
	thisform.cls
	thisform.forecolor=rgb(0,0,64)   &&&getcolor()
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+2+thisform.grid1.Width,thisform.grid1.Top+2+thisform.grid1.Height)
	ENDPROC



	PROCEDURE Load
	Close Data All
	Sele * From Home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	Sele ycurs
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC


ENDDEFINE
*
*-- EndDefine: ygrid_border_color



Grid cosmetics part 3

Click on code to select [then copy] -click outside to deselect


*5*  created on tuesday 2 of october 2018
*this code can create a dynamic border on any vfp control on a form
*it creates a shape on MouseEnter event of any control and destry it at mouseLeave event.
*the shape  bordercolor and the borderwidth can be modified in code

PUBLIC oform
oform=NEWOBJECT("ycontrols_borders")
oform.Show
RETURN

DEFINE CLASS ycontrols_borders AS form
	Height = 423
	Width = 1040
	ShowWindow = 2
	AutoCenter = .T.
	maxbutton=.f.
	borderstyle=0
	Caption = "Drawing a border on any vfp control with a shape on mouseenter event-destroy it on MouseLeave event."
	Name = "Form1"

	ADD OBJECT text1 AS textbox WITH ;
		Value = "this is a textbox", ;
		Height = 23, ;
		Left = 36, ;
		Top = 24, ;
		Width = 100, ;
		Name = "Text1"

	ADD OBJECT label1 AS label WITH ;
		Caption = "Label1", ;
		Height = 17, ;
		Left = 168, ;
		Top = 24, ;
		Width = 144, ;
		Name = "Label1"

	ADD OBJECT edit1 AS editbox WITH ;
		Height = 120, ;
		Left = 36, ;
		Top = 60, ;
		Width = 100, ;
		Value = "This is an editbox", ;
		Name = "Edit1"

	ADD OBJECT command1 AS commandbutton WITH ;
		Top = 24, ;
		Left = 360, ;
		Height = 48, ;
		Width = 84, ;
		Caption = "Command1", ;
		Name = "Command1"

	ADD OBJECT combo1 AS combobox WITH ;
		Height = 24, ;
		Left = 180, ;
		Top = 84, ;
		Width = 100, ;
		Name = "Combo1"

	ADD OBJECT grid1 AS grid WITH ;
		Height = 200, ;
		Left = 240, ;
		Top = 192, ;
		Width = 480, ;
		Name = "Grid1"

	ADD OBJECT image1 AS image WITH ;
		Picture = home(1)+"graphics\icons\misc\misc15.ico", ;
		Stretch = 2, ;
		BackStyle = 0, ;
		Height = 96, ;
		Left = 540, ;
		Top = 12, ;
		Width = 121, ;
		Name = "Image1"

	ADD OBJECT pageframe1 AS pageframe WITH ;
		ErasePage = .T., ;
		PageCount = 2, ;
		Top = 12, ;
		Left = 732, ;
		Width = 265, ;
		Height = 169, ;
		Name = "Pageframe1", ;
		Page1.Caption = "Page1", ;
		Page1.Name = "Page1", ;
		Page2.Caption = "Page2", ;
		Page2.Name = "Page2"

	ADD OBJECT container1 AS container WITH ;
		Top = 204, ;
		Left = 768, ;
		Width = 169, ;
		Height = 97, ;
		Name = "Container1"

	ADD OBJECT list1 AS listbox WITH ;
		Height = 133, ;
		Left = 36, ;
		Top = 204, ;
		Width = 109, ;
		Name = "List1"

	PROCEDURE my1
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	*--- aevent creates an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]

	WITH thisform
	.addObject("shape1","shape")
	WITH .shape1  &&can modify the shape border width
	.Left=loObject.Left-1
	.Top=loObject.Top-1
	.Width=loObject.Width+2
	.Height=loObject.Height+2
	.zorder(1)
	.bordercolor=255
	.borderwidth=1
	.visible=.T.
	endwith
	endwith
	ENDPROC


	PROCEDURE my2
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	*--- aevent creates an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	thisform.removeObject("shape1")
	ENDPROC


	PROCEDURE Init
	WITH thisform
	for i=1 to .controlcount
	bindevent(.controls(i),"mouseEnter",thisform,"my1")
	bindevent(.controls(i),"mouseLeave",thisform,"my2")
	endfor
	endwith
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC

	PROCEDURE grid1.Init
	Sele * From home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	WITH this
	.recordsource="ycurs"
	.recordsourcetype=1
	.deletemark=.F.
	.recordmark=.F.
	.highlightStyle=2
	.gridlines=0
	.fontsize=11
	.fontname="Courier new"
	.SetAll("DynamicBackColor",  "IIF(MOD(RECNO(), 2) = 0, RGB(255, 255, 255), RGB(0, 255, 190) )","column")
	.refresh
	endwith
	ENDPROC

ENDDEFINE
*
*-- EndDefine: ycontrols_borders


Grid cosmetics part 3

Click on code to select [then copy] -click outside to deselect


*6*created on wednesday 3 of October 2018
*the code draws  simple colored borders with the vfp functions Box() and lines()
*this is a solution to simulate a grid border (native border  is vfp system window border and don't have any property to change borderWidth,Bordercolor).
*a dummy textbox is added to the form to switch between colors of active grid/inactive and when(),valid(à event to play with grid focusings.
*active/inactive olors can be selected with  2 shapes bottom the form.

PUBLIC oform
oform1=NEWOBJECT("ygrid_border_color")
oform1.Show
read events
RETURN
*
DEFINE CLASS ygrid_border_color AS form
	Height =365
	Width = 700
	ShowWindow = 0  && works for 2 also
	AutoCenter = .T.
	showtips=.T.
	scalemode=3
	ycl=0
	Caption = "draw a simple border on the grid.can resize the form/grid"
	Name = "Form1"

	ADD OBJECT grid1 AS grid WITH ;
		themes=.T.,;
		Anchor = 15, ;
		AllowHeaderSizing=.F.,;
		fontsize=12,;
		fontbold=.T.,;
		Height =300, ;
		Left =10, ;
		Top = 10, ;
		Width = 670, ;
		Name = "Grid1"

	ADD OBJECT shp1 AS shape WITH ;
		Anchor =768,;
		Left=15,;
		Top=338,;
		Width=13,;
		Height=13,;
		curvature=99,;
		backcolor=rgb(192,192,192),;
		mousepointer=15,;
		tooltiptext="Inactive border color",;
		Name="shp1"

	ADD OBJECT shp2 AS shape WITH ;
		Anchor =768,;
		Left=34,;
		Top=338,;
		Width=13,;
		Height=13,;
		curvature=99,;
		backcolor=255,;
		mousepointer=15,;
		tooltiptext="active border color",;
		Name="shp2"

	ADD OBJECT text1 AS textbox WITH ;
		Top =335, ;
		Left = 312, ;
		Height = 27, ;
		Width=50 ,;
		Anchor = 768, ;
		tooltiptext="switch grid border colors active/inactive"
	Name = "text1"

	PROCEDURE grid1.Init
	WITH this
	.recordsource="ycurs"
	.recordsourcetype=1
	.deletemark=.F.
	.recordmark=.F.
	.highlightStyle=2
	.gridlines=0   &&3
	.fontsize=11
	.fontname="Courier new"
	.headerHeight=27
	*.scrollbars=3
	.SetAll("DynamicBackColor",  "IIF(MOD(RECNO(), 2) = 0, RGB(255, 255, 255), RGB(255, 255, 190) )","column")
	.refresh
	endwith
	ENDPROC

	PROCEDURE shp1.click
	local m.x
	m.x=getcolor()
	if !m.x=-1
	this.backcolor=m.x
	endi
	ENDPROC

	PROCEDURE shp2.click
	local m.x
	m.x=getcolor()
	if !m.x=-1
	this.backcolor=m.x
	endi
	ENDPROC

	PROCEDURE grid1.when
	thisform.ycl=1
	thisform.resize()
	ENDPROC

	PROCEDURE grid1.valid
	thisform.ycl=2
	thisform.resize()
	ENDPROC

	PROCEDURE grid1.mouseWheel
	LPARAMETERS nDirection, nShift, nXCoord, nYCoord
	*if ndirection>0
	thisform.grid1.refresh  && avoid persistent drawing
	*endi
	ENDPROC

	PROCEDURE resize  &&draw a simple rectangle bounding the grid with any choosen color  and headers bottom border
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	thisform.cls
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+2+thisform.grid1.Width,thisform.grid1.Top+2+thisform.grid1.Height)
	WITH thisform
	.drawWidth=2
	try
	.AddObject('Line1','Line')
	catch
	endtry
	WITH .line1
	.Left=thisform.grid1.Left+2
	.Top=thisform.grid1.Top+thisform.grid1.headerHeight
	.Width=thisform.grid1.Width-4-15
	.borderWidth=thisform.drawWidth
	.Height=1
	.bordercolor=iif(thisform.ycl=1,thisform.shp2.backcolor,thisform.shp1.backcolor)
	.zorder(0)
	.visible=.T.
	.zorder(0)
	.Top=.Top
	endwith
	
	thisform.cls
	thisform.forecolor=iif(thisform.ycl=1,thisform.shp2.backcolor,thisform.shp1.backcolor)
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+2+thisform.grid1.Width,thisform.grid1.Top+2+thisform.grid1.Height)
	.refresh
	endwith

	ENDPROC

	PROCEDURE Load
	Close Data All
	Sele * From Home(1)+"samples\data\customer"  Into Cursor ycurs Readwrite
	Sele ycurs
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC
  
ENDDEFINE
*
*-- EndDefine: ygrid_border_color



Grid cosmetics part 3

Click on code to select [then copy] -click outside to deselect



*7* created on wednesday 3 of october 2018
*using the property grid.themes=.f. can colorize the grid.headers(that is not possible with grid.themes=.t.)-here headers are colorized randomly(can make option for fixed colors or one color....)
*adding a dummy textbox can switch active/inactive grid (here random colors in active grid.header and gray for inactive)
*this draws also a outer border around the grid.


PUBLIC oform
oform=NEWOBJECT("ygrid_colorized_headers")
oform.Show
RETURN

*
DEFINE CLASS ygrid_colorized_headers AS form
	Height = 563
	Width = 1136
	ShowWindow = 2
	ShowTips = .T.
	AutoCenter = .T.
	Caption = "Form1"
	Name = "Form1"

	ADD OBJECT grid1 AS grid WITH ;
		Height = 499, ;
		Left = 11, ;
		ScrollBars = 3, ;
		Top = 12, ;
		Width = 1109, ;
		Name = "Grid1"

	ADD OBJECT text1 AS textbox WITH ;
		Anchor = 768, ;
		Height = 25, ;
		Left = 588, ;
		ToolTipText = "Dummy textbox to switch active/inactive colors", ;
		Top = 525+5, ;
		Width = 84, ;
		Name = "Text1"

	PROCEDURE Activate
	thisform.cls
	thisform.forecolor=255
	thisform.drawWidth=2
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+3+thisform.grid1.Width+15,thisform.grid1.Top+3+thisform.grid1.Height+15)
	ENDPROC

	PROCEDURE Resize
	thisform.grid1.when()
	ENDPROC

	PROCEDURE Destroy
	clea events
	ENDPROC

	PROCEDURE grid1.Valid
	WITH thisform.grid1
	for i=1 to .columncount
	.columns(i).header1.backcolor=rgb(225,225,225)
	endfor
	.refresh
	endwith

	thisform.cls
	thisform.forecolor=rgb(192,192,192)
	thisform.drawWidth=2
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+3+thisform.grid1.Width,thisform.grid1.Top+3+thisform.grid1.Height)
	ENDPROC

	PROCEDURE grid1.when
	local m.x
	WITH thisform.grid1
	for i=1 to .columncount
	m.x=rgb(255*rand(),255*rand(),255*rand())
	if m.x=0
	m.x=rgb(255*rand(),255*rand(),255*rand())
	endi
	.columns(i).header1.backcolor=m.x

	endfor
	.refresh
	endwith

	thisform.cls
	thisform.forecolor=255
	thisform.drawWidth=2
	thisform.box(thisform.grid1.Left-1,thisform.grid1.Top-1,thisform.grid1.Left+3+thisform.grid1.Width,thisform.grid1.Top+3+thisform.grid1.Height)
	ENDPROC

	PROCEDURE grid1.Init
	sele * from home(1)+"samples\data\customer" into cursor ycurs readWrite

	rand(-1)
	WITH this
	.themes=.F.
	.Anchor=15
	.recordsource="ycurs"
	.recordsourcetype=1
	.headerHeight=30
	.deletemark=.F.
	.gridlines=2
	.autofit()

	for i=1 to .columncount
	.columns(i).header1.backcolor=rgb(255*rand(),255*rand(),255*rand())
	.columns(i).header1.fontbold=.T.
	.columns(i).header1.fontsize=12
	bindevent(.columns(i).header1,"mouseEnter",thisform,"my")
	bindevent(.columns(i).header1,"mouseLeave",thisform,"my1")
	endfor

	.highlightStyle=2
	.fontname="Courier new"
	.SetAll("DynamicBackColor",  "IIF(MOD(RECNO(), 2) = 0, RGB(255, 255, 255), RGB(255, 255, 190) )","column")
	.refresh


	endwith
	ENDPROC

	PROCEDURE my
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	*--- aevent creates an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	loObject.mousepointer=15
	loObject.fontunderline=.T.
	ENDPROC

	PROCEDURE my1
	LPARAMETERS nButton, nShift, nXCoord, nYCoord
	*--- aevent creates an array laEvents
	Aevents( myArray, 0)
	*--- reference the calling object
	loObject = myArray[1]
	loObject.mousepointer=0
	loObject.fontunderline=.F.
	ENDPROC


ENDDEFINE
*
*-- EndDefine: ygrid_colorized_headers



Grid cosmetics part 3
Grid cosmetics part 3

                     

Yousfi Benameur


Important:All Codes above are tested on VFP9SP2 & windows 10 pro 64 bits version 1803 . Navigator: firefox 62.0.2 64 bits - screen:32 pouces.

To be informed of the latest articles, subscribe:
Comment on this post
A
awesome
Reply
A
super!! machaallah
Reply
H
amazing!!! .. you are the best!
Reply