home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / window / pwez70 / sampform.bas < prev    next >
Encoding:
BASIC Source File  |  1994-02-01  |  6.8 KB  |  154 lines
  1. DECLARE SUB FORMSAMP.FRM.SETUP (S%, BCOL%, TAC%, TMAC%, BAC%, BMAC%, MAC%)
  2. DECLARE SUB FORMSAMP.FRM.DISPLAY (W%, FCOL%, HCOL%)
  3.  
  4. ' Functions MUST DECLARE
  5. DECLARE FUNCTION MOUSEON% (ONOFF%)
  6. DECLARE FUNCTION CHOICEWIND% (T$, T$(), C$(), TR%, LC%, C1%, C2%, ESC%, BRDR%)
  7.  
  8. '***************************************************************************
  9. '**** THIS PROGRAM MUST BE USED WITH ONE OF THE FOLLOWING LIBRARIES:    ****
  10. '***************************************************************************
  11. '**** For QB4.5 unenhanced version use QBUNEN.QLB                       ****
  12. '**** For BASIC 7.1 unenhanced version use PDSUNEN.QLB                  ****
  13. '**** For VBDOS 1.0 unenhanced version use VBUNEN.QLB                   ****
  14. '**** For QB4.50 enhanced version use QBALL.QLB or QBNER.QLB            ****
  15. '**** For BASIC 7.1 enhanced version use PDSALL.QLB or PDSNER.QLB       ****
  16. '**** For VBDOS 1.0 enhanced version use VBALL.QLB or VBNER.QLB         ****
  17. '**** Load QB, QBX, or VBDOS with the /L option and the correct library ****
  18. '***************************************************************************
  19. '**** Load this file first as the main module then load FORMSAMP.FRM    ****
  20. '**** as a module.   Although only four  CALLS  are required to edit    ****
  21. '**** data in the form,  this example displays many  options such as    ****
  22. '**** the INFOLINE, HELP, and data validation.                          ****
  23. '***************************************************************************
  24. COLOR 0, 7: CLS
  25. '----------- Routines must be called once in every program. ---------------
  26. '----------- See WIND_REZ.DOC for details
  27.  
  28. CALL SETWIND(1, 1, 8, 0, 15)          ' For all routines.  15 is color
  29.                                       ' of "hot brackets".
  30. CALL INPTINIT(1, 1, 1, 1, 1)          ' For input routines
  31. J% = MOUSEON%(1)                      ' turn mouse "ON"
  32.  
  33. '--------- Set up the fields and display the form w/o the fields ----------
  34.  
  35.   '----- SETINPT must be called prior to call to FORMSAMP.FRM.SETUP.
  36.   '----- If the Muli-field input screen ( #1 in this example ) is
  37.   '----- reserved for this input screen only, SETINPT & FORMSAMP.FRM.SETUP
  38.   '----- can be called once in the program.  Calls to FORMSAMP.FRM.DISPLAY
  39.   '----- and MULTINPT can be repeated when required.
  40.  
  41.   CALL SETINPT(1, 25, "1E", 15)      ' Mult-input screen #1 with 25 lines.
  42.                                      ' F1 or ESC will exit MULTINPT.
  43.                                      ' 15 is color for button field hot
  44.                                      ' characters.
  45.  
  46.   '----- FORMSAMP.FRM.SETUP calls routine MAKEFIELD for all fields.
  47.  
  48.   CALL FORMSAMP.FRM.SETUP(1, 23, 15, 15, 15, 23, 15)
  49.  
  50.   '----- FORMSAMP.FRM.DISPLAY displays the form without the fields.
  51.   '----- The call to MULTINPT which follows displays the fields.
  52.  
  53.   CALL FORMSAMP.FRM.DISPLAY(1, 23, 15)
  54.  
  55.   '- Add boxes / lines to the form. Use print-out from Form Maker to help -
  56.  
  57.   CALL LINEW(2, 1): CALL LINEW(10, 1)
  58.   CALL BOXW(11, 7, 12, 3, 1): CALL BOXW(11, 43, 12, 3, 1)
  59.  
  60. '---------- Set constants for button and mouse select fields --------------
  61.  
  62.   DIM FIELDDATA$(12)                    ' 12 fields in the form
  63.   FIELDDATA$(10) = "<   OK   >"         ' 10th field is OK button
  64.   FIELDDATA$(11) = "< Cancel >"         ' 11th field is Cancel button
  65.   FIELDDATA$(12) = "[ F1=HELP ]"        ' 12th field is "Mouse select field"
  66.  
  67.   CALL INFOLINE(25, 2, 78, 31)          ' Print instuctions on bottom line
  68.  
  69. '------------------ Get the data via routine MULTINPT ---------------------
  70.  
  71.  TOFLD% = 1: FROMFLD% = 0      ' Enter form in field one ( TOFLD% =1 )
  72.                                ' Update all fields ( FROMFLD% = 0 )
  73. DO
  74.   '---------------------- For infoline at bottom of screen -----------------
  75.   '------------- All fields must be Auto-exit to use the infoline ----------
  76.  
  77.    SELECT CASE TOFLD%
  78.       CASE 1: IL$ = " Enter your name."
  79.       CASE 2: IL$ = " Enter your street address."
  80.       CASE 3: IL$ = " Enter your city."
  81.       CASE 4: IL$ = " Enter your state."
  82.       CASE 5: IL$ = " Enter your zip."
  83.       CASE 6: IL$ = " Enter birth date. FORMAT MUST = DD-MM-YYYY to exit field."
  84.       CASE 7, 8, 9: IL$ = " Enter your Social Security number"
  85.       CASE 10: IL$ = " Press ENTER or the SPACE bar to accept the data as shown."
  86.       CASE 11: IL$ = " Press ENTER or the SPACE bar to cancel."
  87.   END SELECT
  88.   CALL PRINTINFO(IL$ + "  TAB = Next field")
  89.  
  90.   '--------------------- Get the data via MULTINPT ------------------------
  91.  
  92.   ' "U" in MULTINPT - follow user defined field sequence ( order ).
  93.  
  94.   CALL MULTINPT(1, TOFLD%, "U", FROMFLD%, RKEY%, FIELDDATA$(), MOUSESEL%)
  95.  
  96.   WASERROR% = 0                        ' Assume all fields filled
  97.  
  98.    ' ---- Check for SPACE BAR pressed on button or mouse clicked on button
  99.  
  100.    IF RKEY% = 100 OR RKEY% = 32 THEN   ' 100 = mouse / 32 = SPACE BAR
  101.       IF TOFLD% = 10 THEN RKEY% = 13   ' OK button -- make same as ENTER
  102.       IF TOFLD% = 11 THEN RKEY% = 27   ' CANCEL button  -- make same as ESC
  103.    END IF
  104.  
  105.   ' ---- Check if ENTER pressed on Cancel button -------------------------
  106.  
  107.    IF FROMFLD% = 11 AND RKEY% = 13 THEN RKEY% = 27   ' make same as ESC
  108.  
  109.   ' ----- Check if ENTER was pressed or simulated -----------------------
  110.  
  111.    IF RKEY% = 13 THEN                ' ENTER pressed. Check for blank fields.
  112.       FOR X% = 1 TO 9                ' field one to 9.
  113.        IF FIELDDATA$(X%) = "" THEN   ' a field was blank.
  114.           CALL CUROFF
  115.           CALL GETANS("ERROR: BLANK FIELD  Press any key...", "", "", 100, 100, 15, 15, 41)
  116.           TOFLD% = X%                ' re-enter on blank field
  117.           WASERROR% = 1              ' flag for error
  118.           EXIT FOR
  119.        END IF
  120.       NEXT
  121.    END IF
  122.  
  123.   ' ----- Check if F1 pressed or mouse clicked on "[ F1=HELP ]" ---------
  124.   ' RKEY% = 1 for F1. "[ F1=HELP ]" is field 12
  125.  
  126.    IF RKEY% = 1 OR MOUSESEL% = 12 THEN
  127.       REDIM CH$(1), TXT$(3)
  128.       CH$(1) = "Ok"
  129.       TXT$(1) = " Enter data in all fields. Press ENTER"
  130.       TXT$(2) = " or click on <OK> to accept. Press ESC"
  131.       TXT$(3) = " or click on <Cancel> to abort........"
  132.       J% = CHOICEWIND%("@Help", TXT$(), CH$(), 100, 100, 15, 0, 1, 141)
  133.    END IF
  134.  
  135.    ' Exit LOOP if ENTER pressed or < OK > selected without error.
  136.    ' Exit LOOP if ESC pressed or <Cancel> selected.
  137.    
  138. LOOP WHILE (RKEY% <> 13 AND RKEY% <> 27) OR WASERROR% = 1
  139.  
  140. '---------------------------- Done ----------------------------------------
  141.  
  142. IF RKEY% = 13 THEN                      ' ENTER or < OK >
  143.   MESSAGE$ = "DATA ACCEPTED"
  144. ELSE                                    ' ESC or < Cancel >
  145.   MESSAGE$ = "TRANSACTION CANCELED"
  146. END IF
  147.  
  148. CALL GETANS(MESSAGE$ + "! Press any key.", "", "", 20, 100, 15, 15, 1)
  149.  
  150. CALL RSTRWIND(1, 1)                     ' Restore area under form.
  151.                                         ' Window #1 was used for form.
  152. END
  153.  
  154.