Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Move record position in grid
Message
De
28/05/2009 09:20:43
 
 
À
28/05/2009 09:10:30
Neil Mc Donald
Cencom Systems P/L
The Sun, Australie
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire d'écran & Écrans
Versions des environnements
Visual FoxPro:
VFP 9 SP2
Divers
Thread ID:
01402444
Message ID:
01402448
Vues:
167
This message has been marked as the solution to the initial question of the thread.
Has anyone an example of howto be able to drag a record around in a grid, similar to the mover control on the left handside of the grid in VFP Table designer.

Here is the grid class:
**************************************************
*-- Class:        grdmover 
*-- ParentClass:  grid
*-- BaseClass:    grid
*
Define Class grdmover As grid

  AllowCellSelection = .T.
  *-- Name of icon to use in drag drop operation
  cok2dropicon = "DRAGMOVE.CUR"
  *-- Name of icon to use when not ok to drop (i.e., not over grid)
  cnodropicon = "NODROP02.CUR"
  *-- PK value of the grid row being moved
  nmoveditemkey = 0
  *-- Key value of the grid row being dropped upon
  ntargetkey = 0
  *-- Name of the PK field in the grid's RecordSOurce
  cpkfieldname = ""
  *-- Name of the sequence field
  cseqfieldname = ""
  *-- Relative row that the data is coming from
  nsourcerow = 0
  *-- Row that the data is going to
  ntargetrow = 0
  cobjmode = "ADD,EDIT"
  cmodeexpr = ""
  Name = "grdmover"


  *-- Re-order the sequence numbers and refresh the grid
  Procedure resequence
    Local lcPkFieldName, lcSeqFieldName, lnOldSeq, lnNewSeq, lnHeight
    Thisform.LockScreen = .T.
    With This
      *** Determine where the move is coming from
      lcPkFieldName = .cpkfieldname
      lcSeqFieldName = .RecordSource + '.' + .cseqfieldname
      Select ( .RecordSource )
      Locate For &lcPkFieldName == .nmoveditemkey
      If Not Found()
        *** Mayday! Mayday! This should never happen
        Messagebox( 'Kill me now and put me out of my agony!' + Chr( 13 ) + "Can't find Moved record in RecordSource", 16, 'Major WAAAAHHHHH!' )
        Return
      Endif
      lnOldSeq = Evaluate( lcSeqFieldName )
      *** Now find out where it is going
      Locate For &lcPkFieldName == .ntargetkey
      If Not Found()
        Return
      Endif
      lnNewSeq = Evaluate( lcSeqFieldName )
      *** Update the sequence numbers
      If lnOldSeq > lnNewSeq
        *** This is a move Up (e.g: row 5 to row 2)
        Replace All ( lcSeqFieldName ) With Evaluate( lcSeqFieldName ) + 1 ;
          FOR &lcSeqFieldName >= lnNewSeq ;
          AND &lcSeqFieldName < lnOldSeq
      Else
        *** This is a move down ( e.g.: row 2 to row 5 )
        Replace All ( lcSeqFieldName ) With Evaluate( lcSeqFieldName ) - 1 ;
          FOR &lcSeqFieldName > lnOldSeq ;
          AND &lcSeqFieldName <= lnNewSeq
      Endif
      *** put the moved item into the specified location
      Locate For &lcPkFieldName = .nmoveditemkey
      Replace ( lcSeqFieldName ) With lnNewSeq
      lnRecNo = Recno( .RecordSource )
      *** Do anything else you need to after the move
      .AfterMove()
      Go Top In ( .RecordSource )
      .Refresh()
      Go lnRecNo In ( .RecordSource )
      .SetFocus()
    Endwith
    Thisform.LockScreen = .F.
  Endproc


  Procedure DragDrop
    Lparameters oSource, nXCoord, nYCoord
    Local nWhereOut, nRelRowOut, lcPkFieldName
    *** If this is not the move butto, exit stage left
    If Upper( oSource.Name ) == 'CMDMOVE'
      With This
        *** Call GridHitTest to determine if we are in the grid
        If .GridHitTest( nXCoord, nYCoord, @nWhereOut, @nRelRowOut )
          *** Yep...make sure were are not dropping the source onto itself
          *** If this is the case, there is nothing to do
          .ntargetrow = nRelRowOut
          If .ntargetrow # .nsourcerow
            *** Move to Target Row
            *** If moving up, Source Row is > Target Row
            *** and skip will be negative
            *** If moving down, source row is < target row]
            *** and skip will be positive
            Skip .ntargetrow - .nsourcerow In ( .RecordSource )
            *** Save the value of the PK in the target record
            lcPkFieldName = .RecordSource + '.' + .cpkfieldname
            .ntargetkey = Evaluate( lcPkFieldName )
            *** Handle re-sequencing the records in the grid
            .resequence()
          Endif
        Endif
      Endwith
    Endif
  Endproc


  Procedure DragOver
    Lparameters oSource, nXCoord, nYCoord, nState
    Local nWhereOut, nRelRowOut
    *** See if we need to scroll the grid
    With This
      *** Calculate the maximum number of rows in the grid
      lnMaxRows = Int( ( .Height - .HeaderHeight - ;
        IIF( Inlist( .ScrollBars, 1, 3 ),;
        SYSMETRIC( 8 ), 0 ) ) / .RowHeight )
      .GridHitTest( nXCoord, nYCoord, @nWhereOut, @nRelRowOut )
      If nRelRowOut = 1
        .DoScroll( 0 )
      Else
        If nRelRowOut >= lnMaxRows
          .DoScroll( 1 )
        Endif
      Endif
    Endwith

    *** Set the appropriate icon
    If nState = 0
      oSource.DragIcon = Fullpath( This.cok2dropicon )
    Else
      If nState = 1
        oSource.DragIcon = Fullpath( This.cnodropicon )
      Endif
    Endif
  Endproc


  *-- Template method to do anything that needs to be done after resequencing
  Procedure AfterMove
  Endproc


Enddefine
And here is the mover button class:
**************************************************
*-- Class:        cmdmove 
*-- ParentClass:  commandbutton
*-- BaseClass:    commandbutton

Define Class cmdmove As commandbutton


  Height = 18
  Width = 18
  Picture = "..\graphics\ns_01.cur"
  Caption = ""
  Name = "cmdmove"


  Procedure MouseMove
    Lparameters nButton, nShift, nXCoord, nYCoord
    Local nWhereOut, nRelRowOut, lcPKFieldName
    If nButton = 1
      *** start the drag
      With This.Parent.Parent
        .GridHitTest( nXCoord, nYCoord, @nWhereOut, @nRelRowOut )
        .nSourceRow = nRelRowOut
        lcPKFieldName = .RecordSource + '.' + .cPkFieldName
        .nMovedItemKey = Evaluate( lcPKFieldName )
      Endwith
      This.Drag()
    Endif
  Endproc


Enddefine
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform