1. Tenho os seguintes elementos (aqui exemplificados como vetor unidimensional): aVetor:={"DDDD","CCCC","AAAA","BBBB"}
2. Preciso ordenar de forma que fiquem:
- AAAA
BBBB
CCCC
DDDD
Código: Selecionar todos
/*
PROGRAMA : MUDAPOS.PRG
COMENTARIO : Rotina para alterar a ordem dos elementos através de um menú.
Clipper 5.2 + CT
*/
#include "inkey.ch"
#include "achoice.ch"
FOR I=0 TO 24
@ I,00 SAY REPLICATE("Û",80) COLOR "W+/B"
NEXT
aVetor:={"DDDD","CCCC","AAAA","BBBB"} // 1º exemplo
aNew:=MUDA_SEQ(06,18,21,63,{"15/01","01/07","15/04","15/01"},aVetor)
FOR I=0 TO 24
@ I,00 SAY REPLICATE("Û",80) COLOR "W+/B"
NEXT
aVetor:={}
FOR I=65 TO 90
AADD(aVetor,REPLICATE(CHR(I),4)) // 2º exemplo
NEXT
aNew:=MUDA_SEQ(06,18,21,63,{"15/01","01/07","15/04","15/01"},aVetor)
FUNCTION MUDA_SEQ(nLni,nCli,nLnf,nClf,aCor,aVetor)
SET CURSOR OFF
nTam:=LEN( aVetor )
nTlm:=LEN( ALLTRIM( STR( nTam ) ) )
nIni:=1
SETCOLOR(aCor[1]+","+aCor[2]+",,,"+aCor[3])
@ nLni-1,(nCli-2)-(nTlm+1) CLEAR TO ( if( (nLni+nTam+1)<nLnf,(nLni+nTam),nLnf+1) ),nClf+2
@ nLni-1,(nCli-2)-(nTlm+1),( if( (nLni+nTam+1)<nLnf,(nLni+nTam),nLnf+1) ),nClf+2 BOX ( CHR(218)+CHR(196)+CHR(191)+CHR(179)+CHR(217)+CHR(196)+CHR(192)+CHR(179) ) COLOR aCor[4]
SOMBRA(nLni-1,(nCli-2)-(nTlm+1),( if( (nLni+nTam+1)<nLnf,(nLni+nTam),nLnf+1) ),nClf+2)
DO WHILE .T.
MENSAGEM("Selecione com <Enter> o que deseja mudar a ordem")
FOR I=1 TO nTam
@ (nLni-1)+I,(nCli-nTlm)-1 SAY PADL(ALLTRIM(STR(I)),nTlm) COLOR aCor[1]
NEXT
nIni:=ACHOICE(nLni,nCli,nLnf,nClf,aVetor,,"FUN_KEY",nIni)
IF LASTKEY()=27
EXIT
ENDIF
MENSAGEM("Utilize "+CHR(25)+" e "+CHR(24)+" para mudar e <Enter> para finalizar")
aVetor_tmp:=aVetor
nIni_tmp:=nIni
DO WHILE .T.
aElement:=aVetor[nIni]
nLnP:=FVQPOS(nCli,aElement)
@ nLnP,nCli SAY PADR(aElement,(nClf-nCli)+2) COLOR aCor[3]
@ nLnP,(nCli-1) SAY CHR(16) COLOR aCor[3]
@ nLnP,nCli+(nClf-nCli)+1 SAY CHR(17) COLOR aCor[3]
nKey:=INKEY(0)
@ (nLni-1)+nIni,(nCli-1) SAY " " COLOR aCor[1]
@ (nLni-1)+nIni,nCli+(nClf-nCli)+1 SAY " " COLOR aCor[1]
DO CASE
CASE nKey=27 // ESC
aVetor:=aVetor_tmp
nIni:=nIni_tmp
EXIT
CASE nKey=13 // ENTER
EXIT
CASE nKey=5 // Up
avetor:=SOBE(aVetor,nIni,nTam)
CASE nKey=24 // Down
avetor:=DESCE(avetor,nIni,nTam)
ENDCASE
nIni:=ASCAN( avetor,ALLTRIM(aElement) )
FOR I=1 TO nTam
@ (nLni-1)+I,nCli SAY PADR(avetor[I],(nClf-nCli)+1) COLOR (IF(I=nIni,aCor[2],aCor[1]))
NEXT
ENDDO
ENDDO
RETURN aVetor
FUNCTION SOBE(aTmp,nIni,nTam)
Local aNew
aNew:={}
FOR nCurrent := 1 TO nTam
AADD( aNew,SUBSTR(aTmp[nCurrent],AT("ÿ",aTmp[nCurrent])+1) )
NEXT
IF nIni=1
RETURN aNew
ENDIF
aTmp:={}
FOR nCurrent := 1 TO nTam
IF nCurrent<(nIni-1)
AADD( aTmp, anew[nCurrent] )
ELSE
IF nCurrent=(nIni-1)
AADD( aTmp, anew[nIni] )
ELSE
IF nCurrent=nIni
AADD( aTmp, anew[(nIni-1)] )
nRini:=1
ELSE
AADD( aTmp, anew[(nIni+nRini)] )
nRini:=nRini+1
ENDIF
ENDIF
ENDIF
NEXT
RETURN aTmp
FUNCTION DESCE(aTmp,nIni,nTam)
Local aNew
aNew:={}
FOR nCurrent := 1 TO nTam
AADD( aNew,SUBSTR(aTmp[nCurrent],AT("ÿ",aTmp[nCurrent])+1) )
NEXT
IF nIni=nTam
RETURN aNew
ENDIF
aTmp:={}
FOR nCurrent := 1 TO nTam
IF nCurrent<nIni
AADD( aTmp, anew[nCurrent] )
ELSE
IF nCurrent=nIni
AADD( aTmp, anew[nIni+1] )
ELSE
IF nCurrent=(nIni+1)
AADD( aTmp, anew[nIni] )
nRini:=2
ELSE
AADD( aTmp, anew[(nIni+nRini)] )
nRini:=nRini+1
ENDIF
ENDIF
ENDIF
NEXT
RETURN aTmp
FUNCTION FUN_KEY( nMode, nCurElement, nRowPos )
LOCAL nRetVal:=AC_CONT, nKey:=LASTKEY()
DO CASE
CASE nMode == AC_IDLE
nRetVal := AC_CONT
CASE nMode == AC_HITTOP
TONE( 100, 3 )
CASE nMode == AC_HITBOTTOM
TONE( 100, 3 )
CASE nMode == AC_EXCEPT
DO CASE
CASE nKey == K_RETURN
nRetVal := AC_SELECT
CASE nKey == K_ESC
nRetVal := AC_ABORT
OTHERWISE
nRetVal := AC_GOTO
ENDCASE
ENDCASE
RETURN nRetVal
FUNCTION FVQPOS(VPC,VSTRNG)
Local VPL,VPT,VFND,VPOS
VPT:=LEN(VSTRNG)
VPOS:=0
FOR VPL=1 TO 24
VFND:=CHARODD(SCREENSTR(VPL,VPC,VPT))
VPOS:=VPOS+1
IF VFND=VSTRNG
EXIT
ENDIF
NEXT
RETURN VPOS
FUNCTION SOMBRA( LIN_SUP, COL_SUP, LIN_INF, COL_INF )
IF PCOUNT() = 2 .OR. PCOUNT() = 3
C_SOM := COL_SUP; L_SOM := LIN_SUP
LIN_SUP := VAL( SUBS( C_SOM, 1, 2 ) )
COL_SUP := VAL( SUBS( C_SOM, 3, 2 ) )
LIN_INF := VAL( SUBS( C_SOM, 5, 2 ) )
COL_INF := VAL( SUBS( C_SOM, 7, 2 ) )
COL_SOM := SUBS( C_SOM, 9 )
LIN_SOM := L_SOM
ENDIF
IF COL_SUP < 2 .OR. LIN_INF > 22
C_SOM := ""; L_SOM := ""
RETURN .F.
ENDIF
IF PCOUNT() = 3
RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
RETURN .F.
ENDIF
IF PCOUNT() != 2
COL_SOM := SAVESCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1 )
LIN_SOM := SAVESCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2 )
ENDIF
IF SUBS( COL_SOM, 2, 1 ) != CHR( 8 )
C_SOM := STR( LIN_SUP, 2 ) + STR( COL_SUP, 2 ) + STR( LIN_INF, 2 ) +;
STR( COL_INF, 2 ) + COL_SOM
L_SOM := LIN_SOM
ENDIF
FOR I = 2 TO LEN( COL_SOM ) STEP 2
COL_SOM := STUFF( COL_SOM, I, 1, CHR( 8 ) )
NEXT
FOR I = 2 TO LEN( LIN_SOM ) / 2 STEP 2
LIN_SOM := STUFF( LIN_SOM, I, 1, CHR( 8 ) )
NEXT
RESTSCREEN( LIN_SUP + 1, COL_SUP - 2, LIN_INF + 1, COL_SUP - 1, COL_SOM )
RESTSCREEN( LIN_INF + 1, COL_SUP - 2, LIN_INF + 2, COL_INF - 2, LIN_SOM )
RETURN .T.
FUNCTION MENSAGEM( TEXTO, PAUSA )
STATIC ULT_MENSAGEM := ""
LOCAL ULT_CURSOR := SETCURSOR()
IF TEXTO = NIL; TEXTO := ""; ENDIF
@ MAXROW(), 11 SAY PADC( TEXTO, 58 ) COLOR "N/W"
IF PAUSA = NIL
ULT_MENSAGEM := TEXTO
ELSE
INKEY( PAUSA )
@ MAXROW(), 11 SAY PADC( ULT_MENSAGEM, 58 ) COLOR "W/N"
ENDIF
RETURN NILCódigo: Selecionar todos
nIni:=ASCAN( avetor,ALLTRIM(aElement) )
FOR I=1 TO nTam
@ (nLni-1)+I,nCli SAY PADR(avetor[I],(nClf-nCli)+1) COLOR (IF(I=nIni,aCor[2],aCor[1]))
NEXT
