How to do grid sort

[abbasaif]

Hello,

I copied this .prg long time back from a forum. Can I convert this into class, if so how can?
I just wanted to drop the class into any grid contain form and it should sort accordingly.

Please guide me.

Thanks

Local loform As Form
Use (Home(2) + "Northwind\Customers")
loform = Createobject("Form")
loform.Caption = "Example grid with order by column"
loform.AddObject("MyGrid","MyGridOrd")
loform.mygrid.order_enabled = .T.
loform.mygrid.order_all()
loform.mygrid.RecordSource = "Customers"
loform.mygrid.Width = loform.Width
loform.mygrid.Height = loform.Height
loform.mygrid.Anchor = 15
loform.mygrid.Visible = .T.
loform.WindowState = 2
loform.mygrid.AutoFit()
loform.Show(1)

Define Class mygridord As Grid
   *-- Current pointer to the Header object
   Header = .F.
   HeaderHeight = 25
   *-- Enables the order column
   order_enabled = .F.
   Name = "MyGridOrd"

   Procedure order_column
      Lparameters tocolumn, tcfield
      Local tccaption, tlwordwrap
      Do Case
         Case Pemstatus(tocolumn,"Header1",5)
            tccaption = tocolumn.header1.Caption
            tlwordwrap = tocolumn.header1.WordWrap
            tocolumn.RemoveObject('Header1')
         Case Pemstatus(tocolumn,"MyHeader",5)
            tccaption = tocolumn.myheader.Caption
            tlwordwrap = tocolumn.myheader.WordWrap
            tocolumn.RemoveObject('MyHeader')
      Endcase
      tocolumn.AddObject('MyHeader', 'MyHeaderOrd', tcfield)
      tocolumn.myheader.Caption = tccaption
      tocolumn.myheader.WordWrap = tlwordwrap
   Endproc
   Procedure order_all
      Local lo, lc
      For Each lo In This.Columns
         *-- Do not sort the columns that have some value in the TAG property
         If Empty(lo.Tag)
            lc =  Substr(lo.ControlSource,At(".", lo.ControlSource) + 1)
            *-- Remove special symbols that may appear in the ControlSource
            lc = Chrtran(lc, ["'+-/*().,;], [])
            This.order_column(lo, lc)
         Endif
      Endfor
   Endproc

   Procedure Init
      DoDefault()
      If This.order_enabled
         This.order_all()
      Endif
   Endproc
Enddefine

*------------------------------------------------------
* Column y Header Class to sort the columns of the grid MyGridOrd
*------------------------------------------------------
Define Class mycolumnord As Column
   *-- Nothing yet.
Enddefine

Define Class myheaderord As Header
   FontSize = 8
   FontBold = .T.
   Alignment = 2
   nnoreg = 0
   cfield = ""
   norder = 0
   cfieldtype = "U"
   lcyclic = .F. && The order goes from ASC > DESC > NO ORD > ASC > ETC ...
   Procedure Init(tcfield)
      Local  ln1, ln2
      This.cfield = Upper(tcfield)
      ln1 = Afields(lafields, This.Parent.Parent.RecordSource)
      If ln1 > 0
         ln2 = Ascan(lafields, This.cfield, -1, -1, 1, 11)
         If ln2 > 0
            This.cfieldtype = lafields(ln2, 2)
         Endif
      Endif
      If Not Inlist(This.cfieldtype, "U", "G", "M", "W")
         This.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
         This.MousePointer = 15 && Hand
      Endif
   Endproc

   Procedure Click
      If Inlist(This.cfieldtype, "U", "G", "M", "W")
         *- Unable to sort these types of fields.
         Return
      Endif
      This.nnoreg = Min(Reccount(This.Parent.Parent.RecordSource), ;
         RECNO(This.Parent.Parent.RecordSource))
      If Vartype(This.Parent.Parent.Header) == "O" And !Isnull(This.Parent.Parent.Header)
         This.Parent.Parent.Header.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
         If This.Parent.Parent.Header.cfield <> This.cfield
            This.Parent.Parent.Header.norder = 0
         Endif
      Endif
      Do Case
         Case This.norder = 0
            *-- Without order, goes to ASCending
            If Ataginfo(latag,"",This.Parent.Parent.RecordSource) > 0 And Ascan(latag,This.cfield,-1,-1,1,1) > 0
               *-- There is a TAG
            Else
               Local lcsetsafety
               lcsetsafety = Set("Safety")
               Set Safety Off
               Select (This.Parent.Parent.RecordSource)
               Execscript( "INDEX ON " + This.cfield + " TO " + This.cfield + " ADDITIVE")
               Set Safety &lcsetsafety
            Endif
            Execscript("SET ORDER TO " + This.cfield + " IN " + This.Parent.Parent.RecordSource + " ASCENDING")
            This.Parent.Parent.Header = This
            This.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\SORTASC.BMP", "BMP")
         Case This.norder = 1
            *-- Order ASC, goes to DESCending
            If Ataginfo(latag,"",This.Parent.Parent.RecordSource) > 0 And Ascan(latag,This.cfield,-1,-1,1,1) > 0
               *-- There is a TAG
            Else
               Local lcsetsafety
               lcsetsafety = Set("Safety")
               Set Safety Off
               Select (This.Parent.Parent.RecordSource)
               Execscript( "INDEX ON " + tcfield + " TO " + This.cfield + " ADDITIVE")
               Set Safety &lcsetsafety
            Endif
            Execscript("SET ORDER TO " + This.cfield + " IN " + This.Parent.Parent.RecordSource + " DESCENDING")
            This.Parent.Parent.Header = This
            This.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\SORTDES.BMP", "BMP")
         Case This.norder = 2 And This.lcyclic
            *-- Order DESC, goes to No Order
            Execscript("SET ORDER TO 0 IN " + This.Parent.Parent.RecordSource)
            This.Parent.Parent.Header = This
            This.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      Endcase
      This.norder = Mod(This.norder + 1, Iif(This.lcyclic,3,2))
      This.Parent.Parent.Refresh()
      If This.nnoreg > 0
         Go (This.nnoreg) In (This.Parent.Parent.RecordSource)
      Endif
   Endproc

   Procedure RightClick
      If Vartype(This.Parent.Parent.Header) <> "O"
         *-- No order yet
         Return
      Endif
      *-- With RightClick remove any order
      This.nnoreg = Min(Reccount(This.Parent.Parent.RecordSource), ;
         RECNO(This.Parent.Parent.RecordSource))
      Execscript("SET ORDER TO 0 IN " + This.Parent.Parent.RecordSource)
      This.Parent.Parent.Header.norder = 0
      This.Parent.Parent.Header.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
      This.Parent.Parent.Header = This
      This.Parent.Parent.Refresh()
      If This.nnoreg > 0
         Go (This.nnoreg) In (This.Parent.Parent.RecordSource)
      Endif
   Endproc
Enddefine

 

[Mike Lewis]

I copied this .prg long time back from a forum.

It's always a bad idea to blindly copy code from somewhere without understanding what it is or how it works. Much better to get to know the functioning of a grid (or whatever), and work out for yourself how to use it.

The short answer to your question is that the code is already a class - at least, the part between DEFINE CLASS and ENDDEFINE. The problem is that it is a programmatic class, so you cannot drop it onto a form. Instead, create a new grid class in the class designer, and copy and paste the code from the PRG to the relevant methods of the grid.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads

 

[abbasaif]

Thanks for the reply!

I tried to act as you advised.

I create a new grid in class designer. Applied the code to the respected position.
New grid has no header so where to defined the code as column value = -1, and I cannot limit the no. of headers in grid as it depends upon the cursor/tables. So, I could not understood the following:

Define Class myheaderord As Header
   FontSize = 8
   FontBold = .T.
   Alignment = 2
   nnoreg = 0
   cfield = ""
   norder = 0
   cfieldtype = "U"
   lcyclic = .F. && The order goes from ASC > DESC > NO ORD > ASC > ETC ...
   Procedure Init(tcfield)
      Local  ln1, ln2
      This.cfield = Upper(tcfield)
      ln1 = Afields(lafields, This.Parent.Parent.RecordSource)
      If ln1 > 0
         ln2 = Ascan(lafields, This.cfield, -1, -1, 1, 11)
         If ln2 > 0
            This.cfieldtype = lafields(ln2, 2)
         Endif
      Endif
      If Not Inlist(This.cfieldtype, "U", "G", "M", "W")
         This.Picture = Locfile(Home(4) + "Bitmaps\Tlbr_w95\DELETE.BMP", "BMP")
         This.MousePointer = 15 && Hand
      Endif
   Endproc

Please guide...

Thanks

 

[Tore Bleken]

http://www.sweetpotatosoftware.com/blog/index.php/2008/11/25/visual-foxpro-grid-enhancements/

 

[Mike Lewis]

That's not quite right. You don't need a custom header class, but you do need a custom column class. The column contains the header, and you need to put code in the header's click event to toggle the index.

However, the columns don't actually exist within the grid until you populate the grid. So you first need to design a column class. Then use the grid's MemberClass and MemberClassLibrary properties to specify where the grid is to find its columns. At the object level, when you specify the grid's RecordSource, the grid will contain the correct number of columns, and these will be based on your custom column class, and will therefore have the functionality to sort the data.

That said, the code that you posted (in your second post) doesn't actually do anything useful, as far as I can see. All it does is to add an icon to the header if the column cannot be sorted (e.g. if it is a memo field). Worse, if it can't find the icon, it asks the user to locate it. That's about the worst thing you can do in an application.

I would like to make a suggestion. First, throw away all the code that you downloaded. Then create a simple form and place a grid on it. Never mind about classes for the moment. Concentrate instead of getting the grid to sort its data. We can talk you through the code if necessary, but try to do it yourself first. Then, when and only when you have got that working, we can discuss how to convert it into a class.

Mike

__________________________________
Mike Lewis (Edinburgh, Scotland)

Visual FoxPro articles, tips and downloads