Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Listbox Moverbar type functionality in a Grid
Message
De
30/03/2004 09:42:01
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
 
À
30/03/2004 08:28:04
Herb Ellerbock
Customized Computer Systems
Australie
Information générale
Forum:
Visual FoxPro
Catégorie:
Gestionnaire d'écran & Écrans
Divers
Thread ID:
00890724
Message ID:
00890758
Vues:
18
This message has been marked as the solution to the initial question of the thread.
>Hello All,
>
>I would like to able to re-position records in a grid using listbox moverbar style functionality. Can anyone point the way to a methodology?
>
>TIA.
>
>Herb Ellerbock
>Customized Computer Systems

This is not a perfect sample but might be a starter :
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
Enddefine
And 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
Enddefine
Cetin
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform