move a record from xbrowse

[ukoenig]

My solution for the moment with the following problem

1. A table is splitted in different groups ( index on group )
2. Inside a group, I have to switch 2 positions.
3. A visual display of the 2 selected records is added

Code: Select all  Expand view

// ------------------

FUNCTION CHANGE_POS(cMonth)
LOCAL I := 0, h1, h2, nRecord1, nRecord2, cGroup1 := "", cGroup2 := ""

DBSELECTAREA( cMonth )
( cMonth )->(DBGOTOP())

I := 0
DO WHILE !EOF()
    IF ( cMonth )->CHANGE = "X"     // detects 2 selected records
                                                  // to change the position
        I++
    ENDIF
     ( cMonth )->(DBSKIP(+1))
ENDDO

IF I = 0
    MsgAlert( "No records selected", "ERROR" )
    RETURN( NIL )
ELSEIF I = 1
    MsgAlert( "Only 1 record selected", "ERROR" )
    RETURN( NIL )
ENDIF

I := 0
( cMonth )->(DBGOTOP())
DO WHILE !EOF()
    IF ( cMonth )->CHANGE = "X"  // selected for change
        I++
        IF I = 1
            cGroup1 := ( cMonth )->GROUP        // 1. selected group  
            nRecord1 := ( cMonth )->(RECNO())   // 1. selected record
            h1 := FW_RecToHash()
        ELSEIF I = 2
            cGroup2 := ( cMonth )->GROUP             // 2. selected group  
            nRecord2 := ( cMonth )->(RECNO())      // 2. selected record
            h2 := FW_RecToHash()
        ELSEIF I > 2                                // 2 selections reached
            EXIT
        ENDIF
    ENDIF
    ( cMonth )->(DBSKIP(+1))
ENDDO

IF cGroup1 <> cGroup2
    MsgAlert( "Not possible, to change" + CRLF + ;
                       "the position using different groups !", "ERROR" )
    RETURN( NIL )
ENDIF

// write data to the 2 selected records ( 1 to 2 and 2 to 1 )

( cMonth )->(DBGOTO(nRecord1))
FW_HashToRec( h2 )

( cMonth )->(DBGOTO(nRecord2))
FW_HashToRec( h1 )

( cMonth )->(DBGOTOP())

RETURN NIL
 

best regards
Uwe

[FranciscoA]

This is a very simple case, works only when the start and destination are both visible on the same screen. This example also does not have any error handling. In real life we may need to handle scrolling also if the destination is several rows away.
This should serve as a simple example to form the basis of a complex final product.

Cut and Paste instead of Drag and Drop:
Instead of using Drag/Drop, we can also use Cut and Paste. Cut the source record, navigate to the new position and then move the record there .

I agree.

[Silvio.Falconi]

This is an example of moving a row from one position to another position by drag and drop. This is demonstrated with an array

Code: Select all  Expand view

#include "fivewin.ch"

function main()

   local oDlg, oBrw, oFont, oCur, aData[ 12 ]

   AEval( aData, { |u,i| aData[ i ] := NtoCMonth( i ) } )

   DEFINE CURSOR oCur DRAG
   DEFINE FONT oFont NAME "VERDANA" SIZE 0,-16
   DEFINE DIALOG oDlg SIZE 250,500 PIXEL FONT oFont
   @ 10,10 XBROWSE oBrw SIZE -10,-10 PIXEL OF oDlg ;
      DATASOURCE aData COLUMNS 1 CELL LINES NOBORDER

   WITH OBJECT oBrw
      :nStretchCol      := 1
      :oDragCursor      := oCur
      :bDragBegin       := { |r,c,f,o| SetDropInfo( { oBrw:nArrayAt, oBrw:aRow } ) }
      :bDropOver        := { |u,r,c,f| oBrw:LButtonDown( r,c ), ;
                                       oBrw:LButtonUp(), ;
                                       aDel( aData, u[ 1 ] ), ;
                                       AIns( aData, oBrw:nArrayAt, u[ 2 ] ), ;
                                       oBrw:Refresh() }

      //
      :CreateFromCode()
   END

   ACTIVATE DIALOG oDlg CENTERED
   RELEASE FONT oFont
   RELEASE CURSOR oCur

