home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / grafik / glib / mfeddemo.bas < prev    next >
Encoding:
BASIC Source File  |  1991-06-26  |  20.6 KB  |  683 lines
  1. '      FED - DEMO
  2. '  Version III - demonstrates the use of a LEVEL parameter
  3. '                to handle an entire record I/O in a loop and
  4. '                one or 2 MFed CALLS - NO GOTOs!!!!!
  5. '
  6. '                Note that Macros are not actually used, just the
  7. '                editting features of it.
  8. '
  9. '  Text input demo
  10. '  Demonstrates the use of MFed and several other GLib routines
  11. '
  12. '  Author: Gizmo Mike
  13. '  (C) InfoSoft, 1987, 1988, 1989
  14. '
  15.  
  16.  
  17. ' define named common block for most FED variables
  18. '
  19. DECLARE FUNCTION MFed% (ed$, fsiz%, Macro$())
  20. DECLARE FUNCTION ArgCnt%
  21. DECLARE FUNCTION ArgVar$ (which%)
  22. DECLARE FUNCTION NFrmat% (nst$, m%, p%)
  23. DECLARE FUNCTION DlrFrmat% (nst$, m%, p%)
  24.  
  25. COMMON SHARED /MFedVars/ fg%, bg%, fgd%, bgd%, Alarm%, bad$, editted%, hatch%, nums%, num$, upcase%, Mac%, RngLo#, RngHi#
  26.  
  27. DECLARE SUB SaveScrn (SEG arry%)
  28. DECLARE SUB RestScrn (SEG arry%)
  29.  
  30.  
  31.     CLEAR
  32.     DEFINT A-Z
  33.     OPTION BASE 1
  34.  
  35.     hatch = 176                         ' define hatching character
  36.     Mac = 0                             ' signal macros not used
  37.  
  38.  
  39.     TYPE structure                      ' set up employee structure
  40.        NName AS STRING * 25
  41.        Phone AS STRING * 8
  42.        Addr AS STRING * 25
  43.        City AS STRING * 10
  44.        State AS STRING * 2
  45.        Zip AS STRING * 5
  46.        Dept AS STRING * 6
  47.        Superv AS STRING * 12
  48.        PFreq AS STRING * 1
  49.        PRate AS SINGLE
  50.        PIN AS INTEGER
  51.     END TYPE
  52.  
  53.     DIM Emp AS structure             ' DIM emp as TYPE struct
  54.  
  55.     REDIM a$(11)                     ' temp holding for emp structures
  56.  
  57.     'make sure it is set up right
  58.     CLS : SOUND 750, 2: LOCATE 5, 5
  59.     PRINT "Depending on your display, you may want to restart this demo"
  60.     LOCATE 7, 5
  61.     PRINT "with the command line parameter [/CMD /NC] or [/CMD /C]. /NC for"
  62.     LOCATE 9, 5
  63.     PRINT "No Color, /C for color version."
  64.     LOCATE 13, 5
  65.     PRINT "Tap `S' to stop the demo, any other key to continue."
  66.  
  67.     GOSUB WaitKey
  68.  
  69.     IF ky$ = "S" OR ky$ = "s" THEN
  70.        SYSTEM
  71.     END IF
  72.  
  73.     '*********** get command line parms and set colors
  74.     q% = ArgCnt
  75.  
  76.     CMode = 1                           ' assume color
  77.     FOR x = 1 TO q
  78.     IF UCASE$(ArgVar$(x)) = "/NC" THEN
  79.         CMode = 0                   ' user wants no color
  80.         EXIT FOR
  81.     END IF
  82.     NEXT x
  83.  
  84.     IF CMode THEN                       ' find out if command line wants color
  85.     fg = 2: bg = 0                    ' general colors
  86.     fge = 12: bge = 3                 ' err message colors
  87.     fgw = 14: bgw = 4                 ' window colors
  88.     fgd = 10: bgd = 0                 ' data colors
  89.     fgh = 15: bgh = 1                 ' help colors
  90.     fgb = 4: bgb = 0                  ' box color
  91.     fgt = 3: bgt = 0                  ' text colors
  92.     ELSE
  93.     fg = 7: bg = 0
  94.     fge = 15: bge = 0
  95.     fgw = 0: bgw = 7
  96.     fgd = 15: bgd = 0
  97.     fgh = 7: bgh = 15
  98.     fgb = 15: bgb = 0
  99.     fgt = 7: bgt = 0
  100.     END IF
  101.  
  102.     eattr = (bge * 16) + fge              ' error message attributes
  103.     wattr = (bgw * 16) + fgw              ' window attributes
  104.     hattr = (bgh * 16) + fgh              ' help window attributes
  105.  
  106.     CALL WShadow(1)
  107.  
  108.     Adding = 0
  109.  
  110.     REM $DYNAMIC
  111.     REDIM Sarry(4000)                     ' dimension screen array for 2 screens
  112.  
  113.  
  114.     DIM hlp$(10)      ' String array to hold help screen msgs for use later.
  115.                   ' Has to be DIMmed in code prior to other references
  116.                   ' to hlp$().
  117.  
  118.     hlp$(1) = "Home - Start of line             End - End of line"
  119.     hlp$(2) = "  "
  120.     hlp$(3) = "Ctrl-X  Clear Field      Ctrl-End  Clear to end of line"
  121.     hlp$(4) = "Ctrl-U  Undo             <Arrows> Fwd, Bkwd 1 field "
  122.     hlp$(5) = "  "
  123.     hlp$(6) = "       PgUp / Ctrl PgUp - Jump to first field "
  124.     hlp$(7) = "       PgDn / Ctrl PgDn - Jump to last field  "
  125.     hlp$(8) = "  "
  126.     hlp$(9) = "[Esc] or [F9] Aborts Current Edit      [F10] Save Record"
  127.  
  128.     hlp$(10) = "[ Tap any key to continue ]"
  129.  
  130.  
  131.  
  132. prg.start:              '*************** start of program  *****************
  133.     GOSUB GenDisp                        ' put screen mask on screen
  134.     CALL SaveScrn(Sarry(1))                ' save it - RSTSCRN is quicker next time
  135.  
  136.     GOSUB OpenFil                        ' open the file
  137.  
  138.     IF hi = 0 THEN                       ' in case you lost the EMP.DAT file
  139.        GOSUB newfil
  140.     END IF
  141.     recno = hi                           ' get the top rec no
  142.  
  143.     GOSUB RecDisp                        ' display given record
  144.  
  145.  
  146. '----------------------------------------------------------------------------
  147. '  This is one big loop with several SELECT CASE constructs in it.
  148. '
  149. '  One CASE construct sets the level or a pointer to the field that we
  150. '  are currently editing.
  151. '
  152. '  Based on that level, another CASE construct sets the FED parameters
  153. '  for the next call.  ie if we are on level 2 (phone), then we need to
  154. '  set nums ON.
  155. '
  156. '  One other CASE block intercepts those fields that need further data
  157. '  verification and perfomrs that check.
  158. '
  159. '  The data is read from file into the TYPE structure and then stored
  160. '  in a string array for the level pointer indexing, then stored BACK
  161. '  to the TYPE structure for saving to disk.  You should not perform
  162. '  I/O directly on TYPE elements.
  163.  
  164. '  The random access file code contained here is pretty minimal - just
  165. '  enough to be able to demo FED.    In a "real" random file application,
  166. '  there are a number of things that should be done in the way of checking
  167. '  for valid data, also, there are  functions missing like to delete a
  168. '  record (missing because it does not lend itself to demoing FED or GLIB
  169. '  - this is not a QB tutor!).
  170. '  There ARE several other GLIB functions used:
  171. '  ERRMSG, DLRFRMAT, NFRMAT, WDW and a few others.
  172. '---------------------------------------------------------------------------
  173.  
  174.     level = 1                           ' indicates active FIELD in record
  175.     fsiz = 25                 ' first field siz
  176.     rx = 4                    ' input location
  177.     ry = 10
  178.     Alarm = 1                 ' beeper on
  179.     done = 0
  180.     REDIM Macro$(1)
  181.  
  182.     DO
  183.     LOCATE rx, ry                   ' locate current location
  184.     PRINT a$(level)                 ' print string
  185.     LOCATE rx, ry                   ' reset to SOS
  186.  
  187.     FCode = MFed(a$(level), fsiz, Macro$())
  188.     ' first, we want to intercept the 2 numeric inputs and
  189.     ' check them.  All validity checking would go here.
  190.  
  191.     SELECT CASE level
  192.         CASE 2                    ' check the phone
  193.         temp$ = a$(2)
  194.  
  195.         DO
  196.             m = 1: p = 0          ' m sets NFRMAT mode, p is useless here
  197.             errc = NFrmat(temp$, m, p)
  198.             IF m <> 1 THEN         '  something went wrong !!
  199.             ' tell them of error
  200.             CALL ERRMSG(temp$, 24, eattr%, 2)
  201.             temp$ = a$(2)
  202.             LOCATE rx, ry
  203.             FCode = MFed(a$(level), fsiz, Macro$())
  204.             END IF
  205.         LOOP UNTIL m = 1
  206.         a$(2) = temp$
  207.  
  208.         CASE 9
  209.         IF INSTR("HS", a$(9)) = 0 THEN
  210.             CALL ERRMSG("Pay Frequency code must be H or S only.", 24, eattr%, 2)
  211.             ret$ = " "
  212.             CALL GetCH("HS", ret$)   ' mask the input
  213.             a$(9) = ret$
  214.         END IF
  215.  
  216.         CASE 10
  217.         temp$ = a$(10)
  218.         DO
  219.             m = 0: p = 2        ' set up for dollar formatting call
  220.             errc = DlrFrmat(temp$, m%, p%)
  221.  
  222.             IF m <> 0 THEN                   ' if m is changed
  223.             CALL ERRMSG(temp$, 24, eattr, 2)
  224.             temp$ = a$(10)
  225.             LOCATE rx, ry
  226.             FCode = MFed(temp$, fsiz, Macro$())
  227.             END IF
  228.         LOOP UNTIL m = 0
  229.  
  230.         CASE ELSE
  231.     END SELECT
  232.  
  233.  
  234.  
  235.     SELECT CASE FCode                ' handle the exit return first
  236.         CASE 0, 2                    ' down = enter for this
  237.         level = level + 1
  238.  
  239.         ' "wrap" from last to first field
  240.         IF level > UBOUND(a$) THEN level = 1
  241.  
  242.  
  243.         CASE 1                       ' UP
  244.         IF level - 1 > 0 THEN
  245.             level = level - 1
  246.         END IF
  247.  
  248.         CASE 11                        ' F1 key pressed (HELP)
  249.         CALL SaveScrn(Sarry(2001))         ' save screen as is
  250.         CALL wdw(7, 12, 17, 72, 1, 1, 2, hattr, "Editting Help")
  251.  
  252.         FOR x = 1 TO 9                   ' pop help window up
  253.             CALL QPrint(hlp$(x), 7 + x, 14, hattr%)
  254.         NEXT x                           ' QUIKPRT help msgs
  255.         LOCATE 18, 30: COLOR fgh, bgh: PRINT hlp$(10)
  256.  
  257.         GOSUB WaitKey                    ' wait for any key
  258.         CALL RestScrn(Sarry(2001))        ' restore pre help screen
  259.  
  260.  
  261.         CASE 13, 14                          ' F3 page back a record. F$ = FORWARD
  262.         IF editted THEN                  ' they have changed something
  263.             CALL ERRMSG("You cannot PAGE until current edit is saved.", 24, eattr%, 2)
  264.         END IF
  265.  
  266.         IF FCode = 13 THEN
  267.             IF recno > 1 THEN recno = recno - 1      ' back up a record
  268.         ELSE
  269.             IF recno < hi THEN recno = recno + 1     ' forward a record
  270.         END IF
  271.  
  272.         CALL RestScrn(Sarry(1))           ' restore blank screen (bleed thru)
  273.         GOSUB RecDisp                    ' display desired record
  274.         level = 1                        ' set to start with name
  275.  
  276.  
  277.         CASE 17                                  ' F7 add a record
  278.         IF editted <> 0 THEN
  279.             CALL ERRMSG("Cannot ADD until current EDIT is saved.", 24, eattr, 2)
  280.         ELSE
  281.             IF Adding THEN           ' this is a toggle
  282.             Adding = 0
  283.             ELSE
  284.             Adding = 1
  285.             REDIM a$(11)         ' clear out what is in there
  286.             END IF
  287.         END IF
  288.  
  289.         IF Adding THEN
  290.             recno = hi + 1           ' increment record pointer
  291.  
  292.             CALL RestScrn(Sarry(1))   ' show input screen mask
  293.             GOSUB show.rec           ' display it
  294.  
  295.             ' change display to show how to STOP adding
  296.             COLOR fgt
  297.             LOCATE 19, 10: PRINT "[F1] - Help         [F7] - Stop Adding        [F10] - Save"
  298.             COLOR fg
  299.             SOUND 1500, .3
  300.             level = 1
  301.         ELSE
  302.             COLOR fgt
  303.             LOCATE 19, 10: PRINT "[F1] - Help         [F7] - Add record         [F10] - Save"
  304.             COLOR fg
  305.             SOUND 1500, .3      ' get their attention that F7
  306.                                 ' function changed
  307.             CLOSE
  308.             GOSUB OpenFil       ' get top record number
  309.             recno = hi
  310.             GOSUB RecDisp       ' display highest Record
  311.             level = 1
  312.         END IF
  313.  
  314.  
  315.         CASE 18                      ' F8 - quit demo
  316.         CLOSE
  317.         SYSTEM
  318.  
  319.  
  320.         CASE 9, 19                  ' F9, ESC
  321.         recno = 1                   ' this should have a "ARE YOU SURE"
  322.         level = 1
  323.         GOSUB RecDisp               ' prompt if it was more than demo
  324.                          
  325.         CASE 20                         ' F10 save record
  326.         GOSUB closefil              ' Put rec to file and close it
  327.         editted = 0                  ' reset the edit flag
  328.         GOSUB show.rec              ' show the new version
  329.         level = 1
  330.  
  331.  
  332.         CASE 3, 5                     'Pg Up or ^Pg Up
  333.         level = 1
  334.  
  335.         CASE 4, 6                     'Pg Dn or ^Pg Dn
  336.         level = UBOUND(a$)         ' set to edit LAST field
  337.  
  338.         CASE ELSE                        ' handles all other fed codes
  339.  
  340.     END SELECT
  341.  
  342.     nums = 0
  343.     upcase = 0
  344.  
  345.  
  346.     SELECT CASE level         ' now set FED variables/based on next field
  347.         CASE 1
  348.         rx = 4: ry = 10: fsiz = 25: upcase = 1
  349.  
  350.         CASE 2
  351.         rx = 4: ry = 57: fsiz = 8: nums = 1: num$ = "1234567890-"
  352.  
  353.         CASE 3
  354.         rx = 6: ry = 13: Alarm = 1: fsiz = 25
  355.  
  356.         CASE 4
  357.         rx = 8: ry = 10: Alarm = 1: fsiz = 10
  358.  
  359.         CASE 5
  360.         rx = 8: ry = 42: Alarm = 0: fsiz = 2
  361.  
  362.         CASE 6
  363.         rx = 8: ry = 60: Alarm = 0: fsiz = 5
  364.         nums = 1: num$ = "1234567890"
  365.  
  366.         CASE 7
  367.         rx = 12: ry = 16: Alarm = 1: fsiz = 6
  368.  
  369.         CASE 8
  370.         rx = 12: ry = 57: Alarm = 1: fsiz = 12
  371.  
  372.         CASE 9
  373.         rx = 14: ry = 41: Alarm = 1: fsiz = 1: nums = 1
  374.         num$ = "1234567890"
  375.  
  376.         CASE 10
  377.         rx = 14: ry = 70: Alarm = 0: fsiz = 6: nums = 1
  378.         num$ = "1234567890.$"
  379.  
  380.         CASE 11
  381.         rx = 16: ry = 17: Alarm = 0: fsiz = 4: nums = 1
  382.         num$ = "1234567890"
  383.  
  384.         CASE ELSE
  385.     END SELECT
  386.     LOOP UNTIL done
  387.  
  388.  
  389.  
  390.     SYSTEM
  391.  
  392. '================================[ SUBROUTINES ]==============================
  393.  
  394. OpenFil:         '-----------   open demo file statements  ---------
  395.     OPEN "emp.dat" FOR RANDOM AS #1 LEN = LEN(Emp)
  396.     sof = LOF(1) / LEN(Emp)               ' sof is number of records in file
  397.     hi = sof                              ' hi is high record number
  398. RETURN
  399.  
  400.  
  401. closefil:       '-------------   store the record ---------------
  402.     IF editted OR Adding THEN       'no need to save if not changed !
  403.        Emp.NName = a$(1)
  404.        Emp.Phone = a$(2)
  405.        Emp.Addr = a$(3)
  406.        Emp.City = a$(4)
  407.        Emp.State = a$(5)
  408.        Emp.Zip = a$(6)
  409.  
  410.        Emp.Dept = a$(7)
  411.        Emp.Superv = a$(8)
  412.        Emp.PFreq = a$(9)
  413.        Emp.PRate = VAL(a$(10))
  414.        Emp.PIN = VAL(a$(11))
  415.     END IF
  416.     PUT #1, recno, Emp                  ' move record to buffer
  417.     CLOSE #1                            ' actually put file to disk
  418.     GOSUB OpenFil                       ' open file again in updated state
  419.     editted = 0
  420. RETURN
  421.  
  422.  
  423.          '---------- put selected record to the screen  -----------
  424. RecDisp:
  425.                ' convert to memory variable to edit a COPY
  426.                ' of each and strip trailing blanks, assign to temp
  427.                ' array storage
  428.     GET #1, recno, Emp
  429.  
  430.     a$(1) = RTRIM$(Emp.NName)
  431.     a$(2) = RTRIM$(Emp.Phone)
  432.     a$(3) = RTRIM$(Emp.Addr)
  433.     a$(4) = RTRIM$(Emp.City)
  434.     a$(5) = RTRIM$(Emp.State)
  435.     a$(6) = RTRIM$(Emp.Zip)
  436.     a$(7) = RTRIM$(Emp.Dept)
  437.     a$(8) = RTRIM$(Emp.Superv)
  438.     a$(9) = RTRIM$(Emp.PFreq)
  439.  
  440.     a$(10) = LTRIM$(RTRIM$(STR$(Emp.PRate)))
  441.     errc = DlrFrmat(a$(10), 2, 0)
  442.  
  443.     a$(11) = LTRIM$(RTRIM$(STR$(Emp.PIN)))
  444.  
  445.  
  446.  
  447. show.rec:                  ' display the record
  448.     IF editted THEN                      ' This part is not critical,
  449.     COLOR bgb, fgb                 '  but shows user when current
  450.     LOCATE 1, 35                   '  record is different from data
  451.     PRINT " [ EDITING ] "          '  in file.
  452.     ELSE
  453.     COLOR fgb, bgb
  454.     LOCATE 1, 35
  455.     PRINT STRING$(15, 205);
  456.     END IF
  457.     COLOR fg, bg
  458.  
  459.  
  460.     COLOR fg, bg
  461.     LOCATE 4, 10: PRINT a$(1)
  462.     LOCATE 4, 57: PRINT a$(2)
  463.     LOCATE 6, 13: PRINT a$(3)
  464.     LOCATE 8, 10: PRINT a$(4)
  465.     LOCATE 8, 42: PRINT a$(5)
  466.     LOCATE 8, 60: PRINT a$(6)
  467.  
  468.     LOCATE 12, 16: PRINT a$(7)
  469.     LOCATE 12, 57: PRINT a$(8)
  470.     LOCATE 14, 41: PRINT a$(9)
  471.     LOCATE 14, 70: PRINT a$(10)
  472.     LOCATE 16, 17: PRINT STRING$(4, 254)
  473.     LOCATE 16, 71: COLOR fgw, 0: PRINT recno%
  474.     COLOR fg, bg
  475.     editted = 0        ' set edit flag to show that record on screen is same as file
  476.  
  477. RETURN
  478.  
  479.  
  480.  
  481. GenDisp:
  482. '---------------------------------------------------------------------------
  483. '*  Routine to put general display on the screen, this is used once.  After
  484. '*  it is put to the screen, it is saved via SVSCRN, and restored from there
  485. '*  rather than doing all these PRINTs again.                  
  486. '---------------------------------------------------------------------------
  487.  
  488.     CALL boxes(1, 1, 25, 80, 1, fgb)           ' put a big box on screen
  489.     COLOR fgt + 8
  490.     LOCATE 2, 25: PRINT "XYZ Corporation Employee Data File"      ' a title
  491.     COLOR fgt
  492.     LOCATE 4, 4: PRINT "Name: "
  493.     LOCATE 4, 50: PRINT "Phone: "
  494.     LOCATE 6, 4: PRINT "Address: "
  495.     LOCATE 8, 4: PRINT "City: "
  496.     LOCATE 8, 35: PRINT "State: "
  497.     LOCATE 8, 55: PRINT "Zip: "
  498.     LOCATE 12, 4: PRINT "Department: "
  499.     LOCATE 12, 45: PRINT "Supervisor: "
  500.     LOCATE 14, 4: PRINT "Hourly / Salary Level (H or S only): "
  501.     LOCATE 14, 60: PRINT "Pay Rate: "
  502.     LOCATE 16, 55: PRINT "Record Number: ";
  503.  
  504.  
  505.     LOCATE 16, 4: PRINT "4 Digit PIN: "
  506.     COLOR 4, 0: LOCATE 17, 1: PRINT CHR$(199) + STRING$(78, 196) + CHR$(182)
  507.     COLOR fgt + 8: LOCATE 18, 30: PRINT "Editing Keys:": COLOR fgt
  508.  
  509.     LOCATE 19, 10: PRINT "[F1] - Help         [F7] - Add Record         [F10] - Save"
  510.     LOCATE 20, 10: PRINT "[F3] - Page back one record   [F4] - Page forward one record"
  511.     LOCATE 21, 10: PRINT "       [F8] - Quit                   [F9] - Abort Edit"
  512.     LOCATE 22, 10: PRINT "[Enter] - Advances a field.   [PgDn] - Jump to last field"
  513.     LOCATE 23, 5: PRINT "[PgUp] - Jump to first field   <Arrow Keys> Advance or back up one field."
  514.  
  515.   RETURN
  516.  
  517.  
  518.  
  519. newfil:       '---------------- make a new file if demo one got lost  -------
  520.    a$(1) = "JIM LOTUS"
  521.    a$(2) = "555-0123"
  522.    a$(3) = "1432 OAK STREET"
  523.    a$(4) = "CENTERVILE"
  524.    a$(5) = "MA"
  525.    a$(6) = "01234"
  526.    a$(7) = "EXEC."
  527.    a$(8) = "NONE"
  528.    a$(9) = "S"
  529.    a$(10) = "900.00"
  530.    a$(11) = "1234"
  531.  
  532.    recno = 1
  533.    editted = 1
  534.    GOSUB closefil
  535. RETURN
  536.  
  537. WaitKey:             '--------loop until a key is pressed - handy to have
  538.     ky$ = INPUT$(1)
  539. RETURN
  540.  
  541. EditMac:
  542.     ' sample sub routine to edit a macro defintition on the fly.
  543.     ' Using one of the MFed 'soft keys' like a function key, open
  544.     ' a window or otherwise ask the user to press the key combination
  545.     ' they want to change.
  546.     '
  547.     ' On entry, that captured combination should be in MacEd$
  548.     ' MacLen should be the maximum legal length of the Macro
  549.  
  550.     MacErr = 0                          ' clear any previous error
  551.     IF LEN(MacEd$) = 2 THEN             ' check for valid extended key combo
  552.     MacEd = ASC(RIGHT$(MacEd$, 1))
  553.  
  554.     SELECT CASE MacEd
  555.         CASE 1 TO 10, 15 TO 23, 29 TO 35
  556.         CASE ELSE
  557.         MacErr = 1              ' unsupported extended stroke
  558.     END SELECT
  559.     ELSE
  560.     MacErr = 1
  561.     END IF
  562.  
  563.     IF MacErr THEN
  564.     ' insert your error handler here for invalid
  565.     ' key combo pressed
  566.     END IF
  567.  
  568.     OldMac = Mac                        ' save old Mac setting
  569.     Mac = 0                             ' disable for now
  570.     mtemp$ = Macro$(MacEd)
  571.     MFCode = MFed(mtemp$, MacLen, Macro$())
  572.  
  573.     IF MFCode <> 15 THEN                ' esc does not save new defintition
  574.     Macro$(MacEd) = temp$
  575.     END IF
  576.  
  577.     ' your real program should also ask if they want to save the new
  578.     ' defintition, and if so, you could write back to disk using SaveMac
  579.  
  580. REM $STATIC
  581. SUB EditMac (MacEd$, MacLen%, Macro$())
  582.     ' sample sub routine to edit a macro defintition on the fly.
  583.     ' Using one of the MFed 'soft keys' like a function key, open
  584.     ' a window or otherwise ask the user to press the key combination
  585.     ' they want to change.
  586.     '
  587.     ' On entry, that captured combination should be in MacEd$
  588.     ' MacLen should be the maximum legal length of the Macro
  589.  
  590.     IF LEN(MacEd$) = 2 THEN             ' check for valid extended key combo
  591.     MacEd = ASC(RIGHT$(MacEd$, 1))
  592.  
  593.     SELECT CASE MacEd
  594.         CASE 1 TO 10, 15 TO 23, 29 TO 35
  595.         MacErr = 0              ' clear any previous error
  596.  
  597.         CASE ELSE
  598.         MacErr = 1              ' unsupported extended stroke
  599.     END SELECT
  600.     ELSE
  601.     MacErr = 1
  602.     END IF
  603.  
  604.     IF MacErr THEN
  605.     ' insert your error handler here for invalid
  606.     ' key combo pressed
  607.     END IF
  608.  
  609.     OldMac = Mac                        ' save old Mac setting
  610.     Mac = 0                             ' disable for now
  611.     mtemp$ = Macro$(MacEd)
  612.     MFCode = MFed(mtemp$, MacLen, Macro$())
  613.  
  614.     IF MFCode <> 15 THEN                ' esc does not save new defintition
  615.     Macro$(MacEd) = temp$
  616.     END IF
  617.  
  618.     ' your real program should also ask if they want to save the new
  619.     ' defintition, and if so, you could write back to disk using SaveMac
  620.  
  621.     ' also maybe restore the screen from the Macro edit I/O
  622.  
  623.  
  624. END SUB
  625.  
  626. SUB MacRead (MacFil$, Macro$())
  627.     ' this sample sub rotuine demonstates how you can read a macro
  628.     ' file into the Macro array.
  629.     '
  630.     ' Enter with MacFil$ holding the name of the disk file holding the
  631.     ' macro defintitions.  Of course, the macros could be hard coded
  632.     ' into the program but flexibility to allow the user to unload and
  633.     ' reload new defintitions is lost (as might be required in sophisticated
  634.     ' database programs where common city names can be loaded for specific
  635.     ' states).
  636.  
  637.     m = FREEFILE                        ' request a file number
  638.     REDIM Macro$(1 TO 35)               ' set up array, removing old defs
  639.     OPEN MacFil$ FOR INPUT AS #m
  640.  
  641.     FOR x = 1 TO 10                     ' read defs for Alt-Q to Alt-P
  642.     LINE INPUT #m, Macro$(x)
  643.     NEXT x
  644.  
  645.     FOR x = 15 TO 23                     ' read defs for Alt-A to Alt-L
  646.     LINE INPUT #m, Macro$(x)
  647.     NEXT x
  648.  
  649.     FOR x = 29 TO 35                     ' read defs for Alt-Z to Alt-M
  650.     LINE INPUT #m, Macro$(x)
  651.     NEXT x
  652.  
  653.     CLOSE #m
  654.  
  655. END SUB
  656.  
  657. SUB MacWrite (Macro$(), MacFil$)
  658.     ' this sample sub rotuine demonstates how you can write a macro array
  659.     ' to a disk file.  This may be needed after editting a macro on the fly.
  660.     '
  661.     ' Enter with MacFil$ holding the name of the disk file to write to,
  662.  
  663.     m = FREEFILE                        ' request a file number
  664.     OPEN MacFil$ FOR OUTPUT AS #m
  665.  
  666.     FOR x = 1 TO 10                     ' write defs for Alt-Q to Alt-P
  667.     PRINT #m, Macro$(x)
  668.     NEXT x
  669.  
  670.     FOR x = 15 TO 23                    ' write defs for Alt-A to Alt-L
  671.     PRINT #m, Macro$(x)
  672.     NEXT x
  673.  
  674.     FOR x = 29 TO 35                    ' write defs for Alt-Z to Alt-M
  675.     PRINT #m, Macro$(x)
  676.     NEXT x
  677.  
  678.     CLOSE #m
  679.  
  680.  
  681. END SUB
  682.  
  683.