home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / MAGAZINE / MISC / DBMS9108.ZIP / EHRMANN.SEP < prev    next >
Encoding:
Text File  |  1991-07-26  |  9.0 KB  |  269 lines
  1. Listing 1: A test script for WAIT.  
  2.  
  3. edit "CUSTOMER" 
  4. pickform "1" 
  5. while (true) 
  6.    wait table 
  7.       prompt "You can make changes - press Esc to exit" 
  8.    until "Esc" 
  9.    Do_It!                              ; save 
  10.    clearimage                          ; remove image 
  11.    quit                                ; finish script 
  12. endwhile 
  13.  
  14.  
  15.  
  16.  
  17. Listing 2: Custom FieldView example
  18.  
  19.   
  20. proc FIELD_VIEW() 
  21.    private HOLDING                     ; starting value of field 
  22.    HOLDING = []                        ; save field contents 
  23.    while (true) 
  24.       fieldview                        ; enter special mode 
  25.       wait field                       ; cannot leave field 
  26.         prompt "Now in FieldView. Enter/F2 saves; Esc cancels"
  27.         until "Enter", "F2", "Esc", "DOS", "DOSBig" 
  28.       switch 
  29.          case retval = "Enter" or retval = "F2" : 
  30.             quitloop 
  31.          case retval = "Esc" : 
  32.             [] = HOLDING               ; restore field contents 
  33.             quitloop 
  34.          otherwise : 
  35.             beep 
  36.       endswitch 
  37.    endwhile 
  38. endproc 
  39. edit "CUSTOMER" 
  40. pickform "1" 
  41. while (true) 
  42.    wait table 
  43.       prompt "You can make changes - press Esc to exit", 
  44.              "Press Alt-F5 or Ctrl-F to enter FieldView" 
  45.    until "Esc", "FieldView", "F35" 
  46.    switch 
  47.       case retval = "FieldView" or retval = "F35" : 
  48.          FIELD_VIEW()                  ; jump to special proc 
  49.       case retval = "Esc" : 
  50.          Do_It!                        ; save 
  51.          clearimage                    ; remove image 
  52.          quit                          ; finish script 
  53.    endswitch 
  54. endwhile 
  55.  
  56. Listing 3: Alternate FieldView 
  57.  
  58. proc DOFIELDVIEW() 
  59.    private HOLDING 
  60.    HOLDING = [] 
  61.    fieldview                      ; enter special mode 
  62.    cursor normal                  ; turn on Canvas cursor 
  63.    prompt "Editing Field: Enter saves/ends; Esc Cancels/Ends","" 
  64.    while (true) 
  65.       echo normal                 ; show workspace 
  66.       echo off                    ; freeze Canvas 
  67.       synccursor                  ; jump cursor to same position 
  68.       retval = getchar()          ; wait for a single key 
  69.       switch 
  70.          case ( retval <= -71 and retval >= -83 )  ; cursor keys 
  71.            or ( retval >=  32 and retval <= 254 ) : ; alpha keys 
  72.            keypress retval 
  73.           case   
  74.           retval  =   8  :      ; backspace 
  75.             backspace 
  76.           case   
  77.             retval  =  27  :           ; esc 
  78.             enter 
  79.             [] = HOLDING               ; undo capability 
  80.             prompt                     ; restore prompt 
  81.             cursor off                 ; turn canvas cursor off 
  82.             return False 
  83.           case   
  84.             retval  =  13  :           ; enter
  85.             enter                      ; finish 
  86.             prompt                     ; restore prompt 
  87.             cursor off                 ; turn canvas cursor off 
  88.             return True 
  89.           otherwise :                  ; everything else
  90.              beep 
  91.        endswitch 
  92.    endwhile 
  93.  endproc 
  94. edit "CUSTOMER" 
  95. pickform "1" 
  96.  while (true) 
  97.    wait table 
  98.       prompt "You can make changes - press Esc to exit", 
  99.              "Press AltF5 or CtrlF to enter FieldView" 
  100.    until "Esc", "FieldView", "F35" 
  101.     switch 
  102.       case retval = "FieldView" or retval = "F35" : 
  103.          DOFIELDVIEW()                ; jump to new special proc 
  104.       case retval = "Esc" : 
  105.          Do_It!                       ; save 
  106.          clearimage                   ; remove image 
  107.          quit                         ; finish script 
  108.     endswitch 
  109.  endwhile  Listing 4: Custom procedure for ZOOM 
  110.  
  111. proc CUSTOM_ZOOM() 
  112.    private VALUE 
  113.    paintcanvas                        ; blank top two lines 
  114.       fill " " 
  115.       attribute syscolor(0) 
  116.       0,0,1,79 
  117.    @ 1,0 ?? "Type search value and press Enter; Esc cancels"
  118.    @ 0,0 ?? "Value:  " 
  119.    accept fieldtype() to VALUE        ; wait for user entry 
  120.    if retval = False then             ; Esc was pressed 
  121.       return 
  122.    endif 
  123.    zoom                               ; press Ctrl-Z 
  124.    ctrlbackspace                      ; remove previous value 
  125.    typein VALUE                       ; enter new value 
  126.    enter                              ; press this key to search 
  127. endproc 
  128. edit "CUSTOMER" 
  129. pickform "1" 
  130.  while (true) 
  131.    wait table 
  132.       prompt "You can make changes - press Esc to exit" 
  133.    until "Esc", "Zoom" 
  134.    switch 
  135.       case retval = "Zoom" :           ; user pressed this key 
  136.          CUSTOM_ZOOM() 
  137.       case retval = "Esc" : 
  138.          Do_It! 
  139.          clearimage 
  140.          quit 
  141.     endswitch 
  142. endwhile 
  143.  
  144.  
  145. Listing 5: A more complex Zoom 
  146.  
  147. proc CUSTOM_ZOOM() 
  148.    paintcanvas                         ; blank top two lines 
  149.       fill " " 
  150.       attribute syscolor(0) 
  151.       0,0,1,79 
  152.    @ 1,0 ?? "Type search value and press Enter; Esc cancels"
  153.    @ 0,0 ?? "Value:  " 
  154.    if  field() = YYY                 ; test if on previous field 
  155.    and isassigned(VALUE)              ; and search was performed 
  156.    and fieldtype() = type(VALUE) then  ; and type is the same 
  157.       accept fieldtype() default VALUE to VALUE 
  158.    else 
  159.       YYY = field()                   ; assign "flag" 
  160.       accept fieldtype() to VALUE     ; simple ACCEPT 
  161.    endif 
  162.    if retval = False then             ; Esc was pressed 
  163.       return 
  164.    endif 
  165.    zoom                               ; press Ctrl-Z 
  166.    ctrlbackspace                      ; remove previous value 
  167.    typein VALUE                       ; enter new value 
  168.    enter                              ; press this key to search 
  169.    if window() <> "" then             ; message from Paradox 
  170.       return window() 
  171.    else 
  172.       echo normal                     ; update Canvas 
  173.       echo off 
  174.       fieldview 
  175.       home                            ; jump to start of field 
  176.       synccursor                      ; update Canvas cursor 
  177.       X = col()                       ; save position 
  178.       enter 
  179.       menu esc                        ; restore field position 
  180.       synccursor                      ; update Canvas cursor 
  181.       paintcanvas                     ; highlight field 
  182.          reverse 
  183.          row(), X, row(), col() 
  184.       sleep 250                       ; for 1/4 sec 
  185.       return True 
  186.    endif 
  187.  endproc 
  188. proc EDIT_CUSTOMER() 
  189.    private XXX,                        ; WAIT message 
  190.            YYY,                        ; current field 
  191.            VALUE                       ; search value 
  192.    edit "CUSTOMER" 
  193.    XXX = ""                            ; initialize message 
  194.    YYY = field()                       ; and field 
  195.    while (true) 
  196.       wait table 
  197.          prompt "You can make changes - press Esc to exit" 
  198.          message XXX 
  199.       until "Esc", "Zoom" 
  200.       switch 
  201.          case retval = "Zoom" :        ; this key was pressed 
  202.             CUSTOM_ZOOM()              ; call proc 
  203.             if retval = True then      ; value found 
  204.                XXX = ""                ; message is null 
  205.             else 
  206.                XXX = retval            ; message equals WINDOW() 
  207.             endif 
  208.          case retval = "Esc" : 
  209.             Do_It! 
  210.             clearimage 
  211.             quit 
  212.        endswitch 
  213.    endwhile 
  214. endproc 
  215. EDIT_CUSTOMER() 
  216.  
  217. Listing 6: Controling Table-lookup Valchecks 
  218.  
  219. proc VALCHECKHELP() 
  220.    help                                ; press F1 
  221.    if helpmode() <> "LookupHelp" then  ; check mode 
  222.       esc 
  223.       return False 
  224.    endif 
  225.    prompt "Select the value to insert and press F2", 
  226.           "Or press Esc to cancel the operation" 
  227.    cursor normal 
  228.    while (true) 
  229.       echo normal                      ; show Workspace 
  230.       echo off                         ; freeze onto Canvas 
  231.       synccursor 
  232.       retval = getchar()               ; get key from user 
  233.       switch 
  234.          case retval = -60  :          ; F2 
  235.             do_it! 
  236.             quitloop 
  237.          case retval = 27   :          ; Esc 
  238.             esc 
  239.             quitloop 
  240.          case retval = 26 :            ; zoom 
  241.             CUSTOM_ZOOM() 
  242.          case retval = -44 :           ; zoomnext 
  243.             zoomnext 
  244.          case retval <= -71 
  245.           and retval >= -81 :          ; major cursor keys 
  246.             keypress retval 
  247.          otherwise :                   ; everything else 
  248.             beep 
  249.       endswitch 
  250.    endwhile 
  251.    cursor off                          ; turn Canvas cursor off 
  252.    prompt                              ; restore default prompt 
  253.    return True                         ; lookup performed 
  254.  endproc 
  255. edit "CUSTOMER" 
  256. pickform "1" 
  257. while (true) 
  258.    wait table 
  259.       prompt "You can make changes - press Esc to exit" 
  260.    until "Esc", "F1" 
  261.    switch 
  262.       case retval = "F1" :             ; this key was pressed 
  263.          VALCHECKHELP()                ; call custom proc 
  264.       case retval = "Esc" : 
  265.          Do_It! 
  266.          clearimage 
  267.          quit 
  268.     endswitch 
  269. endwhile