Aproveitando o tópico sobre indices CDX coloquei aqui uma função muito util para filtragem de grande bases de dados para um arquivo temporário com opção de organização.
Analise o exemplo que pode ser compilado em Clipper puro.
Código exemplo:
#include "common.ch"
#include "inkey.ch"
#include "fivewin.ch"
/* **** **** **** **** **** **** **** **** **** **** **** **** **** **** */
#include "selector.ch"
/*
static clientes := {}, nRegiao
function main
SET DEFAULT TO D:\CLEVER\FATALL
USE CLIENTES NEW
USE FORNEC NEW
@ clientes SELECT clientes->nome, clientes->endereco, clientes->bairro, clientes->estado ;
FROM clientes ;
FOR clientes->estado='SP' ;
TO tempo1
BROWSE()
@ clientes SELECT clientes->nome, clientes->endereco, clientes->bairro, clientes->estado ;
FROM clientes ;
FOR clientes->estado='CE' ;
TO tempo2
BROWSE()
@ clientes SELECT clientes->regiao ;
FROM clientes ; // INDEX ON regiao+dtoc(datacad)
TO tempo3 ;
SUMMARY nRegiao
BROWSE()
CLOSE DATA
return
*/
/* **** **** **** **** **** **** **** **** **** **** **** **** **** **** */
Procedure SELECTOR(Arg1, Arg2, Arg3, Arg4, Arg5, Arg6, Arg7, Arg8, ;
Arg9, Arg10, Arg11, Arg12)
Local Local1, Local2, Local3, Local4, Local5, Local6, Local7, ;
Local8, Local9, Local10, Local11, Local12, Local13, Local14, ;
Local15, Local16, Local17, Local18, Local19, Local20, Local21, ;
Local22, Local23
Local1:= Len(Arg1)
Local6:= {}
Local7:= ISARRAY(Arg3)
Local14:= {}
Local15:= .F.
Local17:= ""
Local19:= !(ISNIL(Arg10))
If recco()=0
msgrun('Arquivo vazio ou area sem uso','Selector Error')
//return
EndIf
If (ISNIL(Arg2))
Local10:= Select()
Else
If (ISNUMBER(Arg2))
Local10:= Arg2
ElseIf (ISCHARACTER(Arg2))
Local10:= Select(Arg2)
EndIf
Select (Local10)
EndIf
If (Local7)
Local11:= Select(Arg3[1])
EndIf
If (ISNIL(Arg7))
Arg7:= "TEMP.DBF"
Default Arg8 To "temp"
ElseIf (ISNIL(Arg8))
Arg8:= SubStr(Arg8:= SubStr(Arg7, rat("\", Arg7) + 1), 1, ;
At(".", Arg8 + ".") - 1)
EndIf
Default Local16 To IIf((Local8:= rat(".", Arg7)) > rat("\", ;
Arg7), SubStr(Arg7, 1, Local8 - 1), Arg7) + ".NTX"
Local23:= RecNo()
Goto LastRec() + 1
If (Local7)
(Local11)->(dbGoto(LastRec() + 1))
EndIf
For Local9:= 1 To Local1
Local2:= eval(Arg1[Local9][1])
Local4:= ValType(Local2)
Local3:= Transform(Local2, "")
Local5:= Len(Local3)
AAdd(Local6, {IIf((Local8:= At("->", Arg1[Local9][2])) == 0, ;
Arg1[Local9][2], SubStr(Arg1[Local9][2], Local8 + 2)), ;
Local4, IIf(Arg1[Local9][3] != Nil, Arg1[Local9][3], ;
IIf(Local4 == "D", 8, Local5)), IIf(Arg1[Local9][4] != Nil, ;
Arg1[Local9][4], IIf(Local4 == "N" .AND. (Local8:= At(".", ;
Local3)) > 0, Local5 - Local8, 0))})
If (Arg1[Local9][5] == "G")
If (!Local15)
Local15:= .T.
Else
Local17:= Local17 + "+"
EndIf
Do Case
Case Local4 == "C"
Local17:= Local17 + Local6[Local9][1]
Case Local4 == "N"
Local17:= Local17 + ("Str(" + Local6[Local9][1] + ")")
Case Local4 == "D"
Local17:= Local17 + ("DToS(" + Local6[Local9][1] + ")")
Case Local4 == "L"
Local17:= Local17 + ("Iif(" + Local6[Local9][1] + ;
[,"1","0")])
EndCase
AAdd(Local14, Arg1[Local9][1])
ElseIf (Arg1[Local9][6] .AND. Local19 .AND. !Arg9)
AAdd(Arg10, 0)
EndIf
Next
Goto Local23
If (Arg9)
Local12:= Select(Arg8)
Else
dbcreate(Arg7, Local6)
dbUseArea(.T., Nil, Arg7, Arg8, .F.)
Local12:= Select()
If (Local15)
dbCreateIndex(Local16, Local17, &("{||" + Local17 + "}"))
EndIf
Select (Local10)
EndIf
If (!Arg6)
Goto Top
EndIf
If (Local7)
Do While (!EOF() .AND. !(Local11)->(dbSeek(Local13:= ;
(Local10)->(eval(Arg3[2])), .F.)))
dbSkip()
EndDo
EndIf
Do While (!EOF() .AND. (ISNIL(Arg5) .OR. eval(Arg5)))
If (ISBLOCK(Arg11))
eval(Arg11)
EndIf
If (ISNIL(Arg4) .OR. eval(Arg4))
Local18:= .F.
If ((Local21:= "", aeval(Local14, { |_1| Local21:= Local21 ;
+ tostring(eval(_1)) }), !Local15 .OR. ;
!(Local12)->(dbSeek(Local21, .F.))))
(Local12)->(dbAppend())
Local18:= .T.
EndIf
Local20:= 0
For Local9:= 1 To Local1
If (Arg1[Local9][6])
Local20++
EndIf
If (!Local15 .OR. Local18 .OR. Arg1[Local9][5] $ "TA")
Local2:= eval(Arg1[Local9][1])
If (Arg1[Local9][5] == "T")
(Local12)->(fieldput(Local9, fieldget(Local9) + ;
Local2))
ElseIf (Arg1[Local9][5] == "A" .AND. !Local18)
(Local12)->(fieldput(Local9, (fieldget(Local9) + ;
Local2) / 2))
Else
(Local12)->(fieldput(Local9, Local2))
EndIf
If (Arg1[Local9][6] .AND. Local19)
Arg10[Local20]:= Arg10[Local20] + Local2
EndIf
EndIf
Next
EndIf
//If (((Local11)->(dbSkip()), !Local7 .OR. (Local11)->(EOF() .OR. !(Local13 == eval(Arg3[3])))))
dbSkip()
If (Local7)
Do While (!EOF() .AND. !(Local11)->(dbSeek(Local13:= ;
(Local10)->(eval(Arg3[2])), .F.)))
dbSkip()
EndDo
EndIf
//EndIf
EndDo
Select (Local12)
Goto Top
Return
Static Function TOSTRING(Arg1)
Local Local1
Local1:= ValType(Arg1)
If (Local1 == "N")
Arg1:= Str(Arg1)
ElseIf (Local1 == "D")
Arg1:= DToS(Arg1)
ElseIf (Local1 == "L")
Arg1:= IIf(Arg1, "1", "0")
EndIf
Return Arg1
Codigo do arquivo .CH:
/***
* Selector.ch
*
*/
#xcommand @ <array> SELECT [<clauses,...>] ;
=> <array> := {} ;
; @ <array> SELECT , [ <clauses> ]
#xcommand @ <array> SELECT ;
[FROM <from>] ;
[OTM <otm> SEEK <seek> EQUAL <equal>] ;
[FOR <for>] ;
[WHILE <while>] ;
[<rest:REST>] ;
[TO <(file)>] ;
[ALIAS <alias>] ;
[<add:ADDITIVE> [IF <condition>]] ;
[SUMMARY <summary>] ;
[EVAL <block>] ;
=> Selector(<array>, <(from)>, [ { <(otm)>, <{seek}>, <{equal}> } ], ;
<{for}>, <{while}>, <.rest.>, ;
<(file)>, <(alias)>, <.add.> [.and. <condition>], <summary>, ;
<{block}>)
// @ SELECT <field> ...
#xcommand @ <array> SELECT , <field> [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'X', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> ...
#xcommand @ <array> SELECT , <expr> AS <name> [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'X', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'X', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> GROUP ...
#xcommand @ <array> SELECT , <field> GROUP [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'G', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> GROUP ...
#xcommand @ <array> SELECT , <expr> AS <name> GROUP [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'G', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> GROUP ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> GROUP [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'G', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> TOTAL ...
#xcommand @ <array> SELECT , <field> TOTAL [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'T', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> AVERAGE ...
#xcommand @ <array> SELECT , <field> AVERAGE [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'A', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> TOTAL ...
#xcommand @ <array> SELECT , <expr> AS <name> TOTAL [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'T', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> AVERAGE ...
#xcommand @ <array> SELECT , <expr> AS <name> AVERAGE [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'A', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> TOTAL ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> TOTAL [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'T', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> AVERAGE ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> AVERAGE [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'A', .F. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> SUMMARY ...
#xcommand @ <array> SELECT , <field> SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'X', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'X', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'X', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> TOTAL SUMMARY ...
#xcommand @ <array> SELECT , <field> TOTAL SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'T', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <field> AVERAGE SUMMARY ...
#xcommand @ <array> SELECT , <field> AVERAGE SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{field}>, <"field">, , , 'A', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> TOTAL SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> TOTAL SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'T', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> AVERAGE SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> AVERAGE SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, , , 'A', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> TOTAL SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> TOTAL SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'T', .T. }) ;
; @ <array> SELECT [ <clauses> ]
// @ SELECT <expr> AS <name> LENGHT <lenght> DEC <dec> AVERAGE SUMMARY ...
#xcommand @ <array> SELECT , <expr> AS <name> LENGHT <lenght> DEC <dec> AVERAGE SUMMARY [<clauses,...>] ;
=> aAdd(<array>, { <{expr}>, <"name">, <lenght>, <dec>, 'A', .T. }) ;
; @ <array> SELECT [ <clauses> ]
#xcommand @ SELECT [<clauses,...>] ;
=> @ SelectList SELECT [ <clauses> ]
#xcommand REDEFINE SELECTOR [ <oSelec> VAR ] <nVar> ;
[ ID <nId> ] ;
[ ORIGIN ANGLE <nAngle1> ] ;
[ LAST ANGLE <nAngle2> ] ;
[ RANGE <nMin>, <nMax> ] ;
[ MARKS <nMarks> ] ;
[ <lExact: EXACT > ] ;
[ <dlg: OF,WINDOW,DIALOG > <oWnd> ] ;
[ ON CHANGE <uChange> ] ;
[ ON THUMBPOS <uPos> ] ;
[ <color: COLOR,COLORS > <nClrFore> [,<nClrBack> [,<nClrBtn> ] ] ] ;
[ MESSAGE <cMsg> ] ;
[ <update: UPDATE > ] ;
=> ;
[ <oSelec> := ] TSelector():Redefine( <nId>, bSETGET(<nVar>), ;
[<nAngle1>], [<nAngle2>], ;
<nMin>, <nMax>, <nMarks>, <.lExact.>, ;
[<oWnd>], [\{|nVar|<uChange>\}], [\{|nVar|<uPos>\}], ;
<cMsg>, <nClrFore>, <nClrBack>, <nClrBtn>, <.update.> )
#xcommand @ <nRow>, <nCol> SELECTOR [ <oSelec> VAR ] <nVar> ;
[ ORIGIN ANGLE <nAngle1> ] ;
[ LAST ANGLE <nAngle2> ] ;
[ RANGE <nMin>, <nMax> ] ;
[ MARKS <nMarks> ] ;
[ <lExact: EXACT > ] ;
[ SIZE <nWidth>, <nHeight> ] ;
[ <lPixel: PIXEL > ] ;
[ <dlg: OF,WINDOW,DIALOG > <oWnd> ] ;
[ ON CHANGE <uChange> ] ;
[ ON THUMBPOS <uPos> ] ;
[ <color: COLOR,COLORS > <nClrFore> [,<nClrBack> [,<nClrBtn> ] ] ] ;
[ MESSAGE <cMsg> ] ;
[ <design: DESIGN > ] ;
[ <update: UPDATE > ] ;
=> ;
[ <oSelec> := ] TSelector():New( <nRow>, <nCol>, bSETGET(<nVar>), ;
[<nAngle1>], [<nAngle2>], ;
<nMin>, <nMax>, <nMarks>, <.lExact.>, ;
[<oWnd>], [\{|nVar|<uChange>\}], [\{|nVar|<uPos>\}], ;
<nWidth>, <nHeight>, <.lPixel.>, <cMsg>, ;
<nClrFore>, <nClrBack>, <nClrBtn>, <.design.>, <.update.> )
@braços :?)
