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.

One Response to Fancy Grid Highlighting (VFP8 and later)

Leave a Reply

Your email address will not be published. Required fields are marked *