Caixas de verificação

Fórum sobre a linguagem CA-Clipper.

Moderador: Moderadores

EPorcellis
Usuário Nível 1
Usuário Nível 1
Mensagens: 4
Registrado em: 22 Jul 2004 09:53
Contato:

Caixas de verificação

Mensagem por EPorcellis »

Alguém usa com sucesso caixas de verificação em seus programas? Como faço para usar?
Émerson Porcellis
Avatar do usuário
software_facil
Usuário Nível 3
Usuário Nível 3
Mensagens: 211
Registrado em: 23 Fev 2005 12:19
Localização: Curitiba/PR
Contato:

Mensagem por software_facil »

Boa tarde Emerson,

No site da computer associates www.cai.com, na seção de patches para o Clipper, existe um pequeno exemplo denominado MDEMO, o qual mostra todos os recursos novos embutidos no Clipper 5.3, o qual aliás, é a única versão do Clipper que trabalha "nativamente" com esses recursos, bem como radio buttons, menus pull-down com letra em destaque, suporte total ao mouse, figuras em campos memo, e outros recursos visuais em modo gráfico (com o uso da lib LLIBG) para o DOS.
Salientando ainda, como já li em muitos lugares, existe uma afirmação que não é correta, que é a de dizer que a última versão do Clipper era "for Windows", a CA nunca fez tal versão, e a única maneira de ter-se o compilador Clipper rodando como um aplicativo "for Windows", é anexar umas dessas bibliotecas 1-Fivewin, 2-C4Win, 3-DolceVita, se não me engano existe outra, mas no momento não me recordo, sendo que, com o uso dessas bibliotecas, o seu executável sempre será 16bits.

Abraços
messenger : software_facil@hotmail.com
Dudu_XBase
Membro Master
Membro Master
Mensagens: 1071
Registrado em: 25 Ago 2003 16:55

Mensagem por Dudu_XBase »

Boa Noite Emerson !
Eu localizei esse zip, tem tb um bom exemplo no site do magnoman mas a seção downloads ta zoada já comuniquei ele.

// Caixas de Verificação ou Radio
http://www.karland.com/code/clipper/files/btn_te.zip


________________________________________________________________________________________________________
(Aow Saudade) Clipper 5.2e, Blinker 7, RDD SIXNSX, DBFCDX /Xharbour 1.0, Rdd Mediator (Mysql) Free , RDD Sqlrdd (Sql Server) Comercial
(Hoje) C# Python Sql Server e Oracle




Avatar do usuário
rochinha
Administrador
Administrador
Mensagens: 4664
Registrado em: 18 Ago 2003 20:43
Localização: São Paulo - Brasil
Contato:

Mensagem por rochinha »

Amiguinho

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( http://www.the-oasis.net/ )

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.

http://www.5volution.com.br/downloads/forum/sptools.zip

@braços :?)
Dudu_XBase
Membro Master
Membro Master
Mensagens: 1071
Registrado em: 25 Ago 2003 16:55

Mensagem por Dudu_XBase »

Colocado na Seção Downloads para usar com Clipper 5.2

// Caixas de Verificação
https://pctoledo.org/forum/dload. ... ile_id=149


________________________________________________________________________________________________________
(Aow Saudade) Clipper 5.2e, Blinker 7, RDD SIXNSX, DBFCDX /Xharbour 1.0, Rdd Mediator (Mysql) Free , RDD Sqlrdd (Sql Server) Comercial
(Hoje) C# Python Sql Server e Oracle




Responder