СевДон пишет:
| цитата: |
| Сделать свой Browse либо создать TBrowse-объект с блоками для навигации: |
|
Я это и имел в виду, только надо еще определить skipblock
Вот мои процедуры, попробуйте их собрать с 5.01
Параметры:
bIndExp: индексое выражение, либо блок кода, который его вычисляет, либо массив {xTop, xBottom}
bFilter - дополнительный фильтр (необязательно)
nOrder - номер индекса (необязательно)
Пример использования:
oB:GoTopBlock := {|| mGoTop(cName)}
oB:GoBottomBlock := {|| mGoBottom(cName)}
oB:SkipBlock := {|n, x| imSkipper(n, cName)}
#translate ISARRAY( <v1> ) => ( valtype( <v1> ) == "A" )
#translate ISBLOCK( <v1> ) => ( valtype( <v1> ) == "B" )
#translate ISCHARACTER( <v1> ) => ( valtype( <v1> ) == "C" )
#translate ISDATE( <v1> ) => ( valtype( <v1> ) == "D" )
#translate ISLOGICAL( <v1> ) => ( valtype( <v1> ) == "L" )
#translate ISMEMO( <v1> ) => ( valtype( <v1> ) == "M" )
#translate ISNUMBER( <v1> ) => ( valtype( <v1> ) == "N" )
oB:GoTopBlock := {|| mGoTop(bIndExp, bFilter, nOrder)}
oB:GoBottomBlock := {|| mGoBottom(bIndExp, bFilter, nOrder)}
oB:SkipBlock := {|n, x| imSkipper(n, bIndExp, bFilter, nOrder)}
Function mGoTop(bIndExp, bFilter, nOrder)
// -------------------------------------------------------------
// Перемещение на первую запись по фильтру
// -------------------------------------------------------------
Local uIndExp, xIndExp, Released := .f., nOrdSave, lC
if bIndExp == nil
dbGoTop()
else
if nOrder # nil
nOrdSave = IndexOrd()
dbSetOrder(nOrder)
endif
uIndExp = if(IsBlock(bIndExp), EVAL(bIndExp), bIndExp)
if ! IsArray(uIndExp)
xIndExp = uIndExp
if xIndExp # nil
dbSeek(xIndExp)
else
dbGoTop()
endif
else
xIndExp = uIndExp[2]
dbSeek(uIndExp[1], .t.)
lC = .f.
endif
endif
while ! Eof() .and. CheckIndex(xIndExp, lC)
IF bFilter == nil .or. EVAL(bFilter)
Released = .t.
EXIT
ENDIF
dbSkip()
enddo
if ! Released
dbGoto(0)
endif
if nOrdSave # nil
dbSetOrder(nOrdSave)
endif
Return nil
Function mGoBottom(bIndExp, bFilter, nOrder)
// -------------------------------------------------------------
// Перемещение на последнюю запись по фильтру
// -------------------------------------------------------------
Local uIndExp, xIndExp, Released := .f., nOrdSave, lC
if bIndExp == nil
dbGoBottom()
else
if nOrder # nil
nOrdSave = IndexOrd()
dbSetOrder(nOrder)
endif
uIndExp = if(IsBlock(bIndExp), EVAL(bIndExp), bIndExp)
if ! IsArray(uIndExp)
xIndExp = uIndExp
if xIndExp # nil
dbSeekLast(xIndExp)
else
dbGoBottom()
endif
else
xIndExp = uIndExp[1]
dbSeekLast(uIndExp[2], .t.)
lC = .t.
endif
endif
while ! Bof() .and. ! Eof() .and. CheckIndex(xIndExp, lC)
IF bFilter == nil .or. EVAL(bFilter)
Released = .t.
EXIT
ENDIF
dbSkip(-1)
enddo
if ! Released
dbGoto(0)
endif
if nOrdSave # nil
dbSetOrder(nOrdSave)
endif
Return nil
Function mSkipper(n, bIndExp, bFilter, nOrder)
// -------------------------------------------------------------
// Перемещения по файлу на количество записей n
// -------------------------------------------------------------
Local uIndExp, nRet := 0, nRec := RecNo(), xIndExp1, xIndExp2, nOrdSave
Local lC
if bIndExp # nil
if nOrder # nil
nOrdSave = IndexOrd()
dbSetOrder(nOrder)
endif
uIndExp := if(IsBlock(bIndExp), EVAL(bIndExp), bIndExp)
if ! IsArray(uIndExp)
xIndExp1 := xIndExp2 := uIndExp
else
xIndExp1 = uIndExp[1]
xIndExp2 = uIndExp[2]
lC := (n < 0)
endif
endif
if n < 0
while nRet > n
if Eof() .and. LastRec() > 0
mGoBottom(uIndExp, bFilter,,)
else
dbSkip(-1)
endif
if Eof() .or. Bof() .or. ! CheckIndex(xIndExp1, lC)
dbGoto(nRec)
if bFilter # nil
Eval(bFilter)
endif
Exit
endif
if bFilter == nil .or. Eval(bFilter)
nRec = RecNo()
nRet --
endif
enddo
elseif n > 0
while nRet < n
dbSkip()
if Eof() .or. ! CheckIndex(xIndExp2, lC)
dbGoto(nRec)
if bFilter # nil
Eval(bFilter)
endif
Exit
endif
if bFilter == nil .or. Eval(bFilter)
nRec = RecNo()
nRet ++
endif
enddo
elseif bFilter # nil
Eval(bFilter)
endif
if nOrdSave # nil
dbSetOrder(nOrdSave)
endif
Return nRet
Function CheckIndex(xIndExp, lC)
// -------------------------------------------------------------
// Проверка фильтра по индексному выражению
// -------------------------------------------------------------
Local l, xKey
if xIndExp == nil
l = .t.
else
xKey := &(IndexKey())
if lC == nil
if IsDate(xKey) .and. IsCharacter(xIndExp)
l := (DTOS(xKey) = xIndExp)
else
l := (xKey = xIndExp)
endif
else
l := if(lC, (xKey >= xIndExp), (xKey <= xIndExp))
endif
endif
Return l
Function dbSeekLast(xExpr, lC, nOrd)
// -------------------------------------------------------------
// Находит последнюю запись по ключевому выражению xExpr
// Возвращает:
// Логическое значение (найдена или нет).
// -------------------------------------------------------------
Local xSeek, x, cc, nc, nOldOrd
Local cIndex := IndexKey()
if nOrd # nil .and. (nOldOrd:=IndexOrd()) # nOrd
dbSetOrder(nOrd)
endif
if ValType(xExpr) == 'C'
if len(xExpr) == 0
dbGoBottom()
Return ! Eof()
endif
xSeek := incStr(xExpr)
else //IF ValType(xExpr) == 'N'
xSeek := xExpr + 1
endif
dbSeek(xSeek, .t.)
dbSkip(-1)
x := &cIndex
if lC == nil
if ! (if(ValType(x) == 'D' .and. ValType(xExpr) == 'C', DTOS(x), x) = xExpr)
dbGoto(0)
endif
else
if x > xExpr
dbGoto(0)
endif
endif
if nOrd # nil .and. nOrd # nOldOrd
dbSetOrder(nOldOrd)
endif
Return ! Eof()
Function IncStr(cStr)
Local ser, c
for ser := len(cStr) to 1 step -1
c := Chr(Asc(Substr(cStr, ser, 1)) + 1)
cStr := Stuff(cStr, ser, 1, c)
if c # Chr(0)
exit
endif
next
Return cStr
. 
, на клиппере подобные проблемы когда-то решал через Sx_WildSeek() - SIXRDD , на харбуре - через SQL запросы. 
- участник сейчас на форуме
- участник вне форума