Thread: FoxPro Some General Questions/MS FlexGrid

MS FlexGrid
#Define TESTDATALOC "C:\ddrive\TEMP\testdata.DBC"

oForm = createobject('myForm')
oForm.Show
Read events

Define CLASS myform AS form
  Top = 0
  Left = 0
  Height = 450
  Width = 750
  DoCreate = .T.
  Caption = "Form1"
  Name = "Form1"

  Add OBJECT command1 as commandbutton with ;
    Autosize = .t., ;
    Top = 0, ;
    Left = 0, ;
    Name = "Set1", ;
    Caption = 'Sample 1'

  Add OBJECT command2 as commandbutton with ;
    Autosize = .t., ;
    Top = 0, ;
    Left = 0, ;
    Name = "Set2", ;
    Caption = 'Sample 2'

  Add OBJECT command3 as commandbutton with ;
    Autosize = .t., ;
    Top = 0, ;
    Left = 0, ;
    Name = "Set3", ;
    Caption = 'Sample 3'

  Add OBJECT command4 as commandbutton with ;
    Autosize = .t., ;
    Top = 0, ;
    Left = 0, ;
    Name = "Set4", ;
    Caption = 'Sample 4'

  Add OBJECT hflex AS olecontrol WITH ;
    Top = 0, ;
    Left = 0, ;
    Height = 420, ;
    Width = 750, ;
    Name = "Hflex", ;
    OleClass = 'MSHierarchicalFlexGridLib.MSHFlexGrid'

  Procedure LoadSet
  Lparameters tnSet
  Local oRecordset,oConnection, strCn, strShp

  strCn =   [Provider=MSDataShape.1;Persist Security Info=False;]+;
    [Data Source="Data Provider = MSDASQL;]+;
    [DSN=Visual FoxPro Database;UID=;SourceDB=]+TESTDATALOC+[;]+;
    [SourceType=DBC;Exclusive=No;BackgroundFetch=Yes;Collate=Machine;Null=Yes;]+;
    [Deleted=Yes;";Data Provider=MSDASQL ]


  oRecordset = CreateObject("adodb.recordset")
  oConnection = CreateObject("adodb.connection")

  With oConnection
  .Provider = "MSDataShape"
  .ConnectionString = strCn
  .Open
Endwith

lcSel1 = [ select customer.cust_id, ]+;
    [   customer.Company,]+;
    [   orders.order_id,]+;
    [   orders.Order_date ]+;
    [ from customer ]+;
    [  inner join orders on customer.cust_id = orders.cust_id ]

lcSel2 = [ select od.order_id, od.line_no, ]+;
    [   products.prod_name, ]+;
    [   products.no_in_unit as 'Packaging', ]+;
    [   od.unit_price, ]+;
    [   od.Quantity, ]+;
    [   od.unit_price * od.quantity as ExtendedPrice ]+;
    [ from orditems as od ]+;
    [  inner join products on od.product_id = products.product_id ]

Do case
Case tnSet = 1
  strShp = [SHAPE TABLE customer ]+;
    [  APPEND ( (SHAPE TABLE orders   ]+;
    [    APPEND (TABLE orditems RELATE order_id TO order_id)) ]+;
    [  RELATE cust_id TO cust_id ) ]
Case tnSet = 2

  strShp = [SHAPE { select Company, cust_id from customer } ]+;
    [APPEND (( SHAPE { select distinct First_name, Last_name, a.emp_id + cust_id as "Emp_sel", cust_id  from employee a inner join orders b on a.emp_id = b.emp_id }  ]+;
    [APPEND (( SHAPE { select order_date, order_net, shipped_on, emp_id + cust_id as "Emp_sel",order_id from orders }  ]+;
    [APPEND ( { select order_id, line_no, prod_name from orditems inner join products on products.product_id = orditems.product_id } AS rsOrditems  ]+;
    [RELATE order_id TO order_id )) AS rsEmployee ]+;
    [RELATE emp_sel TO emp_sel )) AS rsOrders  ]+;
    [RELATE cust_id TO cust_id ) ]
Case tnSet = 3

  strShp = [ SHAPE  {SELECT cust_id, company FROM customer} ]+;
    [APPEND ({SELECT cust_id, order_id, order_date, order_net ]+;
    [         FROM orders ]+;
    [         WHERE order_date < {1/1/1996} AND cust_id = ?} ]+;
    [         RELATE cust_id TO PARAMETER 0) AS rsOldOrders, ]+;
    [       ({SELECT cust_id, order_id, order_date, order_net ]+;
    [         FROM orders ]+;
    [         WHERE order_date >= {1/1/1996}} ]+;
    [         RELATE cust_id TO cust_id) AS rsRecentOrders ]

Case tnSet = 4
  strShp = [  SHAPE ]+;
    [(SHAPE {]+lcSel1+[ } as rs1 ]+;
    [   APPEND  ({]+lcSel2+[ } AS rsDetails RELATE order_id TO order_id),  ]+;
    [ SUM(rsDetails.ExtendedPrice) AS OrderTotal, ANY(rsDetails.order_id)) AS rsOrders ]+;
    [COMPUTE  rsOrders, ]+;
    [SUM(rsOrders.OrderTotal) AS CustTotal, ]+;
    [ANY(rsOrders.Company) AS Cmpny   ]+;
    [   BY cust_id ]

Endcase
With oRecordset
  .ActiveConnection = oConnection
  .Source = strShp
  .Open
Endwith

With this.hflex
  .Datasource = oRecordset
  .Mergecells = 3
  .GridColorBand(1) = rgb(255,0,0)
  .GridColorBand(2) = rgb(0,0,255)
  .GridColorBand(3) = rgb(0,255,0)
  .ColWidth(0,0) = 300
  .CollapseAll
Endwith
Endproc

  Procedure Init
  With this
    .Set2.Left = .Set1.Left + .Set1.Width + 5
    .Set3.Left = .Set2.Left + .Set2.Width + 5
    .Set4.Left = .Set3.Left + .Set3.Width + 5
    .hflex.Top = .Set1.Top + .Set1.Height + 5
    .hflex.Height = .Height - (.hflex.Top + 5)
    .hflex.Left = 5
    .hflex.Width = .Width - 10
    .LoadSet(1)
  Endwith
Endproc
  Procedure QueryUnLoad
  Clear events
Endproc
  Procedure Set1.Click
  Thisform.LoadSet(1)

Endproc
  Procedure Set2.Click
  Thisform.LoadSet(2)
Endproc
  Procedure Set3.Click
  Thisform.LoadSet(3)
Endproc
  Procedure Set4.Click
  Thisform.LoadSet(4)
Endproc
Enddefine



Here are few samples:
1) This one demonstrates both 'grouping sort' and some other features like coloring.
2) Demonstrates hierarchical data view - like a Treeview but more like a TreeData. Also demonstrates coloring again but this time 'bandwise'

