Forum AtoutFox : Re: detecter le click de la souris sur le header d'une colonne d'un grille   

ven. 26 janvier 2018, 12h09
eddymaue
atoutfox.public.association

Re: detecter le click de la souris sur le header d'une colonne d'un grille

Bonsoir
je n'ai coupé aucun commentaire
je n'ai qu'ajouté du code que tu trouveras
* **********************************
* add by Eddy Maue on Jan 25, 2018

le code ajouté

* End : add by Eddy Maue on Jan 25, 2018
* **********************************

le reste il est tel quel sauf au début avec Set Exclusive On

bonne journée

*2* added 31 january 2016 01:05:23 AM
*-- A method for sorting the grid by a column when the column header is
clicked if there is an index tag on the column's
* controlSource
*the grid is created as class grdBase.it uses the click on headers to
sort the cursor ascending or descending
*the solution uses the bindevent() function.
*the original class is adapted from free source of Marcia Akins
*
Close Data All
Set Safe Off
* ************************************************************
* pour pouvoir modier l'index j'ai dû mettre Set Exclusive On
Set Exclusive On
* ************************************************************
Select * From Home(1)+"samples\data\customer" Into Cursor ycurs
Sele ycurs
Local m.myvar
For i=1 To Fcount() &&here sort all cursor fields (each field have a
tag)
TEXT to m.myvar textmerge noshow
index on <<field(i)>> tag <<field(i)>>
ENDTEXT
Execscript(m.myvar)
Endfor
Locate

*rebuild images (sorting ascending/descending)
Local m.myvar
TEXT to m.myvar noshow
Qk02AQAAAAAAAHYAAAAoAAAAEgAAABAAAAABAAQAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP/////P/////wAAAP////zM/////wAAAP///8zMz////wAAAP///MzMzP///wAAAP//zMzMzM///wAAAP/8zMzMzMz//wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAA==
ENDTEXT
Strtofile(Strconv(m.myvar,14),"down.bmp")
TEXT to m.myvar noshow
Qk02AQAAAAAAAHYAAAAoAAAAEgAAABAAAAABAAQAAAAAAMAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAgAAAgAAAAICAAIAAAACAAIAAgIAAAICAgADAwMAAAAD/AAD/AAAA//8A/wAAAP8A/wD//wAA////AP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP/8zMzMzMz//wAAAP//zMzMzM///wAAAP///MzMzP///wAAAP///8zMz////wAAAP////zM/////wAAAP/////P/////wAAAP///////////wAAAP///////////wAAAP///////////wAAAP///////////wAAAA==
ENDTEXT
Strtofile(Strconv(m.myvar,14),"up.bmp")

Publi yform
yform=Newobject("asup")
yform.Show
*Read Events
Retu

Define Class asup As Form
Top = 0
Left = 0
Height = 601
Width = 710
ShowWindow=2
AutoCenter=.T.
Caption = "BindEvent Grid Sample Form"
Visible = .T.
Name = "Form1"

Add Object grid1 As grdbase With ;
anchor=15,;
FontName = "arial",;
FontSize = 10, ;
Height = 549, ;
Left = 14, ;
RecordSource = "ycurs", ;
RowHeight = 22, ;
headerHeight=25,;
Top = 27, ;
Width = 683, ;
backcolor=Rgb(212,208,200),;
Name = "grid1"

Procedure Init
With Thisform.grid1
DoDefault()

      * **********************************
      *  add by Eddy Maue on Jan 25, 2018
Local lnRecCount As Integer
m.lnRecCount = Reccount(.RecordSource)
.AddProperty("aRowDBcolor("+Transform(m.lnRecCount)+")")
Locate
i=0
Scan
i = i + 1
.aRowDBcolor(Recno()) = Mod(i, 2)
Endscan
lcConditionDBColor =
"IIF(thisform.grid1.aRowDBcolor(IIF(RECNO()=0,1,RECNO()))=0,Rgb(212,208,200),RGB(255,255,255))"
.SetAll("dynamicBackcolor" ,lcConditionDBColor ,"column")
      * End : add by Eddy Maue on Jan 25, 2018
      * **********************************
      *!*  .SetAll("dynamicBackcolor","iif(mod(recno()=2,rgb(255,255,255),Rgb(212,208,200)","column")
.SetAll("backcolor",Rgb(0,255,0),"header")

Locate
.Refresh
Endwith




Procedure Destroy
Clea Events
Endproc
Enddefine
*********************************
Define Class grdbase As Grid
DeleteMark = .F.
Height = 200
Themes=.F.
HighlightRow = .F.
Width = 320
HighlightStyle = 2
AllowCellSelection = .F.
  *-- Contains the field name that is currently controlling the sort
order
csortfield = ""
Name = "grdbase"

Procedure Init
This.SetGrid()
Endproc

  *-- Called from the grid's Init to handle setting it up properly
Procedure SetGrid
Local lnFgColor, lnBgColor, loColumn, loControl, lnCol, lnAlignment
    *** Set up for highlighting current row
Declare Integer GetSysColor In "user32" Integer nIndex
lnBgColor = GetSysColor( 13 )
lnFgColor = GetSysColor( 14 )

    *** Setup grid highlighing. We do not want a 50% gradient
