Fancy Grid Highlighting (VFP8 and later)
Recently as I was working on an email management application using MySQL Server, VFP8 and some email components from AdminSystem, a need to better distinguish the different status of emails (Read, Replied, Forwarded, Acknowledged, Flagged and so on) arose. So VFP grid's numerous property regarding forecolor and backcolor (static or dynamic) where put to good use. I got the inspiration from Mozilla's Thunderbird Email Client. Below is the test program I used and later improved and adapted in my email management application. DynamicCurrentControl was used to show different icons for the different email status. By the way, you can click on the grid's header to sort the records.
Public oForm
oForm = Newobject("form1")
oForm.Show
Return
**********************************************************
* class definition for form1
Define Class form1 As Form
Top = 0
Left = 0
Height = 340
Width = 381
DoCreate = .T.
Caption = "Grid Highlight"
Name = "form1"
ShowTips = .T.
Procedure Init
Public gvTypeA,gvTypeD,gvTypeR
gvTypeA = Rgb(255,0,0)
gvTypeD = Rgb(0,0,128)
gvTypeR = Rgb(64,128,128)
Select temp
Locate
This.AddObject('grid1','grid1')
This.grid1.Visible = .T.
Endproc
Procedure Load
* create cursor for temporary data
Create Cursor temp (cType c(1),cDesc c(40),nRand i)
lnFlds = Afields(laFlds,'temp')
For lnY = 1 To lnFlds
lcNdxNm = laFlds(lnY,1)
Index On &lcNdxNm Tag &lcNdxNm
Next
* create index for all fields
For lnX = 1 To 9
m.cType = 'R'
m.cDesc = m.cType + Space(2) + 'Description ' + Alltrim(Str(lnX))
m.nRand = Rand() * 100
Insert Into temp From Memvar
Next
For lnX = 1 To 9
m.cType = 'A'
m.cDesc = 'Description ' + m.cType + Space(2) + Alltrim(Str(lnX))
m.nRand = Rand() * 100
Insert Into temp From Memvar
Next
For lnX = 1 To 9
m.cType = 'D'
m.cDesc = Alltrim(Str(lnX)) + Space(2) + m.cType + Space(2) + 'Description'
m.nRand = Rand() * 100
Insert Into temp From Memvar
Next
Endproc
Procedure Unload
Release gvTypeA,gvTypeD,gvTypeR
Endproc
Enddefine
* end class definition for form1
**********************************************************
* class definition for grid
Define Class grid1 As Grid
ColumnCount = 3
FontSize = 8
DeleteMark = .F.
Height = 313
Left = 13
Panel = 1
RowHeight = 17
Top = 12
Width = 354
Name = "Grid1"
GridLines = 0
Procedure Init
With This
lcForeColor = "Iif(cType='R',gvTypeR,Iif(cType='D',gvTypeD,gvTypeA))"
.RecordSource = 'temp'
.HighlightStyle = 2
.SetAll('DynamicForeColor',lcForeColor,'column')
.HighlightBackColor = Evaluate(.Column1.DynamicForeColor)
.HighlightForeColor = Rgb(255,255,255)
.SetAll('SelectedBackColor',.HighlightBackColor ,'textbox')
.SetAll('SelectedForeColor',.HighlightForeColor ,'textbox')
With .Column1
.ControlSource = 'cType'
.FontSize = 8
.Width = 36
.RemoveObject('header1')
.AddObject('header1','header1')
.header1.Caption = "Type"
Endwith
With .Column2
.ControlSource = 'cDesc'
.FontSize = 8
.Width = 206
.RemoveObject('header1')
.AddObject('header1','header1')
.header1.Caption = "Description"
Endwith
With .Column3
.ControlSource = 'nRand'
.FontSize = 8
.Width = 75
.RemoveObject('header1')
.AddObject('header1','header1')
.header1.Caption = "Number"
Endwith
.Refresh
Endwith
Endproc
Procedure AfterRowColChange
Lparameters nColIndex
With This
.HighlightBackColor = Evaluate(.Column1.DynamicForeColor)
.HighlightForeColor = Rgb(255,255,255) && white
.SetAll('SelectedBackColor',.HighlightBackColor ,'textbox')
.SetAll('SelectedForeColor',.HighlightForeColor ,'textbox')
Endwith
Endproc
Enddefine
* end class definition for grid
**********************************************************
* class definition for Header
Define Class header1 As Header
Tag = 'A'
FontSize = 8
ToolTipText = 'Click here to sort'
Procedure Click
Local lcNdx,lcOrder,lcAlias
With This
If .Tag = 'A'
lcOrder = 'Ascending'
.Tag = 'D'
Else
lcOrder = 'Descending'
.Tag = 'A'
Endif
lcNdx = .Parent.ControlSource
lcAlias = .Parent.Parent.RecordSource
Select (lcAlias)
Set Order To &lcNdx &lcOrder
.Parent.Parent.Refresh
Endwith
Endproc
Enddefine
* end class definition for Header
Maybe somebody can put this into good use. Please feel free to send feedbacks and/or comments.