Note: In both samples the control is HierarchicalFlexGrid and not FlexGrid. Hflex does all Flex does and more, I found it to be more reliable.


#Define TESTDATALOC _samples+'data\testdata.DBC'

Public oForm
oForm = Createobject('myForm')
oForm.Show

Define Class myform As Form
    Top = 0
    Left = 0
    Height = 480
    Width = 750
    DoCreate = .T.
    Caption = "Flex Grid Sort Sample - Drag a column to left to group by it"

    Add Object hflex As OleControl With ;
        Top = 0, ;
        Left = 0, ;
        Height = 420, ;
        Width = 750, ;
        Name = "Hflex", ;
        OleClass = 'MSHierarchicalFlexGridLib.MSHFlexGrid'

    Add Object cmdFun As CommandButton ;
        with Top = 425, Caption='Show some other features', AutoSize = .T.

    Procedure dosort
        Lparameters toObject
        With toObject
            .Col = 0
            .ColSel = .Cols - 1
            .Sort = 1 && Generic Ascending
        Endwith
    Endproc

    Procedure hflex.MouseDown
        *** ActiveX Control Event ***
        Lparameters Button, Shift, x, Y
        With This
            .Tag = ""
            If .MouseRow = 0
                .Tag = Str(.MouseCol)
                .Drag( 1 )
            Endif
        Endwith
    Endproc

    Procedure hflex.DragDrop
        Lparameters oSource, nXCoord, nYCoord
        If !Empty(This.Tag)
            With This
                .Redraw = .F.
                .ColPosition(Val(.Tag)) = .MouseCol
                Thisform.dosort(This)
                .Redraw = .T.
            Endwith
        Endif
    Endproc

    Procedure Init

        Local oRecordset,oConnection, strCn, strShp

        strCn =   [Provider=MSDataShape;Persist Security Info=False;]+;
            [Data Source=]+TESTDATALOC+[;Data Provider=VFPOLEDB]
        strShp =   [SHAPE { select customer.cust_id, Company, ]+;
            [   orders.order_id, order_date, order_net, shipped_on, ]+;
            [   line_no, prod_name ] +;
            [ From customer ]+;
            [      Left Outer Join orders ]+ ;
            [        On customer.cust_id = orders.cust_id ] +;
            [      inner Join orditems ]+ ;
            [        On orditems.order_id = orders.order_id ] +;
            [      inner Join products ]+ ;
            [        On orditems.product_id = products.product_id } ]


        oRecordset = Createobject("adodb.recordset")
        oConnection = Createobject("adodb.connection")

        With oConnection
            .Provider = "MSDataShape"
            .ConnectionString = strCn
            .Open
        Endwith

        With oRecordset
            .ActiveConnection = oConnection
            .Source = strShp
            .Open
        Endwith


        With Thisform.hflex
            .Datasource = oRecordset
            For ix = 1 To .Cols - 1
                .MergeCol(ix) = .T.
            Endfor
            .MergeCells = 3

        Endwith
        Thisform.dosort(Thisform.hflex)
    Endproc

    Procedure cmdFun.Click
        With Thisform.hflex
            .FixedRows=1 && Number of rows fixed at top
            .FixedCols=1 && Number of Cols Fixed at Left

            .FillStyle = 1 && Repeat
            .WordWrap = .T.

            * First Column
            .Row = 1
            .Col = 0
            .Rowsel = .Rows-1
            .ColSel = 0
            .CellBackcolor = 0xFF0000 && Set all to blue backcolor
            .CellForeColor = 0xFFFFFF && Set all to white forecolor
            .CellAlignment = 9 && General - strings Left,Center
            .CellFontName = 'Arial'
            .CellFontBold = .T.
            .CellFontItalic = .F.
            .CellFontSize = 9

            * First Row
            .Row = 0
            .Col = 1
            .Rowsel = 0
            .ColSel = .Cols-1
            .CellBackcolor = 0xFF0000 && Set all to blue backcolor
            .CellForeColor = 0xFFFFFF && Set all to white forecolor
            .CellAlignment = 9 && General - strings Left,Center
            .CellFontName = 'Arial'
            .CellFontBold = .T.
            .CellFontItalic = .F.
            .CellFontSize = 9

            *Initial coloring of data cells
            .Col = 1
            .Row = 1
            .ColSel = .Cols-1
            .Rowsel = .Rows-1
            .CellAlignment = 9  && General - strings Left,Center
            .CellBackcolor=0x00FFFF && Set all to yellow

            * Enter some manual text on row 4,7 on lefmost fixed col
            .TextMatrix(4,0)="Manual 4"
            .TextMatrix(7,0)="Manual 7"

            * Enter text manually in left topmost corner cell
            .TextMatrix(0,0)="VFP:)"

            * Change color for a group of cells
            .Row = 4 && rectangle top row
            .Col = 5 && rectangle left col
            .Rowsel = 5 && rectangle row end (not 5 rows, end row is 5)
            .ColSel = 7 && rectangle right col
            .CellBackcolor = 0xFFFF00 && Set all to cyan backcolor
            .CellForeColor = 0xFF0000 && Set all to blue forecolor
        Endwith
    Endproc
Enddefine
Sample 2

#Define TESTDATALOC _samples+"data\testdata.DBC"

Public oForm
oForm = Createobject('myForm')
oForm.Show


Define Class myform As Form
    Top = 0
    Left = 0
    Height = 450
    Width = 750
    DoCreate = .T.
    Caption = "Form1"
    Name = "Form1"

    Add Object command1 As CommandButton With ;
        Autosize = .T., ;
        Top = 0, ;
        Left = 0, ;
        Name = "Set1", ;
        Caption = 'Sample 1'

    Add Object command2 As CommandButton With ;
        Autosize = .T., ;
        Top = 0, ;
        Left = 0, ;
        Name = "Set2", ;
        Caption = 'Sample 2'

    Add Object hflex As OleControl With ;
        Top = 0, ;
        Left = 0, ;
        Height = 420, ;
        Width = 750, ;
        Name = "Hflex", ;
        OleClass = 'MSHierarchicalFlexGridLib.MSHFlexGrid'

    Procedure LoadSet
        Lparameters tnSet
        Local oRecordset,oConnection, strCn, strShp

        strCn =   [Provider=MSDataShape;Persist Security Info=False;]+;
            [Data Source=]+TESTDATALOC+[;Data Provider=VFPOLEDB]


        lcSel1 = [ select customer.cust_id, ]+;
            [   customer.Company,]+;
            [   orders.order_id,]+;
            [   orders.Order_date ]+;
            [ From customer ]+;
            [  inner Join orders On customer.cust_id = orders.cust_id ]

        lcSel2 = [ select od.order_id, od.line_no, ]+;
            [   products.prod_name, ]+;
            [   products.no_in_unit As 'Packaging', ]+;
            [   od.unit_price, ]+;
            [   od.Quantity, ]+;
            [   od.unit_price * od.Quantity As ExtendedPrice ]+;
            [ From orditems As od ]+;
            [  inner Join products On od.product_id = products.product_id ]

        Do Case
            Case tnSet = 1

                strShp = [SHAPE { select Company, cust_id from customer } ]+;
                    [Append (( Shape { Select Distinct First_name, Last_name, a.emp_id + cust_id As "Emp_sel", cust_id  From employee a inner Join orders b On a.emp_id = b.emp_id }  ]+;
                    [Append (( Shape { Select Order_date, order_net, shipped_on, emp_id + cust_id As "Emp_sel",order_id From orders }  ]+;
                    [Append ( { Select order_id, line_no, prod_name From orditems inner Join products On products.product_id = orditems.product_id } As rsOrditems  ]+;
                    [Relate order_id To order_id )) As rsEmployee ]+;
                    [Relate emp_sel To emp_sel )) As rsOrders  ]+;
                    [Relate cust_id To cust_id ) ]
            Case tnSet = 2
                strShp = [  SHAPE ]+;
                    [(Shape {]+lcSel1+[ } as rs1 ]+;
                    [   Append  ({]+lcSel2+[ } AS rsDetails RELATE order_id TO order_id),  ]+;
                    [ Sum(rsDetails.ExtendedPrice) As OrderTotal, Any(rsDetails.order_id)) As rsOrders ]+;
                    [Compute  rsOrders, ]+;
                    [Sum(rsOrders.OrderTotal) As CustTotal, ]+;
                    [Any(rsOrders.Company) As Cmpny   ]+;
                    [   By cust_id ]

        Endcase

        oRecordset = Createobject("adodb.recordset")
        oConnection = Createobject("adodb.connection")

        With oConnection
            .Provider = "MSDataShape"
            .ConnectionString = strCn
            .Open
        Endwith
        With oRecordset
            .ActiveConnection = oConnection
            .Source = strShp
            .Open
        Endwith

        With This.hflex
            .Datasource = oRecordset
            .Mergecells = 3
            .GridColorBand(1) = Rgb(255,0,0)
            .GridColorBand(2) = Rgb(0,0,255)
            .GridColorBand(3) = Rgb(0,255,0)
            .ColWidth(0,0) = 300
            .CollapseAll
        Endwith
    Endproc

    Procedure Init
        With This
            .Set2.Left = .Set1.Left + .Set1.Width + 5
            .hflex.Top = .Set1.Top + .Set1.Height + 5
            .hflex.Height = .Height - (.hflex.Top + 5)
            .hflex.Left = 5
            .hflex.Width = .Width - 10
            .LoadSet(1)
        Endwith
    Endproc
    Procedure Set1.Click
        Thisform.LoadSet(1)
    Endproc
    Procedure Set2.Click
        Thisform.LoadSet(2)
    Endproc
Enddefine

source