oForm = Createobject('myForm') oForm.Show Read Events Define Class myForm As Form DataSession = 2 Width = 450 Height = 540 Procedure Init This.Newobject('myGrid1','mySorterGrid1','','','crsTest') This.Newobject('myGrid2','mySorterGrid2','','','crsTest') With This.myGrid1 .Top = 10 .Left = 25 .Width = 400 .Height = 250 .Visible = .T. Endwith With This.myGrid2 .Top = 280 .Left = 25 .Width = 400 .Height = 250 .Visible = .T. Endwith Endproc Procedure Load Select cust_id, company,contact, ; 0x7FFFFFFF As sorter, 0x7FFFFFFF As original ; from customer ; order By cust_id ; into Cursor crsTest ; readwrite Replace All sorter With Recno(), original With Recno() Index On sorter Tag sorter Endproc Procedure QueryUnload Clear Events Endproc Enddefine Define Class myGrid As Grid DeleteMark = .F. ReadOnly = .T. RecordMark = .F. ScrollBars = 3 SplitBar = .F. Highlight = .F. HighlightRow = .F. Name = "grdMyGrid" Procedure AddColumn Lparameters nIndex, cAlias, cField Nodefault This.AddObject("clm"+cField,"myColumn", cAlias+"."+cField,nIndex) Endproc Procedure Init Lparameters tcRecordsource With This .ColumnCount = -1 .RecordSource = tcRecordsource nOldColCount = .ColumnCount For ix = 1 To Fcount(tcRecordsource) .AddColumn(ix, tcRecordsource,Field(ix,tcRecordsource)) Endfor .ColumnCount = nOldColCount Endwith Endproc Procedure MyDragDrop Lparameters oSource, nXCoord, nYCoord, nState Local lnFrom, lnTo With This nXCoord_In = Mcol(Wontop(),3) nYCoord_In = Mrow(Wontop(),3) Store 0 To nWhere_Out , nRelRow_Out , nRelCol_Out , nView_Out If .GridHitTest(nXCoord_In, nYCoord_In, ; @nWhere_Out, @nRelRow_Out, @nRelCol_Out) And nWhere_Out = 3 lnFrom = Recno() .ActivateCell(nRelRow_Out, nRelCol_Out) lnTo = Recno() .MoveRecord(lnFrom,lnTo) Endif Endwith EndProc Procedure MoveRecord Lparameters tnFrom, tnTo If tnFrom = tnTo Return Endif Local lnFrom, lnTo Select (This.RecordSource) Go tnTo lnTo = sorter Go tnFrom lnFrom = sorter If lnTo < lnFrom Replace sorter With sorter+1 For Between(sorter,lnTo,lnFrom-1) Else Replace sorter With sorter-1 For Between(sorter,lnFrom+1,lnTo) Endif Go tnFrom Replace sorter With lnTo This.Refresh Endproc Enddefine Define Class mySorterGrid1 As myGrid Name = "grdMyGrid" Procedure DragDrop Lparameters oSource, nXCoord, nYCoord, nState this.MyDragDrop(oSource, nXCoord, nYCoord, nState) Endproc Enddefine Define Class mySorterGrid2 As myGrid Name = "grdMyGrid" Procedure DragOver Lparameters oSource, nXCoord, nYCoord, nState this.MyDragDrop(oSource, nXCoord, nYCoord, nState) Endproc Enddefine Define Class myColumn As Column Resizable = .F. Movable = .F. Procedure Init Lparameters cControlSource, nIndex With This .ControlSource = cControlSource .ColumnOrder = nIndex .AddObject("myText","myGridTxtBox") .CurrentControl = "myText" .Sparse = .F. Endwith Endproc Enddefine Define Class myGridTxtBox As TextBox Name = "Text1" BorderStyle = 0 Procedure MouseDown Lparameters nButton, nShift, nXCoord, nYCoord If nButton=1 nStart=Seconds() Do While Mdown() And Seconds() - nStart < 1 If Seconds() - nStart > 0.8 This.Drag(1) Exit Endif Enddo Endif Endproc EnddefineAnd another way :
oForm=Createobject('form1') oForm.Show Read Events Define Class form1 As Form DataSession = 2 Top = 0 Left = 0 Height = 215 Width = 457 DoCreate = .T. Caption = "Form1" Name = "Form1" Add Object command1 As CommandButton With ; Top = 36, ; Left = 360, ; Height = 27, ; Width = 84, ; Caption = "Down", ; Name = "Command1" Add Object command2 As CommandButton With ; Top = 72, ; Left = 360, ; Height = 27, ; Width = 84, ; Caption = "Up", ; Name = "Command2" Procedure Init This.AddObject('grdemployee','myGrid') With This.grdEmployee .RecordSource = "crsTest" .SetAll('DynamicBackColor',; '(iif(Recno()=this.nRec,'+; Str(.Columns(1).Text1.SelectedBackColor)+; ',0xFFFFFF))') .SetAll('DynamicForeColor',; '(iif(Recno()=this.nRec,'+; Str(.Columns(1).Text1.SelectedForeColor)+',0))') .Visible = .T. .RecChange() Endwith Endproc Procedure Load Select *, 0x7FFFFFFF As sorter From employee Order By last_name Into Cursor crs1 nofilter Use Dbf('crs1') In 0 Again Alias 'crsTest' Use In 'crs1' Use In 'employee' Select crsTest Replace All sorter With Recno() Index On sorter Tag sorter Endproc Procedure QueryUnload Clear Events Endproc Procedure command1.Click If sorter=Reccount() Return Endif With Thisform.grdEmployee lnRec = Recno(.RecordSource) Skip In (.RecordSource) Replace sorter With sorter-1 In .RecordSource Go lnRec Replace sorter With sorter+1 In .RecordSource lnSorter = Eval(.RecordSource+'.sorter') Thisform.LockScreen = .T. Locate .Refresh =Seek(lnSorter, .RecordSource, 'sorter') .RecChange() *.Refresh Thisform.LockScreen = .F. Endwith Endproc Procedure command2.Click If sorter<=1 Return Endif With Thisform.grdEmployee lnRec = Recno(.RecordSource) Skip - 1 In (.RecordSource) Replace sorter With sorter+1 In .RecordSource Go lnRec Replace sorter With sorter-1 In .RecordSource .RecChange() * .Refresh Endwith Endproc Enddefine Define Class myGrid As Grid nRec = 0 Procedure AfterRowColChange Lparameters nCol This.RecChange Endproc Procedure RecChange This.nRec = Recno(This.RecordSource) This.Refresh() Endproc EnddefineCetin