return nil
 

Dear Mr Rao,
thank for your sample.
I use a Dbf into Order application and I must move all the row at n position

as this:




and this is my source

Code: Select all  Expand view

SELECT TB
                         TB->(DbSetOrder(1))
                         TB->( OrdScope(0, { || cPreNumDoc }))
                         TB->( OrdScope(1, { || cPreNumDoc }) )
                         TB->(DbGoTop())

        aBrowse     :=  {{"PAITEM"      ,i18n("Codice")       ,nil                  ,50 },;
                        { "PADESC"      ,i18n("Descrizione")  ,nil                 ,290 },;
                        { "PAQTY"       ,i18n("Quantità")     ,"9999"               ,45 },;
                        { "PAMISURA"    ,i18n("Misura")       ,nil                  ,37 },;
                        { "PAUNITARIO"  ,i18n("Unitario")     ,pict_money_Euro      ,80 },;
                        { "PASCONTO"    ,i18n("%Sconto")       , nil                ,60 },;
                        { "PAPROVV"     ,i18n("%Provv.")      ,'@ 999.99%'          ,50 },;
                        { "PARIT"       ,i18n("Ritenuta")     ,nil                  ,80 },;
                        { "PAIVA"       ,i18n("Iva")          ,"99%"                ,36 },;
                        { "PATOTALE"    ,i18n("Importo")      ,pict_money_Euro      ,80 }}

 @ 0, 0.2 XBROWSE oBrw       ;
      OF oFld:adialogs[1] DATASOURCE "TB" ;
      COLUMNS aBrowse CELL LINES  FOOTERS NOBORDER   FONT oFont


 oBrw:CreateFromCode()

How I can make it with a dbf ? .. thanks

[solving]

***** Italiano

io farei cosi :
all'indice da te creato aggiungo un campo num_riga
( preferibile un campo carattere con riempimento automatico con zeri a sinistra )

Nuovo Indice -> cPreNumDoc + Num_Riga

crea campo num_riga con passo 1 ( 001, 002, 003, 004, etc.. )
(posso anche non far vedere il campo num_riga nel browse )

Poi clicco con il pulsante destro del mouse sul record/riga da muovere, memorizzo il record.
(posso far apparire un messaggio che dica "copiato/selezionato" il num_riga).

Poi clicco con il pulsante destro del mouse nel record/riga dove copiarlo/spostarlo
e faccio uno scambio sul campo num_riga.

saluti
( uso un traduttore automatico )

***** English

I would do so:
the index you created to add a field num_riga
(preferable a field with automatic filling with zeros to the left)

New Index -> cPreNumDoc + Num_Riga

creates filed num_riga with step number 1 (001, 002, 003, 004, etc ..)
(I can also not to show the field num_riga in browse)

Then I click them with the right mouse button on the record / row to move, I memorize the record.
(I can bring up a message saying "copied / selected" the num_riga).

Then I click with the right mouse button in the record / line where to copy / move it
and do an exchange on the field num_riga.

example:
record 1 num_riga 001
record 2 num_riga 002
record 3 num_riga 003
....
...
record 10 num_riga 010 (to move)
...
...
record 30 num_riga 030 (where to move)
...
...
recod 100 num_riga 100

Step 1 click in the record 10 num_riga 010
Step 2 click in the record 30 num_riga 030

-----> function that reverse /swap num_riga

at the end I'll have '

record 10 num_riga = 030
record 30 num_riga = 010

Greetings
(Use an automatic translator)

[Silvio.Falconi]

Mr. Nages,

