************************************************** *-- Class: grdmover 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 Enddefineand here is the command nbutton class to use as the mover bar:
************************************************** *-- Class: cmdmove 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