How to Implement a Customized Scrolling GET List Control

Last reviewed: April 30, 1996
Article ID: Q121437

The information in this article applies to:

Microsoft FoxPro for MS-DOS, versions 2.0, 2.5x, 2.6, 2.6a
Microsoft FoxPro for Windows, versions 2.5x, 2.6, 2.6a

SUMMARY

FoxPro does not provide any built-in means of creating a specialized scrolling control like the one used in the Modify Structure dialog box or the one used in the RQBE tool.

It is possible, however, to simulate such a control by using a series of nested windows. The sample code below illustrates this process.

MORE INFORMATION

NOTE: Save this code as SCROLLER.PRG. To execute the code, type "DO scroller.prg" in the Command window.

Sample Code

*------------------------------------------------------------------------- * * SCROLLER.PRG - Sample code for implementing a simple specialized list

*                control
*

* Various environmental initializations...

     scrnfont="FoxFont"
     scrnfontsize=9
     num_items=15
     CLEAR
     IF _WINDOWS
       MODIFY WINDOW SCREEN FONT scrnfont,scrnfontsize
     ENDIF

* Define container window.

     DEFINE WINDOW container ;
          FROM 1,1 TO 12,30 ;
          TITLE "Scrolling Gets" ;
          HALFHEIGHT FLOAT ;
          FONT scrnfont,scrnfontsize
     ACTIVATE WINDOW container

* Define the container for the scrolled region. Window B will * limit the visibility of the scrolling chunk of screen, and * window C will actually be relocated on the screen as the * scrolling buttons are pressed.

     DEFINE WINDOW B ;
          FROM 1,2 TO 9,12 ;
          IN WINDOW container ;
          FONT scrnfont,scrnfontsize
     DEFINE WINDOW C ;
          FROM 0,0 TO 100,20 ;
          IN WINDOW B ;
          FONT scrnfont,scrnfontsize ;
          NONE
     ACTIVATE WINDOW B
     ACTIVATE WINDOW C

* Define the container for the control buttons and other * GET objects on the screen. In order to be able to access * controls in both the container and the scrollable region, * the controls must be at the same level of window-nesting.

     DEFINE WINDOW a1 ;
          FROM 1,13 TO 9,30 ;
          IN WINDOW container ;
          FONT scrnfont,scrnfontsize ;
          NONE
     DEFINE WINDOW a2 ;
          FROM 0,0 TO 8,17 ;
          IN WINDOW a1 ;
          FONT scrnfont,scrnfontsize ;
          NONE
     ACTIVATE WINDOW a1
     ACTIVATE WINDOW a2

* Initialize button variables.

     scrup=1
     scrdn=1
     exitbtn=0

* Draw the buttons.

     @0,0 GET scrup ;
          FUNCTION "* ^" ;
          VALID scrollit('up') ;
          SIZE 2,3
     @6,0 GET scrdn ;
          FUNCTION "* v" ;
          VALID scrollit('dn') ;
          SIZE 2,3
     @6,5 GET exitbtn ;
          FUNCTION "* \?Quit" ;
          SIZE 2,5

* Define the controls on the scrolling region. * Create <num_items> buttons and GETs. * (This is also an example of a control array.)

     ACTIVATE WINDOW C
     DECLARE btn(num_items)
     DECLARE txt(num_items)
     FOR i = 1 TO num_items
          btn(i) = 1
          txt(i) = chr(i+48) + chr(i+49) + chr(i+50)
          @i-1,0 GET btn(i) ;
               FUNCTION "* " + STR(i) ;
               SIZE 1,3 ;
               VALID scrbtn(OBJVAR())
          @i-1,4 GET txt(i) ;
               SIZE 1,5 ;
               WHEN scrtxt(OBJVAR(),"When") ;
               VALID scrtxt(OBJVAR(),"Valid")
     NEXT
     READ WHEN enablescroll() VALID exitbtn=1
     RELEASE WINDOW container
     return

*------------------------------------------------------------------------- PROCEDURE scrollit * Use the Move Window command to position the scroll area

     PARAMETER direction
     DO CASE
          CASE LOWER(direction) = 'dn'
               MOVE WINDOW C BY -1,0
          CASE LOWER(direction) = 'up'
               MOVE WINDOW C BY 1,0
     ENDCASE
     =enablescroll()
     RETURN .T.

*------------------------------------------------------------------------- PROCEDURE enablescroll * Disable or enable the scroll buttons as appropriate.

     ACTIVATE WINDOW a2
     curpos = ROUND(WLROW('b')-WLROW('c'),0)
     visible_items = ROUND(WROWS('b'),0)
     enableup = curpos > 0
     enabledn = curpos < num_items-visible_items
     IF enableup
          SHOW GET scrup enabled
     ELSE
          SHOW GET scrup disabled
     ENDIF
     IF enabledn
          SHOW GET scrdn enabled
     ELSE
          SHOW GET scrdn disabled
     ENDIF
     RETURN .T.

*------------------------------------------------------------------------- PROCEDURE scrbtn

     PARAMETER btnname
     bindex=STR(VAL(RIGHT(btnname,  LEN(btnname) - AT("(",btnname) ) ) )
     WAIT WINDOW "Button " + ALLTRIM(bindex) ;
          + " Valid." ;
          NOWAIT TIMEOUT 5
     RETURN .T.

*------------------------------------------------------------------------- PROCEDURE scrtxt

     PARAMETER fname,clause
     findex=VAL(RIGHT(fname,LEN(fname) - AT("(",fname)))
     WAIT WINDOW "Field " + fname + " " ;
          + clause + ":" + CHR(13) + txt(findex) ;
          NOWAIT TIMEOUT 5
     RETURN .T.

* * * End of program SCROLLER.PRG *-------------------------------------------------------------------------

Additional reference words: FoxDos FoxWin 2.00 2.5x 2.50 2.5 2.5a 2.50a
2.5b 2.50b 2.60 2.60a control array get list getlist scroll bar scrollbar
KBCategory: kbprg kbui kbcode
KBSubcategory: FxtoolRqbe

THE INFORMATION PROVIDED IN THE MICROSOFT KNOWLEDGE BASE IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND. MICROSOFT DISCLAIMS ALL WARRANTIES, EITHER EXPRESS OR IMPLIED, INCLUDING THE WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. IN NO EVENT SHALL MICROSOFT CORPORATION OR ITS SUPPLIERS BE LIABLE FOR ANY DAMAGES WHATSOEVER INCLUDING DIRECT, INDIRECT, INCIDENTAL, CONSEQUENTIAL, LOSS OF BUSINESS PROFITS OR SPECIAL DAMAGES, EVEN IF MICROSOFT CORPORATION OR ITS SUPPLIERS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. SOME STATES DO NOT ALLOW THE EXCLUSION OR LIMITATION OF LIABILITY FOR CONSEQUENTIAL OR INCIDENTAL DAMAGES SO THE FOREGOING LIMITATION MAY NOT APPLY.

Last reviewed: April 30, 1996
© 1998 Microsoft Corporation. All rights reserved. Terms of Use.