Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : RADIOB.ZIP
Filename : RADIOBTN.PRG

 
Output of file : RADIOBTN.PRG contained in archive : RADIOB.ZIP
/*
³ Radio buttons for Clipper 5.2
³
³ For a demonstration, run the batch file MAKEDEMO.BAT to make an EXE or use
³ the command:
³
³ rmake radiobtn /dTEST
³
³ To use the radio buttons GET Reader in an application, recompile
³ RADIOBTN.PRG without the /dTEST preprocessor directive.
³
³ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
³ ³ The functions contained herein are the original work of Dan Comeau ³
³ ³ and others and are placed in the public domain. ³
³ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ
³
³ Modifications:
³
³ Version Changes
³ ÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ 1.0 þ Original release.
³ 1.0a þ Disabled GET variables now return 0; ie., when the WHEN
³ expression is false. Thanks to John Forsberg [75170,641]
³ for this modification. Note that if the user ends the READ
³ with Esc, PgUp, or PgDn, the disabled GET value may not
³ be 0.
³ 1.0b þ New parameter for drawing shadow around box. See
³ RADIOBTN.CH for syntax. Thanks (again) to John Forsberg
³ [75170,641] for this modification. Check out the
³ DrawBoxShadow() function he wrote to draw a shadow around a
³ box using pure Clipper code.
³ 1.1 þ VALID clause now supported.
³ 1.2 þ Horizontal spacing option, HSPACING, added. Thanks to
³ Rich Miller [70632,734] for this modification.
³ þ New syntax: VIA RADIOBUTTONS. The previous syntax of
³ WITH RADIOBUTTONS is still supported. You don't need to
³ change your code because of this change.
³ þ Made several minor internal changes to optimize display.
³
³
³ I'd like to hear about any enhancements you make to these functions. In
³ fact, with your permission, I'd like to add your enhancements and make a
³ new version. Send revised source code or questions to my CompuServe
³ account [70451,2312] or my mailing address:
³
³ Dan Comeau
³ 603-1320 Richmond Rd
³ Ottawa, Ontario, K2B 8L3, Canada.
³
³ If you end up using all or parts of this code in a commercial or
³ shareware library, I'd appreciate it if you let me know.
³
*/

#include "radiobtn.ch"

#include "box.ch" //ÄÄ as shipped with Clipper
#include "getexit.ch" //ÄÄ '' '' '' ''
#include "inkey.ch" //ÄÄ '' '' '' ''

#define RB_LEFT "(" //ÄÄ left bracket
#define RB_RIGHT ")" //ÄÄ right bracket
#define RB_YES chr(7) //ÄÄ the dot in the middle of the brackets
#define RB_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


/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Test function for the radio buttons.
³
³ To make the test version, use: rmake radiobtn /dTEST
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
#ifdef TEST

#define SCREEN_COLOR "GR+/B" //ÄÄ regular screen color
#define SHADOWBOX_COLOR "GR+/R" //ÄÄ for box with a shadow around it
#define GREYED_COLOR "W/B" //ÄÄ color of disabled GET

function test()

local aGet1 := { "1 Choice1","2 Disable Buttons #2","3 Choice1" }
local cGet1 := "Get 1"
local cGet2 := "Get 2"
local GetList := {}
local nChoice1 := 2 //ÄÄ initial choices for radio buttons
local nChoice2 := 1
local nChoice3 := 1
local nChoice4 := 2
local nChoice5 := 2

set scoreboard off

//ÄÄ demonstrate set key ability within a radio button GET
setkey( K_F1, { |s,r,c| s:=savescreen(), ;
r:=row(),;
c:=col(),;
scroll(), ;
setpos(5,5), ;
dispout("You pressed F1. Press any key to continue . . ."), ;
inkey(0), ;
restscreen(,,,,s),;
setpos(r,c) } )

setcolor( SCREEN_COLOR )
clear screen

@ 2,5 say "Use the Tab, Shift-Tab, arrow, space bar, and Enter keys to move around."
@ 3,5 say "Press F1 to show use of setkey within GETs."

@ 5,5 say "Normal Get #1:" ;
get cGet1

@ 6,5 say "Buttons #1" ;
get nChoice1 ;
color SCREEN_COLOR ;
via radiobuttons aGet1

@ 6,40 say "Buttons #2" ;
get nChoice2 ;
when nChoice1 != 2 ;
color SCREEN_COLOR+","+GREYED_COLOR ;
via radiobuttons { "1 Choice2","2 Choice2","3 Choice2","4 Choice2" } ;
nobox