Can we please have this sample with a DBF?.

Thank you.

This xbrowse example, after the end of the drag, informs the programmer, start record number and destination record number. The programmer has to decide if he wants to swap data of some fields between these two records or wants a visual re-ordering of the rows where the moved record appears in the new position.

First thing to decide is how the programmer wants to record the change in the dbf. Once that is clear, it can be plugged into the bDropOver.

can you create asmal ltest with dbf thanks

[Maurizio]

Hello

this works with ADO and field LINE_NUMBER

Code: Select all  Expand view

:oDragCursor      := oCur
         :bDragBegin       := { |r,c,f,o| SetDropInfo( { oRs:AbsolutePosition ,;
                                          oRs:Fields( "LINE_NUMBER" ):Value ,0 } ) }
         :bDropOver        := { |u,r,c,f| oBrw:LButtonDown( r,c ), ;
                                       oBrw:LButtonUp(), ;
                                       u[3] := oRs:Fields( "LINE_NUMBER" ):Value ,;
                                       oRs:Fields( "LINE_NUMBER" ):Value := u[2] ,oRS:Update(),;
                                       oRs:AbsolutePosition := u[1] ,;
                                       oRs:Fields( "LINE_NUMBER" ):Value := u[3] ,oRS:Update(),;
                                       oRs:ReQuery(),;
                                       oBrw:Refresh() }
 

Maurizio
www.nipeservice.com

[Silvio.Falconi]

I wish move all fields and I not use oRs

[ukoenig]

Silvio,

this sample moves record n to row-pos x.
The record from pos x moves to the position of record n

Code: Select all  Expand view

#include 'fivewin.ch'
#include 'ord.ch'
#include 'xbrowse.ch'

REQUEST DBFCDX

FUNCTION MAIN()
local oDlg, oBrw, oFont
local nMaxSal  := 0, oCur, nPos1, h1, h2
local nProgClr := RGB( 161, 224, 255 )

DEFINE CURSOR oCur DRAG

XBrNumFormat( 'E', .t. )

USE customer NEW SHARED ALIAS CUST VIA 'DBFCDX'

DBEval( { || nMaxSal := Max( nMaxSal, FIELD->Salary ) } )
GO TOP

DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12

DEFINE DIALOG oDlg SIZE 500,300 PIXEL ;
      TITLE "Progress Bars in XBrowse" ;
      FONT oFont

@ 10,10 XBROWSE oBrw ;
      COLUMNS 'First', 'Age', 'Salary' ;
      OF oDlg ;
      SIZE -10,-10 PIXEL ;
      PICTURES nil, '999.99 %' ;
      ALIAS 'CUST' ;
      CELL LINES AUTOSORT NOBORDER FOOTERS

