Somente para constar e ficar mais fácil de encontrar quando procurarmos....
Código: Selecionar todos
/*****
*
* mtabedit.PRG
*
* Copyright (c) 1991 Computer Associates Int'l Corporation.
* All Rights Reserved.
*
* Clipper tbr25 /N /W
* RTLINK FILE tbr25
*
*/
#include "inkey.ch"
#include "setcurs.ch"
#include "achoice.ch"
#define CSEP chr(32)
#define MYCOLORS "W+/BG,W+/B"
#xcommand STABILIZE <obj> INKEY [TO] <x> =>;
DISPBEGIN();;
WHILE (!<obj>:stabilize()) .AND.;
((<x> := INKEY()) == 0);;
END;;
DISPEND()
// #define MAXLEN 100
FUNCTION mtabedit(up,left,down,right,aArray, aColumns, blFunc, blMove)
LOCAL b, nKey, column
LOCAL cScreen, k
local nSubscript
local i
local nCurs:=setcursor()
private maxlen:=len(aArray)
// Init
k := 0
nSubscript := 1
if len(aArray)==0
return -1
end if
cScreen := savescreen()
SETCURSOR(SC_NONE)
// TBrowse object for values
b := TBrowseNew( up,left,down,right )
//
// nSubscript is passed by reference
b:skipBlock := {|x| JumpIt(x, at (no spam) nSubscript)}
b:goTopBlock := {|| nSubscript := 1}
b:goBottomBlock := {|| nSubscript := MAXLEN}
b:colSep := CSEP
for i:=1 to len(aColumns)
do case
case aColumns[i]==1
column := TBColumnNew("", { || aArray[nSubscript,1] })
case aColumns[i]==2
column := TBColumnNew("", { || aArray[nSubscript,2] })
case aColumns[i]==3
column := TBColumnNew("", { || aArray[nSubscript,3] })
case aColumns[i]==4
column := TBColumnNew("", { || aArray[nSubscript,4] })
case aColumns[i]==5
column := TBColumnNew("", { || aArray[nSubscript,5] })
case aColumns[i]==6
column := TBColumnNew("", { || aArray[nSubscript,6] })
case aColumns[i]==7
column := TBColumnNew("", { || aArray[nSubscript,7] })
case aColumns[i]==8
column := TBColumnNew("", { || aArray[nSubscript,8] })
case aColumns[i]==9
column := TBColumnNew("", { || aArray[nSubscript,9] })
case aColumns[i]==10
column := TBColumnNew("", { || aArray[nSubscript,10] })
case aColumns[i]==11
column := TBColumnNew("", { || aArray[nSubscript,11] })
case aColumns[i]==12
column := TBColumnNew("", { || aArray[nSubscript,12] })
end case
b:addColumn( column )
next i
WHILE .T.
STABILIZE b INKEY TO nKey
IF (b:stable)
nKey := INKEYnull()
ENDIF
IF !TbMoveCursor( nKey, b )
do case
case nKey == K_ESC
nSubscript:=0
EXIT
case nKey == K_ENTER
DoGet(b)
otherwise
WHILE !b:stabilize()
END
if blFunc<>NIL
i:=&(blFunc+"("+str(nKey)+","+str(nSubscript)+")")
if i==AC_ABORT
exit
end if
if i==AC_REDRAW
maxlen:=len(aArray)
b:refreshAll()
b:Stabilize()
end if
if i==AC_SELECT
exit
end if
end if
end case
else
if !empty(blMove)
WHILE !b:stabilize()
END
i:=&(blMove+"("+str(nKey)+","+str(nSubscript)+")")
end if
ENDIF
END
SETCURSOR(SC_NONE)
SCROLL()
setcursor(nCurs)
RestoreScreen(,,,,cScreen)
RETURN nSubscript
/*****
*
* Main Skipper
*
*/
STATIC FUNCTION JumpIt(nRequest, nSubscript)
LOCAL k := 0
// Show current
IF nRequest == 0
k := 0 // When browsing databases was a matter
// of SKIP 0. Return 0 and your array
// element will be painted on screen
ELSEIF nRequest > 0
// Skip forward
// When browsing databases was a matter of SKIP. Now
// you should return the proper array subscript
//
// (MAXLEN - nSubscript) is the amount of elements until
// the end of the array
//
IF nRequest < (MAXLEN - nSubscript)
k := nRequest
ELSE
k := MAXLEN - nSubscript
ENDIF
ELSEIF nRequest < 0
// Skip backwards
IF nRequest < (1 - nSubscript)
// Skip several elements
k := 1 - nSubscript
ELSE
k := nRequest
ENDIF
ENDIF
// Position in the proper element
nSubscript += k
RETURN (k)
/*****
*
* Cursor Movement Methods
*
*/
STATIC FUNCTION TBMoveCursor( nKey, oObj )
LOCAL nFound
STATIC aKeys := ;
{ K_DOWN , {|b| b:down()},;
K_UP , {|b| b:up()},;
K_PGDN , {|b| b:pageDown()},;
K_PGUP , {|b| b:pageUp()},;
K_RIGHT,{| obj | obj:right()},;
K_LEFT,{| obj | obj:left()},;
K_CTRL_PGUP , {|b| b:goTop()},;
K_CTRL_PGDN , {|b| b:goBottom()},;
K_HOME , {|b| b:home()},;
K_END , {|b| b:end()},;
K_CTRL_HOME , {|b| b:panHome()},;
K_CTRL_END , {|b| b:panEnd()} }
nFound := ASCAN( aKeys, nKey )
IF (nFound != 0)
EVAL( aKeys[++nFound], oObj )
ENDIF
RETURN (nFound != 0)
*+��������������������������������������������������������������������
*+
*+ Static Function DoGet()
*+
*+��������������������������������������������������������������������
*+
static function DoGet(obj)
local nCursSave
local column
local get
local nKey
if obj:colPos == 1
return .f.
end if
// Cursors are for GETs, so:
nCursSave := setcursor(SC_NORMAL)
// make sure browse is stable
while (!obj:stabilize())
end
column := obj:getColumn(obj:colPos)
altd()
// create a corresponding GET and READ it
get := GetNew(row(),col(),column:block,;
column:heading,,"W+/BG,W+/B")
// at (no spam) row(),col() get wert
// Get old key value or NIL
readmodal({get})
setcursor(nCursSave)
obj:refreshCurrent()
ForceStable(obj)
// check exit key
nKey := lastkey()
if (nKey == K_UP .or. nKey == K_DOWN .or. ;
nKey == K_PGUP .or. nKey == K_PGDN)
keyboard chr(nKey)
endif
return (.T.)