@ 7,60 get nChoice3 ;
color SCREEN_COLOR ;
via radiobuttons { "1 Choice3","2 Choice3","3 Choice3","4 Choice3","5 Choice3" } ;
nobox

@ 11,5 say "Normal Get #2:" ;
get cGet2

@ 13,5 say "Buttons #4:"
@ 13,col()+1 get nChoice4 ;
color SCREEN_COLOR ;
via radiobuttons { "1 Choice4","2 Choice4","3 Choice4" } ;
nobox ;
horizontal

@ 18,2 say "This is a radiobutton with a shadowed box drawn around it."
@ 15,5 say"Choice 5 With Horizontal Spacing = 5 and a Long Title" ;
get nChoice5 ;
color SHADOWBOX_COLOR ;
with radiobuttons { "1 Choice5","2 Choice5" } ;
double ;
horizontal ;
hspacing 5 ;
shadow

read
RadioBtnKill() //ÄÄ reduce memory requirement by setting array to NIL

//ÄÄ display values
? "Normal Get Values :",cGet1, cGet2
? "Radio Button Values:", nChoice1, nChoice2, nChoice3, nChoice4, nChoice5

return nil

#endif


/*
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
³ Initialization for Radio Buttons. Display title and choices. Optionally
³ draw box around choices. Horizontal choices must fit on one line.
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
function RadioBtnNew( oGet, bWhen, ;
nRow, nCol, cTitle, nChoice, ;
aChoices, lNoBox, lDblBox, ;
lHoriz, lShadow, nHSpacing )

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
nChoice := 1
endif

//ÄÄ Add choices array to the aAllButtons array.
aadd( aAllButtons, { oGet:Name, aChoices, nHSpacing } )

// ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿
// ³ 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
nChoice := 0 //ÄÄ don't show any choices for greyed out radio buttons

//ÄÄ return zero for disabled button
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
³ RadioBtnReader().
*/
DrawRadioButtons( nRow, ;
nCol - if( lHoriz .and. lNoBox .and. empty( cTitle ), ;
1, 0 ;
), ;
aChoices, nChoice, nChoice, cColorSpec, ;
lNoBox, lHoriz, empty( cTitle ), nHSpacing ;
)
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
RB_LEFT + ; //ÄÄ left bracket
( if( n == nCursor, nCursorPos := col() + ; //ÄÄ set position of selected button
if( n == 1, ;
0, ;
nHSpacing-if( lNoBox, 0, 1 ) ), ), ;
if( n == nChoice, RB_YES, RB_NO ) ; //ÄÄ bw the brackets
) + ;
RB_RIGHT + " " + c, ; //ÄÄ right bracket + text
cColorSpec ;
) ;
}

#xtranslate bVERTICALCONTROL ;
=> { | c, n | setpos( row() + 1, if( lNoBox, nCol, nCol + 2 ) ), ;
dispout( RB_LEFT + ( if( n == nCursor, nCursorPos := row(), ), ;
if( n == nChoice, RB_YES, RB_NO );
) + ;
RB_RIGHT + " " + c, ;
cColorSpec ;
) ;
}


static function DrawRadioButtons( nRow, nCol, aChoices, nChoice, nCursor, ;
cColorSpec, lNoBox, lHoriz, lNoTitle, ;
nHSpacing )

local nCursorPos := 0 //ÄÄ cursor position (could be either row or col)

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 Buttons GET Reader.
³ Supports WHEN and VALID.
³ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ
*/
function RadioBtnReader( oGet, lNoBox, lHoriz, cTitle )

local aChoices //ÄÄ radio button choices
local cGetVar //ÄÄ current get variable
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
nFoundChoice := ascan( aAllButtons, { |a| a[1] == oGet:Name } )
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
//ÄÄ make a copy of the get var value; return zero for disabled button
nChoice := if( oGet:VarGet() != 0, oGet:VarGet(), 1 )
nCursor := nChoice //ÄÄ cursor position
nKey := 0
nMaxChoices := len( aChoices )


//ÄÄ 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 )
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
//ÄÄ move choice to next button
nCursor := nChoice := if( nChoice == nMaxChoices, 1, nChoice+1 )
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
//ÄÄ 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

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 )
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

//ÄÄ return zero for disabled button
oGet:VarPut( 0 ) //ÄÄ update get var

DrawRadioButtons( oGet:Row, oGet:Col, aChoices, nChoice, nCursor, ;
cGreyColor, lNoBox, lHoriz, empty(cTitle), ;
nHSpacing )

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 RadioBtnKill()
aAllButtons := {}
return nil

*: EOF: RADIOBTN.PRG


  3 Responses to “Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : RADIOB.ZIP
Filename : RADIOBTN.PRG

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/