VFP grid Cosmetics Part I

Published on by Yousfi Benameur

-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).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).
Selct all the code and paste into a ygrid_cosmetics.prg or run selection (play in temp folder).

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.
Download these 4 pictures to the prg source folder .some are part of code above.
Download these 4 pictures to the prg source folder .some are part of code above.
Download these 4 pictures to the prg source folder .some are part of code above.

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.)

Published on Visual foxpro, grid

To be informed of the latest articles, subscribe:
Comment on this post