Encontrei isto entre minhas bibliotecas que tem relação ao que necessita, mas não encontrei a .LIB ou exemplo para maior suporte. A .LIB é a RBCKalgumacoisa talvez existente no velho site OASIS(
Código: Selecionar todos
#include "NFERROR.CH"
/* get:exitState values */
//#define GE_NOEXIT 0 // no exit attempted (blank)
#define GE_UP 1
#define GE_DOWN 2
#define GE_TOP 3
#define GE_BOTTOM 4
//#define GE_ENTER 5
#define GE_WRITE 6
#define GE_ESCAPE 7
#define GE_WHEN 8 // when clause unsatisfied
#define _GETEXIT_CH
#command @ <row>, <col> [SAY <cTitle>] ;
GET <nVar> ;
[COLOR <cColor>] ;
[VALID <lValid>] ;
[WHEN <lWhen>] ;
[SEND <msg>] ;
VIA RADIOBUTTONS <aButtons> ;
[<horiz: HORIZONTAL>] ;
[<nobox: NOBOX>] ;
[<double: DOUBLE>] ;
[<shadow: SHADOW>] ;
[HSPACING <nHSpacing>] ;
[YESMARKER <cYesTick>] ;
[NOMARKER <cNoTick>] ;
;
=> setpos( <row>, <col> ) ;
; aadd( GetList, _GET_(<nVar>,<(nVar)>,"9",<{lValid}>,<{lWhen}> ) ) ;
[; atail(GetList):colorSpec := <cColor> ] ;
[; atail(GetList):<msg>] ;
; RBCB_New( atail(getlist), <{lWhen}>, ;
<row>, <col>, <cTitle>, <nVar>, ;
<aButtons>, <.nobox.>, <.double.>, <.horiz.>, ;
<.shadow.>, <nHSpacing>, <cYesTick>, <cNoTick> ) ;
; atail(getlist):reader := { |get| RBCB_Reader( get, <.nobox.>, ;
<.horiz.>, <cTitle>, ;
<cYesTick>, <cNoTick> ) }
// Alternate syntax
#command @ [<clauses,...>] WITH RADIOBUTTONS [<moreClauses,...>] ;
=> @ [<clauses>] VIA RADIOBUTTONS [<moreClauses>]
#command @ [<clauses,...>] VIA CHECKBOX [<moreClauses,...>] ;
=> @ [<clauses>] VIA RADIOBUTTONS [<moreClauses>]
#command @ [<clauses,...>] WITH CHECKBOX [<moreClauses,...>] ;
=> @ [<clauses>] VIA RADIOBUTTONS [<moreClauses>]
#include "box.ch" // as shipped with Clipper 5.2d
#include "inkey.ch" // '' '' '' ''
#include "common.ch" // '' '' '' ''
#define RB_LEFT "(" // radiobutton left bracket
#define RB_RIGHT ")" // radiobutton right bracket
#define RB_YES chr(7) // the dot in the middle of the radiobutton brackets
#define RB_NO " " // unselected option
#define CB_LEFT "[" // checkbox left bracket
#define CB_RIGHT "]" // checkbox right bracket
#define CB_YES "û" // the check in the middle of the radiobutton brackets
#define CB_NO " " // unselected option
#define HBRACKETSPACING 4 // space (ie.,"( ) ") between 1st bracket & text of horizontal choices
#ifndef K_SPACE // this was finally defined in Clipper 5.2
#define K_SPACE 32
#endif
static aAllButtons := {} // for all the get radio buttons and check boxes
/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Initialization for Radio Buttons and Check Boxes. Display title and
³ choices. Optionally draw box around choices. Horizontal choices must
³ fit on one line.
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
function RBCB_New( oGet, bWhen, ;
nRow, nCol, cTitle, nChoice, ;
aChoices, lNoBox, lDblBox, ;
lHoriz, lShadow, nHSpacing, cYesMarker, cNoMarker )
local cColorSpec // color string
local n // temp variable
local nWidth // width of button box
dispbegin() // buffer the display output
if cTitle == NIL
cTitle := "" // init to enable testing in len()
endif
if valtype( nHSpacing ) != "N" // set default horizontal spacing
nHSpacing := 2
endif
if (nChoice < 1) .or. (nChoice > len( aChoices )) // make sure nChoice is in valid range
if len( aChoices ) > 1
nChoice := 1 //--- Only if a radio button not a check box
endif
endif
// Add choices array to the aAllButtons array.
aadd( aAllButtons, { oGet:Name, aChoices, nHSpacing, oGet:subscript } )
// ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
// ³ Draw box around buttons ³
// ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
if ! lNoBox // draw box around buttons
if lHoriz // draw horizontal box
// find total width of aChoices choices
nWidth := 0
aeval( aChoices, { |c, n| nWidth += if( n == 1, 1, nHSpacing ) ;
+ HBRACKETSPACING ;
+ len( c ) } )
nWidth := max( nWidth + 1, len( cTitle ) + 2 ) // make sure title fits
// draw single or double line box
dispbox( nRow, nCol, nRow+2, nCol+nWidth+1, ;
if( lDblBox, B_DOUBLE, B_SINGLE )+space(1), oGet:ColorSpec )
if lShadow // draw shadow around box
DrawBoxShadow( nRow, nCol, nRow+2, nCol+nWidth+1 )
endif
else // draw vertical box
// find max width of aChoices choices
nWidth := len( aChoices[1] )
aeval( aChoices, { |c| nWidth := max(nWidth, len(c)) } )
nWidth := max( nWidth+5, len(cTitle)+1 ) // add 5 spaces for " ( ) "
// draw single or double line box
dispbox( nRow, nCol, nRow+len(aChoices)+1, nCol+nWidth+2, ;
if( lDblBox, B_DOUBLE, B_SINGLE )+space(1), oGet:ColorSpec )
if lShadow // draw shadow around box
DrawBoxShadow( nRow, nCol, nRow+len(aChoices)+1, nCol+nWidth+2 )
endif
endif
endif
// ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
// ³ Put title at top left corner ³
// ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
if !empty( cTitle )
if lNoBox // no box around buttons
@ nRow, nCol say cTitle color oGet:ColorSpec
else // box drawn around buttons
@ nRow, nCol+1 say " "+cTitle+" " color oGet:ColorSpec
endif
endif
// ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
// ³ Display radio button choices ³
// ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
// check when condition for this get; use this to set colors
if ( bWhen == NIL ) .or. eval( bWhen, oGet )
// normal color
cColorSpec := oGet:ColorSpec
else
// failed pre-validation (ie., WHEN)
// grey out the radio button box choices
cColorSpec := if( (n:=at(",",oGet:ColorSpec)) > 0, ; // find comma delimiter
substr(oGet:ColorSpec,n+1), ; // remainder of color string
oGet:ColorSpec ) // same color as regular
// Uncomment the next lines to change data value if WHEN condition fails
//-x- nChoice := 0 // don't show any choices for greyed out radio buttons
//-x- // return zero for disabled button
//-x- oGet:VarPut( nChoice ) // update get var
endif
// draw the buttons
/*
³ Note: 1 is subtracted from nCol when horizontal and no box or
³ title. This was needed to line up the buttons with the oGet
³ supplied coordinates when DrawRadioButtons() is called from
³ RBCB_Reader().
*/
DrawRadioButtons( nRow, ;
nCol - if( lHoriz .and. lNoBox .and. empty( cTitle ), ;
1, 0 ;
), ;
aChoices, nChoice, nChoice, cColorSpec, ;
lNoBox, lHoriz, empty( cTitle ), nHSpacing, cYesMarker, cNoMarker ;
)
dispend()
return nil
/*
* ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
* Draw Radio Buttons choices
* ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
// code blocks to display the buttons
#xtranslate bHORIZONTALCONTROL ;
=> { | c, n | dispout( replicate( " ", if( n == 1, if( lNoBox, 0, 1 ), nHSpacing ) ) + ; // space before bracket
cLeftBracket + ; // left bracket
( if( n == nCursor, nCursorPos := col() + ; // set position of selected button
if( n == 1, ;
0, ;
nHSpacing-if( lNoBox, 0, 1 ) ), ), ;
if( n == nChoice, cYesMarker, cNoMarker ) ; // bw the brackets
) + ;
cRightBracket + " " + c, ; // right bracket + text
cColorSpec ;
) ;
}
#xtranslate bVERTICALCONTROL ;
=> { | c, n | setpos( row() + 1, if( lNoBox, nCol, nCol + 2 ) ), ;
dispout( cLeftBracket + ( if( n == nCursor, nCursorPos := row(), ), ;
if( n == nChoice, cYesMarker, cNoMarker );
) + ;
cRightBracket + " " + c, ;
cColorSpec ;
) ;
}
static function DrawRadioButtons( nRow, nCol, aChoices, nChoice, nCursor, ;
cColorSpec, lNoBox, lHoriz, lNoTitle, ;
nHSpacing, cYesMarker, cNoMarker)
local cLeftBracket
local cRightBracket
local nCursorPos := 0 // cursor position (could be either row or col)
if len( aChoices ) == 1 // checkbox
DEFAULT cLeftBracket TO CB_LEFT
DEFAULT cRightBracket TO CB_RIGHT
DEFAULT cYesMarker TO CB_YES
DEFAULT cNoMarker TO CB_NO
else // radiobutton
DEFAULT cLeftBracket TO RB_LEFT
DEFAULT cRightBracket TO RB_RIGHT
DEFAULT cYesMarker TO RB_YES
DEFAULT cNoMarker TO RB_NO
endif
dispbegin()
set cursor off
if lHoriz // horizontal radio buttons
if lNoBox
setpos( nRow + if(lNoTitle,0,1), nCol )
aeval( aChoices, bHORIZONTALCONTROL ) // show buttons
setpos( nRow + if(lNoTitle,0,1), nCursorPos+1 ) // display cursor at this coordinate
else // with a box around buttons
setpos( nRow+1, nCol+1 )
aeval( aChoices, bHORIZONTALCONTROL ) // show buttons
setpos( nRow+1, nCursorPos+2 ) // display cursor at this coordinate
endif
else // vertical radio buttons
if lNoBox
setpos( nRow-if(lNoTitle,1,0), nCol )
aeval( aChoices, bVERTICALCONTROL ) // show buttons
setpos( nCursorPos, nCol+1 ) // display cursor at this coordinate
else
setpos( nRow, nCol )
aeval( aChoices, bVERTICALCONTROL ) // show buttons
setpos( nCursorPos, nCol+3 ) // display cursor at this coordinate
endif
endif
set cursor on
dispend()
return nil
/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Radio and Check Buttons GET Reader.
³ Supports WHEN and VALID.
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
function RBCB_Reader( oGet, lNoBox, lHoriz, cTitle, cYesMarker, cNoMarker )
local aChoices // radio button choices
local cGreyColor // greyed out color if WHEN condition failed
local cSavedScreen // to save portion of screen normally showing GET value
local n // temp variable
local nChoice // button choices (1st one is name of get variable)
local nCursor // button cursor (may be different than nChoice)
local nFoundChoice // array position of this gadget in all gadgets
local nHSpacing // how many spaces to leave between horizontal choices
local nKey // key pressed
local nMaxChoices // max number of choices
local nOldChoice // to save current choice
local nOldCursor // to save current cursor position
local bHotKey // code block for a set key that is pressed
// initialize variables
// 1st element of aAllButtons == GET var name
// 4th '' '' '' == array subscript if GET var was an array
nFoundChoice := ascan( aAllButtons, { |a| a[1] == oGet:Name .and.; // compare against name
if( a[4] == NIL, ; // compare against possible array subscript
.t., ; // no array used if NIL
a[4] == oGet:subscript ) } )
aChoices := aAllButtons[ nFoundChoice, 2 ]
nHSpacing := aAllButtons[ nFoundChoice, 3 ]
// read the GET if the WHEN condition is satisfied
if ( GetPreValidate( oGet ) ) // note: see our own version of this udf below
// initialize variables
n := 0
nKey := 0
nMaxChoices := len( aChoices )
if nMaxChoices > 1 // Only if a radio button
// make a copy of the get var value
nChoice := if( oGet:VarGet() != 0, oGet:VarGet(), 1 )
if LastKey() == K_UP
nCursor := nMaxChoices // On an UP that changes GET objects
else
nCursor := nChoice // cursor position
endif // move to last button of the new get
else
nChoice := oGet:VarGet() // Retain prior value
nCursor := 1 // cursor position
endif
// activate the GET for reading
dispbegin()
// save the 1 character spot where the GET value is about to be displayed
cSavedScreen := savescreen( oGet:row, oGet:col, oGet:row, oGet:col )
oGet:SetFocus()
// restore the 1 character spot where the GET displayed its value
restscreen( oGet:row, oGet:col, oGet:row, oGet:col, cSavedScreen )
// redraw buttons: sets cursor under choice
DrawRadioButtons( oGet:Row, oGet:Col, aChoices, nChoice, nCursor, ;
oGet:ColorSpec, lNoBox, lHoriz, empty(cTitle), ;
nHSpacing, cYesMarker, cNoMarker )
dispend()
do while ( oGet:ExitState == GE_NOEXIT )
nOldChoice := nChoice // save "old" choice before movement
nOldCursor := nCursor // save "old" cursor choice before movement
nKey := inkey(0) // wait for a key to be pressed
// see if a hot key was pressed
if ( bHotKey := setkey( nKey ) ) != nil
eval( bHotKey, procname(1), procline(1), readvar() )
loop // get next key
endif
// determine what key was pressed
do case
case nKey == K_ESC // cancel selection
oGet:ExitState := GE_ESCAPE
case nKey == K_SPACE // move to cursor or the next radio button choice
if ! nCursor == nChoice
// move choice to cursor position
nChoice := nCursor
else
if nMaxChoices == 1 // It's a tick box
nChoice := 0 // Toggle the only choice
else // Only if a radio button
// move choice to next button
nCursor := nChoice := if( nChoice == nMaxChoices, 1, nChoice+1 )
endif
endif
case nKey == K_ENTER // get to the next get
oGet:ExitState := GE_ENTER
case nKey == K_UP // up arrow
if lHoriz // horizontal box: exit to previous get
oGet:exitstate := GE_UP
else // vertical box: move cursor up
if nCursor == 1
oGET:exitstate := GE_UP // move to previous get
else
nCursor--
endif
endif
case nKey == K_DOWN // down arrow
if lHoriz // horizontal box: exit to next get
oGET:exitstate := GE_DOWN
else // vertical box: move cursor down
if nCursor == nMaxChoices
oGET:exitstate := GE_DOWN // move to next get
else
nCursor++
endif
endif
case nKey == K_LEFT // left arrow
if lHoriz // horizontal box: move cursor to previous choice
if nCursor == 1
nCursor := nMaxChoices
// to move to the previous get,
// comment the line above and uncomment the next line
// oGET:exitstate := GE_UP // move to previous get
else
nCursor--
endif
else // vertical box
// uncomment this line if you want the cursor to move to previous get
// oGet:exitstate := GE_UP
endif
case nKey == K_RIGHT // right arrow
if lHoriz // horizontal box: move cursor to next choice
if nCursor == nMaxChoices
nCursor := 1
// to move to the next get,
// comment the line above and uncomment the next line
// oGET:exitstate := GE_DOWN // move to next get
else
nCursor++
endif
else // vertical box
// uncomment this line if you want the cursor to move to next get
// oGET:exitstate := GE_DOWN
endif
case nKey == K_TAB // tab: exit to next get
oGET:exitstate := GE_DOWN
case nKey == K_SH_TAB // shift-tab: exit to previous get
oGet:exitstate := GE_UP
case nKey == K_PGUP // page up
oGET:ExitState := GE_WRITE
case nKey == K_PGDN // page down
oGet:ExitState := GE_WRITE
otherwise
if Len(aChoices) > 1
// handle if user pressed a key to select the first letter
// 1st, continue search from current location
n := ascan( aChoices, ;
{ |c| upper( left(c,1) ) == upper ( chr(nKey) ) },;
nChoice+1, nMaxChoices )
if n == 0
// 2nd, if another not found, restart search from the top
n := ascan( aChoices, ;
{ |c| upper( left(c,1) ) == upper ( chr(nKey) ) },;
1, nChoice - 1 )
endif
nCursor := nChoice := if( n > 0, n, nChoice ) // move cursor if a match
elseif upper( left(aChoices[1],1) ) == upper ( chr(nKey) )
nChoice := if( nChoice == 0, 1, 0) // Toggle the tick box for check box
endif
endcase
// check if moved to new radio button selection
if ! nOldChoice == nChoice .or. ! nOldCursor == nCursor
DrawRadioButtons( oGet:Row, oGet:Col, aChoices, nChoice, nCursor, ;
oGet:ColorSpec, lNoBox, lHoriz, empty(cTitle), ;
nHSpacing, cYesMarker, cNoMarker)
endif
// disallow exit if the VALID condition is not satisfied
if ! GetPostValidate( oGet )
oGet:ExitState := GE_NOEXIT
end
enddo ( oGet:ExitState == GE_NOEXIT )
oGet:VarPut( nChoice ) // update get var
// de-activate the GET
dispbegin()
// save the 1 character spot where the GET value is about to be displayed
cSavedScreen := savescreen( oGet:row, oGet:col, oGet:row, oGet:col )
oGet:KillFocus()
// restore the 1 character spot where the GET displayed its value
restscreen( oGet:row, oGet:col, oGet:row, oGet:col, cSavedScreen )
dispend()
else
// failed pre-validation (ie., WHEN)
// grey out the radio button box choices
cGreyColor := if( (n:=at(",",oGet:ColorSpec)) > 0, ; // find comma dilimiter
substr(oGet:ColorSpec,n+1), ; // remainder of color string
oGet:ColorSpec ) // same color as regular
// Uncomment the next lines to change data value if WHEN condition fails
//-x- // return zero for disabled button
//-x- oGet:VarPut( 0 ) // update get var
oGet:VarPut( nChoice ) // update get var
DrawRadioButtons( oGet:Row, oGet:Col, aChoices, nChoice, nCursor, ;
cGreyColor, lNoBox, lHoriz, empty(cTitle), ;
nHSpacing, cYesMarker, cNoMarker)
endif
return nil
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// A copy from Nantucket's version with some modifications.
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
/*
³ GetPreValidate()
³ Test entry condition (WHEN clause) for a GET.
*/
static function GetPreValidate( get )
local when := .t.
if ( get:preBlock <> NIL )
when := Eval(get:preBlock, get)
end
if ( !when )
get:exitState := GE_WHEN // indicates failure
else
get:exitState := GE_NOEXIT // prepares for editing
end
return when
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
// A copy from Nantucket's version with some modifications.
//ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
/*
³ GetPostValidate()
³ Test exit condition (VALID clause) for a GET.
*/
static function GetPostValidate( get )
local valid := .t.
if ( get:exitState == GE_ESCAPE )
return (.t.) // NOTE
end
// check VALID condition if specified
if ( get:postBlock <> NIL )
valid := Eval(get:postBlock, get)
end
return (valid)
/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Draw Shadow to the right and under Box
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
static function DrawBoxShadow( nTop, nLeft, nBottom, nRight )
// save old color
local cOldColor := set( _SET_COLOR )
// build bottom shadow buffer array (account for screen height)
local BottomBuf := if( nBottom < maxrow(), ;
{ nBottom + 1, ;
nLeft + 1, ;
nBottom + 1, ;
if( nRight < maxcol(), ;
nRight + 1, ;
nRight ;
), ;
savescreen( nBottom + 1, ;
nLeft + 1, ;
nBottom+1, ;
if( nRight < maxcol(), ;
nRight + 1, ;
nRight ;
) ;
) ;
}, ;
nil ;
)
// build right shadow buffer array (account for screen width)
local RightBuf := if( nRight < maxcol(), ;
{ nTop + 1, ;
nRight + 1, ;
if( nBottom < maxrow(), ;
nBottom + 1, ;
nBottom ;
), ;
nRight + 1, ;
savescreen( nTop + 1, ;
nRight + 1, ;
if( nBottom < maxrow(), ;
nBottom + 1, nBottom ;
), ;
nRight + 1 ;
) ;
}, ;
nil ;
)
// code block to evaluate shadow buffer arrays
local ShdwStrip := { | buf | ( restscreen( buf[1], buf[2], buf[3], buf[4], ;
transform( buf[5], ;
replicate( "X" + chr(8), ;
len( buf[5] ) * 0.5 ;
) ;
) ;
) ;
) ;
}
// draw bottom shadow
if ! BottomBuf == NIL
eval( ShdwStrip, BottomBuf )
endif
// draw right shadow
if ! RightBuf == NIL
eval( ShdwStrip, RightBuf )
endif
// restore original color
set( _SET_COLOR, cOldColor )
return nil
/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Clear the radio button array. Do this after the READ to free up memory.
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
function RBCB_Kill()
aAllButtons := {}
return nil
Acho que ja dá pra quebrar a cabeça também, mas se usa o Clipper 5.3 talvez tenha mais sucesso analisando o funcionamento dos comandos extras desta versão que tem sua sintaxe dentro do arquivo STD.CH como abaixo:
Código: Selecionar todos
/***
* @..GET CHECKBOX
*/
#command @ <row>, <col> GET <var> ;
CHECKBOX ;
[VALID <valid>] ;
[WHEN <when>] ;
[CAPTION <caption>] ;
[MESSAGE <message>] ;
[COLOR <color>] ;
[FOCUS <fblock>] ;
[STATE <sblock>] ;
[STYLE <style>] ;
[SEND <msg>] ;
[GUISEND <guimsg>] ;
[BITMAPS <aBitmaps>] ;
;
=> SetPos( <row>, <col> ) ;
; AAdd( ;
GetList, ;
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ;
) ;
; ATail(GetList):Control := _CheckBox_( <var>, <caption>, ;
<message>, <color>, <{fblock}>, <{sblock}>, ;
<style>, <aBitmaps> ):Display() ;
; ATail(GetList):reader := { | a, b, c, d, e, f | ;
GuiReader( a, b, c, d, e, f ) } ;
[; ATail(GetList):<msg>] ;
[; ATail(GetList):Control:<guimsg>]
/***
* @..GET LISTBOX
*/
#command @ <top>, <left>, <bottom>, <right> GET <var> ;
LISTBOX <items> ;
[VALID <valid>] ;
[WHEN <when>] ;
[CAPTION <caption>] ;
[MESSAGE <message>] ;
[COLOR <color>] ;
[FOCUS <fblock>] ;
[STATE <sblock>] ;
[<drop: DROPDOWN>] ;
[<scroll: SCROLLBAR>] ;
[SEND <msg>] ;
[GUISEND <guimsg>] ;
[BITMAP <cBitmap>] ;
;
=> SetPos( <top>, <left> ) ;
; AAdd( ;
GetList, ;
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ;
) ;
; ATail(GetList):Control := _ListBox_( <top>, <left>, <bottom>, ;
<right>, <var>, <items>, <caption>, <message>, ;
<color>, <{fblock}>, <{sblock}>, <.drop.>, ;
<.scroll.>, <cBitmap> ):display() ;
; ATail(GetList):reader := { | a, b, c, d, e, f | ;
GuiReader( a, b, c, d, e, f ) } ;
[; ATail(GetList):<msg>] ;
[; ATail(GetList):Control:<guimsg>]
/***
* @..GET PUSHBUTTON
*/
#command @ <row>, <col> GET <var> ;
PUSHBUTTON ;
[VALID <valid>] ;
[WHEN <when>] ;
[CAPTION <caption>] ;
[MESSAGE <message>] ;
[COLOR <color>] ;
[FOCUS <fblock>] ;
[STATE <sblock>] ;
[STYLE <style>] ;
[SEND <msg>] ;
[GUISEND <guimsg>] ;
[SIZE X <sizex> Y <sizey>] ;
[CAPOFF X <capxoff> Y <capyoff>] ;
[BITMAP <bitmap>] ;
[BMPOFF X <bmpxoff> Y <bmpyoff>] ;
;
=> SetPos( <row>, <col> ) ;
; AAdd( ;
GetList, ;
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ;
) ;
; ATail(GetList):Control := _PushButt_( <caption>, <message>, ;
<color>, <{fblock}>, <{sblock}>, <style>, ;
<sizex>, <sizey>, <capxoff>, <capyoff>, ;
<bitmap>, <bmpxoff>, <bmpyoff> ):display() ;
; ATail(GetList):reader := { | a, b, c, d, e, f | ;
GuiReader( a, b, c, d, e, f ) } ;
[; ATail(GetList):<msg>] ;
[; ATail(GetList):Control:<guimsg>]
/***
* @..GET RADIOGROUP
*/
#command @ <top>, <left>, <bottom>, <right> GET <var> ;
RADIOGROUP <buttons> ;
[VALID <valid>] ;
[WHEN <when>] ;
[CAPTION <caption>] ;
[MESSAGE <message>] ;
[COLOR <color>] ;
[FOCUS <fblock>] ;
[STYLE <style>] ;
[SEND <msg>] ;
[GUISEND <guimsg>] ;
;
=> SetPos( <top>, <left> ) ;
; AAdd( ;
GetList, ;
_GET_( <var>, <(var)>, NIL, <{valid}>, <{when}> ) ;
) ;
; ATail(GetList):Control := _RadioGrp_( <top>, <left>, <bottom>, ;
<right>, <var>, <buttons>, <caption>, <message>, ;
<color>, <{fblock}>, <style> ):display() ;
; ATail(GetList):reader := { | a, b, c, d, e, f | ;
GuiReader( a, b, c, d, e, f ) } ;
[; ATail(GetList):<msg>] ;
[; ATail(GetList):Control:<guimsg>]
Veja o exemplo de programa com estes recursos neste exemplo usando uma lib chamada SPTools.