With This
.HighlightBackColor = lnBgColor
.HighlightForeColor = lnFgColor
Endwith

    *** now make sure that the dblclick method of all the contained text
boxes
    *** delegate to the grid's dblclick()
For lnCol = 1 To This.ColumnCount
loColumn = This.Columns[ lnCol ]
      *** Set up the grid so that we we click on a column header
      *** we sort the grid where appropriate
For Each loControl In loColumn.Controls
If Lower( loControl.BaseClass ) = 'header'
Bindevent( loControl, 'Click', This, 'SortGrid' )
Else
If Pemstatus( loControl, [dblClick], 5 )
Bindevent( loControl, 'dblClick', This, 'dblClick' )
Endif
Endif
Endfor
Endfor
This.AutoFit()
Endproc

  *-- A method for sorting the grid by a column when the column header
is clicked if there is an index tag on the column's controlSource
  Procedure sortgrid
    Local laEvents[ 1 ], loHeader, lcField, loColumn, lcSortOrder,
loControl
    Local llFoundColumn, llAllowCellSelection, lnRecNo


    llAllowCellSelection = This.AllowCellSelection

    *** First of all, see which column fired off this event
    Aevents( laEvents, 0 )
    loHeader = laEvents[ 1 ]
    If Vartype( loHeader ) = 'O'
      *** First See if a ControlsSource was set for the column
      With loHeader.Parent
        lcField = ''
        If Not Empty( .ControlSource )
          *** Cool. Use it to decide how to sort the grid
          If Not Empty( .ControlSource ) And ( '.' $ .ControlSource ) And
Not( '(' $ .ControlSource )
            lcField = Justext( .ControlSource )
          Endif
        Endif
      Endwith
      If Empty( lcField )
        *** Try to find the field in the underlying data
        *** This code assumes that the
        *** The underlying cursor will be in natural order
        For lnCol = 1 To This.ColumnCount
          If This.Columns[ lnCol ].Name = loHeader.Parent.Name
            lcField = Field( lnCol, This.RecordSource )
            Exit
          Endif
        Endfor
      Endif
      This.csortfield = []
      *** we have a field - let's see if it already has a sort order set
      *** if it does, it will have the appropriate picture in the header
      lcSortOrder = ''
      If Not Empty( loHeader.Picture )
        lcSortOrder = Iif( Lower( Justfname( loHeader.Picture ) ) ==
'down.bmp', '', 'DESC' )
      Else
        *** See if there is a visual cue on any of the other grid
        *** column headers and remove it if there is
        For Each loColumn In This.Columns
          For Each loControl In loColumn.Controls
            If Lower( loControl.BaseClass ) == [header]
              If Not Empty( loControl.Picture )
                llFoundColumn = .T.
                loControl.Picture = []
                loControl.FontBold = .F.
                Exit
              Endif
            Endif
          Endfor
          If llFoundColumn
            Exit
          Endif
        Endfor
      Endif

      *** if we have a field - let's sort
      If Not Empty( lcField )
        *** Check to see if the tag exists assume
        *** that if there is a tag on this field, it has the same name as
the field
        *IF IsTag( lcField, This.RecordSource )
        This.csortfield = lcField
        lnRecNo = Recno( This.RecordSource )
        *** Go ahead and set the order for the table
        Select ( This.RecordSource )
        If Not Empty( lcSortOrder )
          Set Order To ( lcField ) Descending
        Else
          Set Order To ( lcField )
        Endif
        This.SetFocus()
        If lnRecNo # 0
          Go lnRecNo In ( This.RecordSource )
        Endif
        *** And set the visual cues on the header
        loHeader.Picture = Iif( Empty( lcSortOrder ), [up.bmp], [down.bmp]
)
        loHeader.FontBold = .T.
        loHeader.Parent.SetFocus()
      Endif
      * ENDIF

    Endif

    * **********************************
    * add by Eddy Maue on Jan 25, 2018
    With Thisform
      .LockScreen=.T.

      With .grid1

        Local lnRecCount As Integer, lnCurrentRecno As Integer
        m.lnCurrentRecno = Recno()
        m.lnRecCount = Reccount(.RecordSource)
        .AddProperty("aRowDBcolor("+Transform(m.lnRecCount)+")")
        Locate
        i=0
        Scan
          i = i + 1
          .aRowDBcolor(Recno()) = Mod(i, 2)
        Endscan

        Locate For Recno() =  m.lnCurrentRecno

      Endwith && Grid

      .LockScreen=.F.
      .Refresh()
    Endwith && Form
    * End : add by Eddy Maue on Jan 25, 2018
    * **********************************



  Endproc

Enddefine
*
*-- EndDefine: grdbase
*************************


Dans son message précédent, ybenam a écrit :


--
a+ Eddy
Merci de partager avec moi votre immense savoir que je me ferai plaisir
d'absorber... il va de soi que je vais vous en laisser un peu
Politesse et savoir vivre oblige ;0)
Permalink : http://www.atoutfox.org/nntp.asp?ID=0000018821