WITH OBJECT oBrw:Salary
      :nTotal     := 0
      :lTotal     := .t.
      :SetProgBar( { || nMaxSal },, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

WITH OBJECT oBrw:Age
      :cHeader    := 'Percent'
      :SetProgBar( 100, 104, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

oBrw:bRClicked := { || nRPos := RECNO(), ;
                       nCPos := oBrw:SelectedCol():nCreationOrder, ;
                       MsgAlert( RECNO(), "Record" ) }

WITH OBJECT oBrw
      :nStretchCol   := 1
      :MakeTotals()
      :oDragCursor      := oCur
      :bDragBegin       := { |r,c,f,o| nPos1 := RECNO(), h1 := FW_RecToHash() }
      :bDropOver        := { |u,r,c,f| oBrw:LButtonDown( r,c ), ;
                         h2 := FW_RecToHash(), ;
                         oBrw:LButtonUp(), ;
                         FW_HashToRec( h1 ), ;
                         DBGOTO( nPos1 ), ;
                         FW_HashToRec( h2 ), ;
                         oBrw:Refresh() }

      :CreateFromCode()
END

ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
RELEASE CURSOR oCur

RETURN NIL
 

best regards
Uwe

[Silvio.Falconi]

sorry I not have FW_RecToHash() and FW_HashToRec functions

[ukoenig]

Silvio,

I can show another function to save and write a record to a array if needed.

best regards
Uwe

[ukoenig]

Silvio,

A replacement of FW_RecToHash() and FW_HashToRec that works the same.

Code: Select all  Expand view

#include 'fivewin.ch'
#include 'ord.ch'
#include 'xbrowse.ch'

REQUEST DBFCDX

FUNCTION MAIN()
local oDlg, oBrw, oFont
local nMaxSal  := 0, oCur, nPos1, h1, h2
local nProgClr := RGB( 161, 224, 255 )
local COLLECT1 := {}, COLLECT2 := {}

DEFINE CURSOR oCur DRAG

XBrNumFormat( 'E', .t. )

USE customer NEW SHARED ALIAS CUST VIA 'DBFCDX'

DBEval( { || nMaxSal := Max( nMaxSal, FIELD->Salary ) } )
GO TOP

DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12

DEFINE DIALOG oDlg SIZE 500,300 PIXEL ;
      TITLE "Progress Bars in XBrowse" ;
      FONT oFont

@ 10,10 XBROWSE oBrw ;
      COLUMNS 'First', 'Age', 'Salary' ;
      OF oDlg ;
      SIZE -10,-10 PIXEL ;
      PICTURES nil, '999.99 %' ;
      ALIAS 'CUST' ;
      CELL LINES AUTOSORT NOBORDER FOOTERS

WITH OBJECT oBrw:Salary
      :nTotal     := 0
      :lTotal     := .t.
      :SetProgBar( { || nMaxSal },, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

WITH OBJECT oBrw:Age
      :cHeader    := 'Percent'
      :SetProgBar( 100, 104, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

oBrw:bRClicked := { || nRPos := RECNO(), ;
                       nCPos := oBrw:SelectedCol():nCreationOrder, ;
                       MsgAlert( RECNO(), "Record" ) }

WITH OBJECT oBrw
      :nStretchCol   := 1
      :MakeTotals()
      :oDragCursor      := oCur
      :bDragBegin       := { |r,c,f,o| nPos1 := RECNO(), COLLECT1 := RECREAD() }
      :bDropOver        := { |u,r,c,f| oBrw:LButtonDown( r,c ), ;
                   COLLECT2 := RECREAD(), ;
                   oBrw:LButtonUp(), ;
                   RECWRITE(COLLECT1), ;
                   DBGOTO( nPos1 ), ;
                   RECWRITE(COLLECT2), ;
                   oBrw:Refresh() }

      :CreateFromCode()
END

ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
RELEASE CURSOR oCur

RETURN NIL

// ------------------

FUNCTION RECREAD()
LOCAL FX, COLLECT := {}

nFields := FCOUNT()

FX := 1
FOR FX := 1 TO nFields
    AADD(COLLECT, FIELDGET(FX))
NEXT

RETURN COLLECT

// ------------------

FUNCTION RECWRITE(COLLECT)
LOCAL FX

nFields := FCOUNT()

FX := 1
rlock()
FOR FX := 1 TO nFields  
    FIELDPUT(FX, COLLECT[FX])
NEXT
dbunlock()

RETURN NIL
 

[lucasdebeltran]

Hello,

Very interesting. But when I drag over, I found this error:

Error occurred at: 11/15/15, 17:35:22
Error description: Error BASE/1074 Argument error: <=
Args:
[ 1] = U
[ 2] = N 21

Stack Calls
===========
Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:HEADERLBUTTONUP( 11096 )
Called from: .\source\classes\XBROWSE.PRG => TXBROWSE:LBUTTONUP( 3528 )
Called from: uvetest.prg => (b)MAIN( 64 )
Called from: .\source\classes\WINDOW.PRG => TXBROWSE:DROPOVER( 3285 )
Called from: => TWINDOW:HANDLEEVENT( 0 )

Thanks.

[Antonio Linares]

Lucas,

What source code do you have there in line 11096 ?

Called from: .\source\classes\XBROWSE.PRG => TXBRWCOLUMN:HEADERLBUTTONUP( 11096 )

[FranciscoA]

Uwe.
Works fine onto my 12.04 version.
Thanks.

Code: Select all  Expand view

#include 'fivewin.ch'
#include 'ord.ch'
#include 'xbrowse.ch'

REQUEST DBFCDX

FUNCTION MAIN()
local oDlg, oBrw, oFont
local nMaxSal  := 0, oCur, nPos1, h1, h2
local nProgClr := RGB( 161, 224, 255 )
local COLLECT1 := {}, COLLECT2 := {}
local nRpos, nCpos

DEFINE CURSOR oCur DRAG

XBrNumFormat( 'E', .t. )

USE customer NEW SHARED ALIAS CUST VIA 'DBFCDX'

DBEval( { || nMaxSal := Max( nMaxSal, FIELD->Salary ) } )
GO TOP

DEFINE FONT oFont NAME "TAHOMA" SIZE 0,-12

DEFINE DIALOG oDlg SIZE 500,300 PIXEL ;
      TITLE "Progress Bars in XBrowse" ;
      FONT oFont

@ 10,10 XBROWSE oBrw ;
      COLUMNS 'First', 'Age', 'Salary' ;
      OF oDlg ;
      SIZE -10,-10 PIXEL ;
      PICTURES nil, '999.99 %' ;
      ALIAS 'CUST' ;
      CELL LINES AUTOSORT NOBORDER FOOTERS

WITH OBJECT oBrw:Salary
      :nTotal     := 0
      :lTotal     := .t.
      :SetProgBar( { || nMaxSal },, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

WITH OBJECT oBrw:Age
      :cHeader    := 'Percent'
      :SetProgBar( 100, 104, { || { nProgClr, CLR_WHITE } } )
      :nDataStrAlign := AL_RIGHT
END

oBrw:bRClicked := { || nRPos := RECNO(), ;
                       nCPos := oBrw:SelectedCol():nCreationOrder, ;
                       MsgAlert( RECNO(), "Record" ) }

WITH OBJECT oBrw
      :nStretchCol   := 1
      :MakeTotals()
      :oDragCursor      := oCur
      :bDragBegin       := { |r,c,f,o| nPos1 := RECNO(), COLLECT1 := RECREAD() }
      :bDropOver        := { |u,r,c,f| oBrw:LButtonDown( r,c ), ;
                   COLLECT2 := RECREAD(), ;
                   oBrw:LButtonUp(), ;
                   RECWRITE(COLLECT1), ;
                   DBGOTO( nPos1 ), ;
                   RECWRITE(COLLECT2), ;
                   oBrw:Refresh() }

      :CreateFromCode()
END

ACTIVATE DIALOG oDlg CENTERED
RELEASE FONT oFont
RELEASE CURSOR oCur
Cust->(dbCloseArea())
RETURN NIL

// ------------------

FUNCTION RECREAD()
LOCAL FX, COLLECT := {}
local nFields := FCOUNT()

FX := 1
FOR FX := 1 TO nFields
    AADD(COLLECT, FIELDGET(FX))
NEXT

RETURN COLLECT

// ------------------

FUNCTION RECWRITE(COLLECT)
LOCAL FX
local nFields := FCOUNT()

FX := 1
rlock()
FOR FX := 1 TO nFields  
    FIELDPUT(FX, COLLECT[FX])
NEXT
dbunlock()

RETURN NIL
 

[lucasdebeltran]

Antonio,

if nMRow <= ::oBrw:nHeaderHeight ;
.and. nMCol <= ( ::nWidth + ::nDisplayCol )


Thanks!.