ATOUTFOX
COMMUNAUTÉ FRANCOPHONE DES PROFESSIONNELS FOXPRO
Visual FoxPro : le développement durable

Forum AtoutFox : je réessais pour comprendre   

Sujet

rss Flux RSS des derniers messages

Vous devez vous identifier pour pouvoir poser une question ou répondre.

ven. 26 janvier 2018, 22h21
eddymaue
atoutfox.public.association

je réessais pour comprendre

dans MesNews il y a une case à décocher "Retour ligne auto"

*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 = IifLowerJustfname( 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 = RecnoThis.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 = IifEmpty( 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
*************************


--
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=0000018824
18 785 messages dans le forum • Liste complète des messages

Publicité

Les pubs en cours :


www.atoutfox.org - Site de la Communauté Francophone des Professionnels FoxPro - v3.4.0 - © 2004-2018.
Cette page est générée par un composant COM+ développé en Visual FoxPro 9.0