VFP grid Cosmetics Part I
-The vfp grid have many PEM to beautify it and make it some attractive.
This code test many methods to do that purpose .
this native grid utility can do the follows :
-Generates random dynamic lighten backcolors for grid rows(can fix color).
-Generates random dynamic backcolors for headers (can fix color).
-Generates random lighten colors for columns
-Generates random forecolor for grid rows or one forecolor fixed.
-Sort any header /column ascending or descending when checked (cansort checkbox).
-adjust grid rowHeight
-Clear any formatting (this is manadatory fo r certains tasks as random rowscolors)
-set new fontname,fontsize
-Rightclick on any form point to fire a contextuel menu or on left button.
-can generate random lighten color rows or checkboards on grid.
-gridlines: click successively to obtain the values 0,1,2,3 possibles
test the control buttons below the grid and the contextuel menu to see all these cosmetics and how to make them.
*copy the code (CTRL+C) to ygrid_cosmetics.prg
*download the 4 pictures in 2nd section to your source folder (as prg) and run the code
*can use the APIs (in previous post) or gdiplusX to make gradients images
*Begin code
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
Set Safe Off
*form.picture encoded--decoded
Local m.ystr
TEXT to m.ystr noshow
iVBORw0KGgoAAAANSUhEUgAAASwAAAAgCAYAAACoyEW6AAAAAXNSR0IArs4c6QAAAARnQU1BAACxjwv8YQUAAAAJcEhZcwAADsQAAA7EAZUrDhsAAAPsSURBVHhe7d3bbtpYFMbxzyYYMBQwJOHUTNOkTdRe9jlyk5fI4/ayVU40nZQAIWCgnAzBnrXdPdJIE6n4wsxcfD9pS4k33P61FkqEcXFxEfR6PRAR/d8ZZ2dnQTKZ1L/Kg/Ua5moFIwhgJhL6KRHR9vjSocAw4Eubgn90yDg/Pw/0z6HnnR1M63UEvo9Zt6ufEhFtj12pwDBNZB8esPP8rJ++EKz+6SkGJyeYyBtmr1+HpfNl2iIiipspU5Xa7OwfP5CTgal0dYXy5aW+fSFYw7dvMTw+xiyfx9RxYMlIluBqSERbsJYBablaIeu6sMdjFG9vUfz2Td/+JlizbBbHR0fhISKK222zGR57Oo0YrEwGs1wOf8haePDmjb4lIorP/ffv+FPWQXsygT2fRwhWKoWFbaOhgiWHiChu9xKrlpz0bAbb8zYP1tSyMEsmwwmr0WjoWyKi+LRarV8Tlvoca7mMMGGZJhaJRDhhMVhEtA0qWOGEtV7D9v0IwQoCLCRatVqNwSKirVDBarfbSEusbMOIECwpnCfRqkqs6hItIqK4PUisOhKtlMTKlg1v82DJ/riQaFWrVVTrdX1LRBSfzsMDOp0O0uqPRy1r82DNVbA8DxUVrP19fUtEFJ/O4yO6KlipFDKRgjWfYzGdYk/WQQaLiLZBBaunPsPKZpHJZCKshBKrpZzd3d1wLSQiiptaB5+enmBJsGw5mwdrPMZyNMJepYL9vT19S0QUn8deD71uF1ahADufj7ASui684RBlidW+TFlERHF7lOmqL9FKFYvIOM7mwVr0+/DkqGDtlsv6logoPk/SnDBY0py0nM0nLBnLlvJGR6YrBouItkEFy1WfYcmglKlUIkxY7TY8iZYjY1mZKyERbUFfYuW6LlISq3StFiFYrRY8OY5MV6VSSd8SEcVnMBjAlSkr1WggLWfzYN3fh0dNWCU5RERxG8h0pSas9MFBeDYO1kxe9CzByhcKcIpFfUtEFB93OMR4NMKOxMqWFm3+oXuzidXdHfL5PByJFhFR3FyJ1Xg8RvLwEJmjowgr4c0NvOvrcMIqSrSIiOI2lFipCSv1/j3S795tHizv6gqLy0sUVLBevdK3RETxGf78iZEEK316itTJSYQJ68sXLL9+Df+fJ5fL6VsiovhMJpPw/5itDx+Q/vjx98FyZW8cyig2//wZSznqS1R939e3RETxMU0z/DJV69MnZOQUb27gNJv69qUJ6/AQruyPvuti1W7rp0RE25Os1WA6DpzraxTv7vTTF4Il4xQCqZyRTMKwLP2QiGh7guUSwWoFQ2130qO//TtYsgKGLyIi+o+p4QmyIv4C/AWzh0l/NiQaSgAAAABJRU5ErkJggg==
ENDTEXT
=Strtofile(Strconv(m.ystr,14),"ypict.png")
Inkey(0.3)
*create contextuel menu in source folder
Local m.myvar
TEXT to m.myvar noshow
DEFINE POPUP raccourci SHORTCUT RELATIVE FROM MROW(),MCOL()
DEFINE BAR 1 OF raccourci PROMPT "Gridlines" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 2 OF raccourci PROMPT "Random header colors" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 3 OF raccourci PROMPT "Random dynamic rows colors" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 4 OF raccourci PROMPT "Grid forecolor" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 5 OF raccourci PROMPT "random columns colors" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 6 OF raccourci PROMPT "Refresh grid" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 7 OF raccourci PROMPT "Grid FontName/fontsize" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 8 OF raccourci PROMPT "Summary help" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 9 OF raccourci PROMPT "Default folder" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 10 OF raccourci PROMPT "increase grid rowHeight" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 11 OF raccourci PROMPT "Change form picture" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 12 OF raccourci PROMPT "clear any grid formatting" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 13 OF raccourci PROMPT "grid random checkBoards" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 14 OF raccourci PROMPT "gread headers green-black" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 15 OF raccourci PROMPT "Add header pictures" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
ON SELECTION BAR 1 OF raccourci ;
DO _4a517tony ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 2 OF raccourci ;
DO _4a517tooe ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 3 OF raccourci ;
DO _4a517toof ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 4 OF raccourci ;
DO _4a517toog ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 5 OF raccourci ;
DO _4a517tooh ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 6 OF raccourci _screen.activeform.grid1.refresh
ON SELECTION BAR 7 OF raccourci ;
DO _4a517tooi ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 8 OF raccourci ;
DO _4a517tooj ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 9 OF raccourci set defa to (yrep)
ON BAR 10 OF raccourci ACTIVATE POPUP increasegr
ON SELECTION BAR 11 OF raccourci ;
DO _4a517took ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 12 OF raccourci ;
DO _4a517tool ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 13 OF raccourci ;
DO _4a517toom ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 14 OF raccourci ;
DO _4a517toot ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 15 OF raccourci ;
DO _4a517toou ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
DEFINE POPUP increasegr SHORTCUT RELATIVE
DEFINE BAR 1 OF increasegr PROMPT "increase rowheight" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
DEFINE BAR 2 OF increasegr PROMPT "decrease rowHeight" ;
FONT "Courier New", 8 style "BI" COLOR G/W*, R/W*,,,,W+/GR
ON SELECTION BAR 1 OF increasegr ;
DO _4a517toov ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ON SELECTION BAR 2 OF increasegr ;
DO _4a517toow ;
IN LOCFILE("JUSTN\YMENU" ,"MPX;MPR|FXP;PRG" ,"WHERE is YMENU?")
ACTIVATE POPUP raccourci
*
PROCEDURE _4a517tony
with _screen.activeform.grid1
try
.gridlines=.gridlines+1 &&0,1,2,3
catch
.gridlines=0
endtry
.refresh
endwith
*
PROCEDURE _4a517tooe
Local m.x
m.x='rgb('+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+')' &&unique color
with _screen.activeform.grid1
.SetAll("BackColor",Eval(m.x),"header")
.Refresh
endwith
*
PROCEDURE _4a517toof
*random lines lighten colors level=65%
_screen.activeform.command4.click()
retu
Local lnRed,lnGreen,lnBlue,t,level,x
tnlevel=0.65
lnRed =Int(255*Rand())
lnGreen = Int(255*Rand())
lnBlue = Int(255*Rand())
*m.x='rgb('+Trans(lnRed,'999')+','+Trans(lnGreen,'999')+','+Trans(lnBlue)+')'
*lighten color
m.x='RGB('+trans( lnRed + ((255 - lnRed ) * tnLevel))+','+;
trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
trans( lnBlue + ((255 - lnBlue ) * tnLevel) )+')'
With _screen.activeform.grid1
.SetAll("DynamicBackColor","IIF(MOD(recno(), 2)=0, RGB(255,255,255) ,"+m.x +")" , "Column")
.Refresh
Endwith
*
PROCEDURE _4a517toog
Local lnRed,lnGreen,lnBlue,t,level,x
tnlevel=-0.35 &&darken
lnRed = Int(255*Rand())
lnGreen = Int(255*Rand())
lnBlue = Int(255*Rand())
*Darken color
* m.x='RGB('+trans( lnRed + ((255 - lnRed ) * tnLevel))+','+;
trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
trans( lnBlue + ((255 - lnBlue ) * tnLevel) )+')'
m.x='RGB('+trans(int(lnRed + (lnRed * tnLevel)))+','+ ;
trans(int(lnGreen + (lnGreen * tnLevel)))+','+ ;
trans(int(lnBlue + (lnBlue * tnLevel)) )+')'
with _screen.activeform.grid1
for i=1 to .columncount
if vartype(.columns(i).mycnt)="O"
.columns(i).mycnt.setall("forecolor",eval(m.x),"textbox")
else
.forecolor=eval(m.x)
endi
endfor
.refresh
endwith
*
PROCEDURE _4a517tooh
*random columns lighten colors
With _Screen.ActiveForm.grid1
local m.x,lnRed,lnGreen,lnBlue,tnlevel
tnlevel=0.75
for i=1 to .columncount
lnRed =int(255*rand())
lnGreen=int(255*rand())
lnBlue =int(255*rand())
*m.x='rgb('+trans(lnRed)+','+trans(lnGreen)+','+trans(lnBlue)+')'
m.x='RGB('+trans( lnRed + ((255 - lnRed ) * tnLevel))+','+;
trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
trans( lnBlue + ((255 - lnBlue ) * tnLevel) )+')'
.columns(i).dynamicBackColor=eval('"'+m.x+'"')
endfor
.Refresh
Endwith
retu
*
PROCEDURE _4a517tooi
local xfont
m.xfont=getfont()
if ! empty(m.xfont)
m.xfontname=getwordnum(m.xfont,1,',')
m.xfontsize=getwordnum(m.xfont,2,',')
with _screen.activeform.grid1
for i=1 to .columncount
if vartype(.columns(i).myCNT)="O"
.columns(i).myCNT.text1.fontname=m.xfontname
.columns(i).myCNT.text1.fontSize=int(val(m.xfontsize))
else
.fontname=m.xfontname
.fontsize=int(val(m.xfontsize))
endi
endfor
.refresh
endwith
endi
*
PROCEDURE _4a517tooj
_screen.activeform.yhelp.click()
*
PROCEDURE _4a517took
local m.xpict
m.xpict=getpict()
if empty(m.xpict)
return .f.
endi
_screen.activeform.picture=m.xpict
*
PROCEDURE _4a517tool
* Clear the current grid dynamic fore and back colors
with _screen.activeform.grid1
.SetAll("dynamicbackcolor", "", "Column")
.SetAll("dynamicforecolor", "", "Column")
.refresh
endwith
*
PROCEDURE _4a517toom
&& checkerboard
with _screen.activeform.grid1
.SetAll("dynamicforecolor", "RGB(255,255,255)", "Column")
FOR i = 1 TO .ColumnCount
IF i % 2 = 0
.Columns(i).dynamicbackcolor = "IIF(RECNO()%2 = 0, 255*RGB(255,0,0),255* RGB(255*rand(),255*rand(),0))"
ELSE
.Columns(i).dynamicbackcolor = "IIF(RECNO()%2 = 0,255* RGB(255*rand(),0,255*rand()),255* RGB(255,0,0))"
ENDIF
ENDFOR
.refresh
endwith
retu
*
PROCEDURE _4a517toot
With _Screen.ActiveForm.grid1
For i=1 To .ColumnCount
.Columns(i).header1.BackColor=0
.Columns(i).header1.ForeColor=Rgb(0,255,0)
Endfor
.Refresh
Endwith
*
PROCEDURE _4a517toou
local gnbre
gnbre=adir(gabase,home(1)+"GRAPHICS\BITMAPS\OFFCTLBR\SMALL\COLOR\*.bmp")
with _screen.activeform.grid1
for i=1 to .columncount
try
.columns(i).header1.picture=home(1)+"GRAPHICS\BITMAPS\OFFCTLBR\SMALL\COLOR\"+gabase(i,1)
catch
endtry
endfor
endwith
*
PROCEDURE _4a517toov
with _screen.activeform.grid1
.rowHeight=.rowHeight+1
.parent.spinner2.value=.parent.spinner2.value+1
endwith
*
PROCEDURE _4a517toow
with _screen.activeform.grid1
if .rowHeight>16
.rowHeight=.rowHeight-1
.parent.spinner2.value=.parent.spinner2.value-1
endi
endwith
ENDTEXT
=Strtofile(m.myvar,"ymenu.mpr")
*Create the form with class
Publi yform
yform=Newobject("ygcosmetics" )
yform.Show
Read Events
Return
*
Define Class ygcosmetics As Form
Height = 580
Width = 900
ShowWindow = 2
ShowTips = .T.
AutoCenter = .T.
Picture = "ypict.png"
Caption = "VFP Grid cosmetics -part I-"
xpict = .F.
yclick = 0
ycheck = .F.
yord = .F.
Name = "Form1"
Add Object grid1 As Grid With ;
FontBold = .T., ;
FontSize = 10, ;
Anchor = 15, ;
DeleteMark = .F., ;
Height = 489, ;
Left = 2, ;
RowHeight = 19, ;
Top = 39, ;
Width = 898, ;
HighlightStyle = 1, ;
Name = "Grid1"
Add Object command4 As CommandButton With ;
Top = 547, ;
Left = 0, ;
Height = 25, ;
Width = 132, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Random Dbackcolors", ;
BackColor = Rgb(0,255,0), ;
Name = "Command4"
Add Object check1 As Checkbox With ;
Top = 551, ;
Left = 723, ;
Height = 17, ;
Width = 67, ;
FontBold = .T., ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "Can Sort", ;
ForeColor = Rgb(0,0,160), ;
Name = "Check1"
Add Object command5 As CommandButton With ;
Top = 547, ;
Left = 133, ;
Height = 25, ;
Width = 134, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Random header colors", ;
BackColor = Rgb(0,255,0), ;
Name = "Command5"
Add Object command6 As CommandButton With ;
Top = 547, ;
Left = 283, ;
Height = 25, ;
Width = 117, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Light Grid Forecolor", ;
BackColor = Rgb(0,255,0), ;
Name = "Command6"
Add Object yhelp As CommandButton With ;
Top = 547, ;
Left = 283, ;
Height = 25, ;
Width = 117, ;
visible=.F. ,;
Anchor = 768, ;
Caption = "Help", ;
BackColor = Rgb(0,255,0), ;
Name = "yhelp"
Add Object spinner2 As Spinner With ;
Anchor = 768, ;
Height = 25, ;
KeyboardHighValue = 100, ;
KeyboardLowValue = 15, ;
Left = 671, ;
SpinnerHighValue = 100.00, ;
SpinnerLowValue = 15.00, ;
ToolTipText = "RowHeight", ;
Top = 547, ;
Width = 50, ;
Value = 22, ;
Name = "Spinner2"
Add Object shape1 As Shape With ;
Top = 0, ;
Left = 312, ;
Height = 37, ;
Width = 277, ;
BackStyle = 0, ;
BorderStyle = 0, ;
ToolTipText = "Rightclick to fire the contextuel menu", ;
Name = "Shape1"
Add Object check2 As Checkbox With ;
Top = 552, ;
Left = 794, ;
Height = 17, ;
Width = 101, ;
FontBold = .T., ;
Anchor = 768, ;
AutoSize = .T., ;
Alignment = 0, ;
BackStyle = 0, ;
Caption = "+-CheckBoxes", ;
ForeColor = Rgb(0,0,160), ;
Name = "Check2"
Add Object shape2 As Shape With ;
Top = 552, ;
Left = 268, ;
Height = 15, ;
Width = 15, ;
Anchor = 768, ;
Curvature = 15, ;
MousePointer = 15, ;
ToolTipText = "Header/black-green", ;
BackColor = Rgb(0,255,0), ;
Name = "Shape2"
Add Object label1 As Label With ;
FontBold = .T., ;
FontSize = 9, ;
Anchor = 768, ;
Caption = "Random Rows colors", ;
Height = 25, ;
Left = 543, ;
Top = 547, ;
Width = 123, ;
BackColor = Rgb(255,255,0), ;
Name = "Label1"
Add Object command1 As CommandButton With ;
Top = 548, ;
Left = 481, ;
Height = 25, ;
Width = 60, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "C-Colors", ;
ToolTipText = "Columns random lighten colors", ;
BackColor = Rgb(255,255,0), ;
Name = "Command1"
Add Object command2 As CommandButton With ;
Top = 548, ;
Left = 399, ;
Height = 25, ;
Width = 84, ;
FontBold = .T., ;
Anchor = 768, ;
Caption = "Forecolor", ;
BackColor = Rgb(255,128,0), ;
Name = "Command2"
Add Object label2 As Label With ;
AutoSize = .T., ;
FontBold = .T., ;
FontSize = 12, ;
BackStyle = 0, ;
Caption = "Menu", ;
Height = 22, ;
Left = 24, ;
MousePointer = 15, ;
Top = 9, ;
Width = 44, ;
ForeColor = Rgb(0,255,0), ;
Name = "Label2"
Procedure my
Lparameters nKeyCode, nShiftAltCtrl
* aevent create an array laEvents
Aevents( myArray, 0)
* reference the calling object
loObject = myArray[1]
Local m.x
m.x="thisform.grid1."+loObject.Parent.Parent.Name+'.'+loObject.Parent.Name+"."+loObject.Name
m.x=Eval(m.x)
loObject.Parent.Parent.Text1.SetFocus()
If nKeyCode = 24
Skip 1 In "ycurs"
If Eof()
Go Bottom
Endif
DoDefault( )
loObject.Parent.Parent.Parent.Refresh() &&grid
loObject.Parent.Parent.Text1.SetFocus()
x.SetFocus
Endif
If nKeyCode = 5
Skip -1 In "ycurs"
If Bof()
Go Top
Endif
DoDefault( )
loObject.Parent.Parent.Parent.Refresh() &&grid
loObject.Parent.Parent.Text1.SetFocus()
x.SetFocus
Endif
DoEvent
Endproc
Procedure yhelp.Click
Local m.myvar
TEXT to m.myvar noshow
this native vfp grid utility can do:
-Generates random dynamic lighten backcolors for grid rows.can fix color.
-Generates random dynamic backcolors for headers .can fix color
-Generates random lighten colors for columns
-Generates random forecolor for grid rows or one forecolor fixed.
-Sort any header /column ascending or descending when enabling.
-adjust grid rowHeight,fontname,fontsize
-Rightclick on any form point to fire a contextuel menu or on left button.
-can generate random lighten color rows or checkboards on grid.
Author: Yousfi Benameur El Bayadh ALGERIA
January 2015
ENDTEXT
Messagebox(m.myvar,0+32+4096,"Summary Help" )
Endproc
Procedure my1
Lparameters nButton, nShift, nXCoord, nYCoord
*--- aevent create an array laEvents
Aevents( myArray, 0)
*--- reference the calling object
loObject = myArray[1]
If Thisform.yord=.T.
Sele ycurs
Local m.myvar
For i=1 To Fcount()
TEXT to m.myvar textmerge noshow
index on <<field(i)>> tag <<field(i)>>
ENDTEXT
Execscript(m.myvar)
Endfor
Locate
Endi
If Thisform.check1.Value=1
With Thisform
.yclick=.yclick+1
If .yclick>1
.yclick=0
Endi
.grid1.SetAll("picture","","header" )
If .yclick=0
loObject.Picture="ascend.bmp" &&home(1)+"graphics\icons\arrows\ARW05UP.ico"
Else
loObject.Picture="descend.bmp" &&home(1)+"graphics\icons\arrows\ARW05DN.ico"
Endi
Sele ycurs
Locate
If .yclick=0
Set Order To (loObject.Caption) Ascending
Else
Set Order To (loObject.Caption) Descending
Endi
.grid1.Refresh
*locate
.grid1.SetFocus
Endwith
Endi
Return
Endproc
Procedure my2
Lparameters nButton, nShift, nXCoord, nYCoord
* aevent create an array laEvents
Aevents( myArray, 0)
* reference the calling object
loObject = myArray[1]
Sele ycurs
Repl xcheck With loObject.Value
Endproc
Procedure RightClick
Do ymenu.mpr
Endproc
Procedure Init
Thisform.yord=.F.
Sele ycurs
Locate
With Thisform.grid1
.Themes=.F. &&for headers ...bug in vfp9sp2
.RecordSource="ycurs"
.DeleteMark=.F.
.GridLines=0
.FontSize=10
.FontName="courier new"
.RowHeight=Thisform.spinner2.Value
.HeaderHeight=25
.Anchor=15
.FontBold=.T.
.SetAll("fontsize",12,"header" )
.SetAll("fontbold",.T.,"header" )
.SetAll("forecolor",255,"header" )
.AutoFit()
.Refresh
Endwith
With Thisform.grid1
For i=1 To .ColumnCount
Bindevent[.Columns(i).header1,"mousedown",Thisform,"my1" ] &&
Endfor
.column1.header1.Picture="descend.bmp"
Endwith
Endproc
Procedure Load
Close Data All
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs Readwrite
Alter Table ycurs Add Column xcolor i
Sele ycurs
Repl All xcolor With Rgb(255*Rand(),255*Rand(),255*Rand())
*brow
Locate
Local m.myvar
For i=1 To Fcount()
TEXT to m.myvar textmerge noshow
index on <<field(i)>> tag <<field(i)>>
ENDTEXT
Execscript(m.myvar)
Endfor
Locate
Endproc
Procedure Activate
Thisform.command4.Click()
Thisform.command5.Click()
Endproc
Procedure Destroy
Close Data All
Set Safe On
Clea Events
Endproc
Procedure grid1.Resize
With This
For i=1 To .ColumnCount
If Vartype(.Columns(i).myCNT)="O"
.Columns(i).myCNT.Anchor=15
.Columns(i).myCNT.image1.Anchor=15
.Columns(i).Refresh
Endi
Endfor
.Refresh
Endwith
Endproc
Procedure grid1.AfterRowColChange
Lparameters nColIndex
DoDefault()
Endproc
Procedure command4.Click
*random lines lighten colors level=65%
Local lnRed,lnGreen,lnBlue,tnLevel,x
tnLevel=0.65
lnRed =Int(255*Rand())
lnGreen = Int(255*Rand())
lnBlue = Int(255*Rand())
m.x='RGB('+Trans( lnRed + ((255 - lnRed ) * tnLevel))+','+;
trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
trans( lnBlue + ((255 - lnBlue ) * tnLevel) )+')'
With Thisform.grid1
.SetAll("DynamicBackColor","IIF(MOD(recno(), 2)=0, RGB(255,255,255) ,"+m.x +")" , "Column" )
.Refresh
Endwith
Endproc
Procedure check1.InteractiveChange
Thisform.command4.Enabled=Iif(This.Value=1,0,1)
If This.Value=1
With Thisform.grid1
For i=1 To .ColumnCount
Unbindevent (.Columns(i).header1,"mousedown",Thisform,"my1" )
Bindevent (.Columns(i).header1,"mousedown",Thisform,"my1" )
Endfor
.column1.header1.Picture="descend.bmp"
Endwith
This.Parent.grid1.SetAll("DynamicBackColorIF(MOD(RECNO( ), 2)=0, RGB(255,255,255) , RGB(255,255,255))", "Column" )
Else
Set Order To
Thisform.yord=.T. &&control index
This.Parent.grid1.SetAll["picture","","header" ] &&&
Endi
This.Parent.grid1.Refresh
Endproc
Procedure command5.Click
Local m.x
m.x='rgb('+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+','+Trans(Int(255*Rand()))+')' &&unique color
With This.Parent.grid1
.SetAll("BackColor",Eval(m.x),"header" )
.Refresh
Endwith
Endproc
Procedure command6.Click
Local lnRed,lnGreen,lnBlue,T,Level,x
tnLevel=-0.50 &&darken
lnRed = Int(255*Rand())
lnGreen = Int(255*Rand())
lnBlue = Int(255*Rand())
m.x='RGB('+Trans(Int(lnRed + (lnRed * tnLevel)))+','+ ;
trans(Int(lnGreen + (lnGreen * tnLevel)))+','+ ;
trans(Int(lnBlue + (lnBlue * tnLevel)) )+')'
With Thisform.grid1
For i=1 To .ColumnCount
If Vartype(.Columns(i).myCNT)="O"
.Columns(i).myCNT.SetAll("forecolor",Eval(m.x),"textbox" )
Else
.ForeColor=Eval(m.x)
Endi
Endfor
.Refresh
Endwith
Retu
Endproc
Procedure spinner2.InteractiveChange
Thisform.grid1.RowHeight=This.Value
Endproc
Procedure shape1.RightClick
Do ymenu.mpr
Endproc
Procedure check2.InteractiveChange
Thisform.ycheck=!Thisform.ycheck
Try
Use In ycurs
Catch
Endtry
With Thisform.grid1
Do Case
Case This.Value=0
Sele * From Home(1)+"samples\data\customer" Into Cursor ycurs Readwrite
Alter Table ycurs Add Column xcolor i
.RecordSource="ycurs"
Sele ycurs
.SetAll('DynamicBackColor','IIF(mod(recno(),2)=0,RGB(128,215,0),RGB(220,208,211))','Column')
Case This.Value=1
Sele .F. As xcheck,* From Home(1)+"samples\data\customer" Into Cursor ycurs Readwrite
Alter Table ycurs Add Column xcolor i
.RecordSource="ycurs"
Sele ycurs
With .column1
.Width=30
.AddObject("check1","checkbox" )
.CurrentControl="check1"
.Sparse=.F.
With .check1
.Value=xcheck
.Caption=""
.BackStyle=0
.Visible=.T.
Endwith
Endwith
Sele ycurs
Local m.myvar
For i=1 To Fcount()
TEXT to m.myvar textmerge noshow
index on <<field(i)>> tag <<field(i)>>
ENDTEXT
Execscript(m.myvar)
Endfor
Locate
.SetAll('DynamicBackColor','IIF(xCheck,RGB(158,205,190),RGB(220,228,211))','Column')
Bindevent[Thisform.grid1.column1.check1,;
"interactiveChange",Thisform,"my2" ] &&
Endcase
.SetAll("fontsize",12,"header" )
.SetAll("fontbold",.T.,"header" )
.SetAll("forecolor",255,"header" )
.Parent.shape2.Click
.Refresh
Endwith
Endproc
Procedure shape2.Click
With Thisform.grid1
.SetAll("backcolor",0,"header" )
.SetAll("forecolor",Rgb(0,255,0),"header" )
.SetAll("fontbold",.T.,"header" )
Endwith
Endproc
Procedure label1.Click
&&make lighten colors -- better for eyes
Local nlevel
nlevel=0.67
Sele ycurs
Repl All xcolor With Rgb(255*Rand(),255*Rand(),255*Rand())
Scan
Local m.lnRed,m.lnGreen,m.lnBlue
m.lnRed = Bitrshift(Bitand(xcolor, 0x0000FF), 0)
m.lnRed=m.lnRed +(255 - m.lnRed ) * nlevel
m.lnGreen = Bitrshift(Bitand(xcolor, 0x00FF00), 8)
m.lnGreen=m.lnGreen+(255 - m.lnGreen) * nlevel
m.lnBlue = Bitrshift(Bitand(xcolor, 0xFF0000),16)
m.lnBlue=m.lnBlue+ (255 - m.lnBlue )* nlevel
m.xx= 'rgb('+ Transform(m.lnRed,"999" )+","+Transform(m.lnGreen,"999" )+","+Transform(m.lnBlue,"999" )+") "
m.xx=Eval(m.xx)
Repl xcolor With m.xx
Endscan
Locate
With Thisform.grid1
.SetAll("dynamicBackcolor","ycurs.xcolor","column" )
.Refresh
Endwith
Retu
Endproc
Procedure command1.Click
*random columns lighten colors
With Thisform.grid1
Local m.x,lnRed,lnGreen,lnBlue,tnLevel
tnLevel=0.75
For i=1 To .ColumnCount
lnRed =Int(255*Rand())
lnGreen=Int(255*Rand())
lnBlue =Int(255*Rand())
m.x='RGB('+Trans( lnRed + ((255 - lnRed ) * tnLevel))+','+;
trans( lnGreen + ((255 - lnGreen) * tnLevel))+ ','+ ;
trans( lnBlue + ((255 - lnBlue ) * tnLevel) )+')'
.Columns(i).DynamicBackColor=Eval('"'+m.x+'"')
Endfor
.Refresh
Endwith
Retu
Endproc
Procedure command2.Click
Local m.xcolor
m.xcolor=Getcolor()
If !m.xcolor=-1
Thisform.grid1.ForeColor=m.xcolor
Endi
Endproc
Procedure label2.Click
Do ymenu.mpr
Endproc
Enddefine
*-- EndDefine: ygcosmetics
*end code
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Download these 4 pictures to the prg source folder .some are part of code above.
Remark:Can make row picture using a container with image as currentcontrol.(sparse=.f.)