READ

***** Popup with hot keys
STORE 1 TO choice
@ 4,2 GET choice FUNCTION ' \<Cash;Cha\<rge;Net 30;Net 60'
READ

***** Disabled popup
STORE 1 TO choice
@ 4,2 GET choice FUNCTION ' Cash;\Charge;Net 30;Net 60'
READ
Here are some examples of valid DEFAULT clauses for popups:

@ 5,0 GET choice FUNCTION ' Cash;Charge;Net 30;Net 60' DEFAULT 'Cash'
READ

@ 5,0 GET choice FUNCTION ' Cash;Charge;Net 30;Net 60' DEFAULT 3
READ

***** Dynamically changed popups
CLEAR
SET TALK OFF
STORE 1 TO color, fruitorveg, popchoice, start
DIMENSION poparray(4,3)
STORE 'Apples' TO poparray(1,1)
STORE 'Bananas' TO poparray(1,2)
STORE 'Limes' TO poparray(1,3)
STORE 'Strawberries' TO poparray(2,1)
STORE 'Lemons' TO poparray(2,2)
STORE 'Grapes' TO poparray(2,3)
STORE 'Radishes' TO poparray(3,1)
STORE 'Corn' TO poparray(3,2)
STORE 'Lettuce' TO poparray(3,3)
STORE 'Beets' TO poparray(4,1)
STORE 'Squash' TO poparray(4,2)
STORE 'Celery' TO poparray(4,3)

@ 9, 2  SAY 'Color:'
@ 11,2  SAY 'Type:'
@ 9, 10 GET color  FUNCTION '*RH \<Red;\<Yellow;\<Green' ;
        SIZE 0,0,2 VALID PROC1()
@ 11,10 GET fruitorveg FUNCTION '*RH \<Fruit;\<Vegetable' ;
        SIZE 0,0,2 VALID PROC2()
@ 4, 14 GET popchoice FUNCTION '' FROM poparray RANGE start,2
@ 14,17 GET ok FUNCTION '*T OK' DEFAULT 1 SIZE 1,8
@ 10,0,10,41 BOX
@ 8,0,12,41 BOX
READ CYCLE

PROCEDURE PROC1
DO CASE
        CASE COLOR = 1
                IF fruitorveg = 1
                        start = 1
                ELSE
                        start = 7
                ENDIF
        CASE COLOR = 2
                IF fruitorveg = 1
                        start = 2
                ELSE
                        start = 8
                ENDIF
        CASE COLOR = 3
                IF fruitorveg = 1
                        start = 3
                ELSE
                        start = 9
        ENDIF
ENDCASE
STORE 1 TO popchoice
SHOW GETS
RETURN .T.

PROCEDURE PROC2
IF fruitorveg = 1
        DO CASE
                CASE color = 1
                        STORE 1 TO start
                CASE color = 2
                        STORE 2 TO start
                CASE color = 3
                        STORE 3 TO start
        ENDCASE
ELSE
        DO CASE
                CASE color = 1
                        STORE 7 TO start
                CASE color = 2
                        STORE 8 TO start
                CASE color = 3
                        STORE 9 TO start
        ENDCASE
ENDIF
STORE 1 TO popchoice
SHOW GETS
RETURN .T.

***** Override color defaults
STORE 1 TO choice
@ 5,0 GET choice FUNCTION ' Cash;Charge;Net 30;Net 60' ;
        COLOR SCHEME 4
READ

*       Defines popup with hot buttons and color characteristics:
*               selected option         bright white on a blue background (W+/B)
*               Hot key                         red on a blue background (R/B)
*               Enabled options         yellow on a blue background (GR+/B)
*               Disabled options        white on a blue background (W/B)
STORE 1 TO choice
@ 5,0 GET choice FUNCTION ' \<Cash;Cha\<rge;Net30;Net60' ;
        COLOR ,,,,,W+/B,R/B,,GR+/B,W/B
READ

+---------------------------------+
|         Program Example         |
+---------------------------------+
SET TALK OFF
DEFINE WINDOW popupex FROM 7, 16 TO 16,63 ;
        FLOAT DOUBLE COLOR SCHEME 5
CLOSE ALL
USE customer
DIMENSION dbftags(256)
dbftags(1) = 'Record #'
FOR i = 2 to 256
        IF empty(tag(i-1))
                i = i - 1
                DIMENSION dbftags(i)
                EXIT
        ELSE
                dbftags(i) = tag(i-1)
        ENDIF
ENDFOR
dbforder = 'Record #'

ACTIVATE WINDOW popupex
@ 3,7 GET dbforder PICTURE '@' FROM dbftags SIZE 3,14
@ 0,2 TO 7,43
@ 0,5 SAY ' Customer Browse Order: '
@ 2,27 GET okcancel PICTURE '@*VT \!OK;\?Cancel' ;
        SIZE 1, 10, 2 DEFAULT 0
READ CYCLE
RELEASE WINDOW popupex

IF okcancel = 1
        IF dbforder = "Record #"
                SET ORDER TO
        ELSE
                SET ORDER TO (dbforder)
        ENDIF
        WAIT WINDOW 'Order set to '+dbforder NOWAIT
        BROWSE WIDTH 10 NOWAIT
ELSE
        WAIT WINDOW 'Order not set' NOWAIT
        CLOSE ALL
ENDIF

-----------------------------------

See Also:  @ ... SAY/GET, OBJNUM(), READ, SHOW GETS, USER-DEFINED
FUNCTIONS (UDFs)

-----------------------------------