home *** CD-ROM | disk | FTP | other *** search
/ High Voltage Shareware / high1.zip / high1 / DIR9 / VARFIL.ZIP / VARFIL02.CLA < prev    next >
Text File  |  1993-06-24  |  11KB  |  198 lines
  1.                 MEMBER('VARFILES')
  2. OMIT('╝')
  3. ╔════════════════════════════════════════════════════════════════════════════╗
  4. ║   VARFIL02.CLA - Internal Source Module        !                           ║
  5. ╚════════════════════════════════════════════════════════════════════════════╝
  6.  
  7. OMIT('╝')
  8. ╔════════════════════════════════════════════════════════════════════════════╗
  9. ║ UpdateRolo -                                   !Generated Procedure        ║
  10. ╚════════════════════════════════════════════════════════════════════════════╝
  11. UpdateRolo      PROCEDURE
  12.  
  13. LOC:Message      STRING(30)
  14. Action           BYTE
  15. NoMoreFields     BYTE(0)                         !No more fields flag
  16. SCREEN           SCREEN(12,56),PRE(SCR),SHADOW,FALL,CUA,COLOR(112)
  17.                    !dimensions=25,80,25,80
  18.                    ROW(1,1)    STRING('█▀{54}█'),COLOR(116)
  19.                    ROW(12,1)   STRING('█▄{54}█'),COLOR(116)
  20.                                REPEAT(10)
  21.                    ROW(2,1)      STRING('█'),COLOR(116)
  22.                    ROW(2,56)     STRING('█'),COLOR(116)
  23.                                .
  24.                    ROW(5,13)   PROMPT('Last Name:'),COLOR(113,116,120,127,127)
  25.                      COL(24)   ENTRY(@s20),USE(Rol:Lastname),OVR,COLOR(126,7,120)
  26.                    ROW(6,12)   PROMPT('First Name:'),COLOR(113,116,120,127,127)
  27.                      COL(24)   ENTRY(@s15),USE(Rol:FirstName),OVR,COLOR(126,7,120)
  28.                    ROW(7,10)   PROMPT('Phone Number:'),COLOR(113,116,120,127,127)
  29.                      COL(24)   ENTRY(@P### ###-####P),USE(Rol:PhoneNumber),OVR,COLOR(126,7,120)
  30.                    ROW(2,14)   ENTRY(@s30),USE(LOC:Message),SKIP,COLOR(126,7,120)
  31.                    ROW(9,12)   BUTTON('  &Ok  |'),SHADOW,KEY(EnterKey),USE(?Ok),REQ,COLOR(23,71,24,31,79)
  32.                      COL(32)   BUTTON('  &Cancel  '),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(23,71,24,31,79)
  33.                  .
  34.  
  35. SavePointer   STRING(10)                         !Position of current record
  36. AutoAddPtr    STRING(10)                         !Position of Autoinc record
  37. AutoIncAdd    BYTE(0)                            !On for Autoincrement add
  38.  
  39.   CODE
  40.  
  41.   CheckOpen(Rolodex)                             !Ensure Primary file is OPEN
  42.   CASE KEYCODE()                                 !What Key was pressed?
  43.     OF InsKey                                    !Insert a new record
  44.  
  45.       Action = AddRecord                         !Set action code 1 (ADD)
  46.       LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message)) !Assign ADD message
  47.       CLEAR(Rol:Record)                          !CLEAR Record buffer
  48.       DO AutoNumber                              !Set autonumber key field(s)
  49.  
  50.     OF EnterKey                                  !Process a CHANGE request
  51.     OROF MouseLeft2                              !on EnterKey or double mouse
  52.  
  53.       Action = ChangeRecord                      !Set action code 2 (CHANGE)
  54.       LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message)) !Assign CHANGE message
  55.  
  56.     OF DelKey                                    !Process a DELETE request
  57.  
  58.       Action = DeleteRecord                      !Set action code 3 (DELETE)
  59.       LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message)) !Assign DELETE message
  60.       SavePointer = POSITION(Rolodex)            !Position in PRIMARY file
  61.  
  62.   END                                            !End CASE Keycode
  63.  
  64.   OPEN(Screen)                                   !Open the FORM screen
  65.   IF Action = DeleteRecord                       !IF request for DELETE
  66.     DISABLE(1,FIELDS())                          !Disable all screen fields
  67.     ENABLE(?OK)                                  !Enable the OK and the
  68.     ENABLE(?Cancel)                              !Cancel buttons
  69.   END                                            !End IF request for delete
  70.   DISPLAY                                        !Display screen fields
  71.  
  72.   LOOP                                           !Begin Main process loop
  73.  
  74.     CASE SELECTED()                              !Process selected Field
  75.       OF NoMoreFields                            !User pressed Enter or OK
  76.         CASE Action                              !Process requested Action
  77.           OF AddRecord                           !Action = 1 (ADD)
  78.  
  79.             ADD(Rolodex)                         !Add Record to Primary file
  80.  
  81.           OF ChangeRecord                        !Action = 2 (Change)
  82.  
  83.             PUT(Rolodex)                         !Write the Record
  84.  
  85.           OF DeleteRecord                        !Action = 3 (Delete)
  86.  
  87.             DELETE(Rolodex)                     !Delete this record
  88.         END                                      !End CASE Action
  89.  
  90.       IF ERRORCODE()                             !Error check on File I/O
  91.         IF ERRORCODE() = DupKeyErr               ! Duplicate key detected
  92.           IF DUPLICATE(Rol:IdKey)                !check unique keys
  93.             GLO:Message3 = '[ '
  94.             GLO:Message3 = Clip(GLO:Message3) & (' Rol:Id ')
  95.             GLO:Message3 = Clip(GLO:Message3)&' ]'
  96.           END
  97.           GLO:Message1 = 'This record creates a duplicate key entry'
  98.           GLO:Message2 = 'The unique key field(s) are listed below: '
  99.           ShowWarning                            !inform the user
  100.           SELECT(1)                              !select first field
  101.           DISPLAY                                !re-display the screen
  102.           CYCLE                                  !back to main loop
  103.         END                                      !End IF Duplicate errorcode
  104.         CASE Action                              !Error message based on Action
  105.           OF AddRecord
  106.             GLO:Message1 = 'Error attempting to ADD Record'
  107.           OF ChangeRecord
  108.             GLO:Message1 = 'Error attempting to CHANGE Record'
  109.           OF DeleteRecord
  110.             GLO:Message1 = 'Error attempting to DELETE Record'
  111.         END                                      !End CASE Action
  112.         GLO:Message2 = 'The file: Rolodex could not be updated'
  113.         GLO:Message3 = 'Code:'&Errorcode()&': '&Error()
  114.         ShowWarning                              !Notify the user
  115.         DISABLE(1,FIELDS())                      !Disable all the fields
  116.         ENABLE(?Cancel)                          !Enable Cancel button
  117.         SELECT(?Cancel)                          !and place cursor on Cancel
  118.         DISPLAY                                  !Re-display the screen
  119.         CYCLE                                    !Re-start main LOOP
  120.       ELSE                                       !Else no errorcode()
  121.         BREAK                                    !Break from main Loop
  122.       END                                        !End IF Errorcode()
  123.  
  124.     END                                          !End CASE Selected()
  125.  
  126.     ACCEPT                                       !Enable screen entry
  127.  
  128.     CASE FIELD()                                 !Process fields
  129.       OF ?Ok                                     !On the OK button
  130.  
  131.         SELECT(1)                                !Start with the first field
  132.         SELECT                                   !and cycle non-stop
  133.         CYCLE                                    !restart main process loop
  134.  
  135.       OF ?Cancel                                 !On Cancel button
  136.  
  137.         IF AutoIncAdd                            !ADDed autoincrement record?
  138.           RESET(Rolodex,AutoAddPtr)              !Re-position record pointer
  139.           NEXT(Rolodex)                          !Re-read the record we added
  140.           IF DiskError('Could not READ Record')  !Check for file I/O error
  141.             RETURN                               !Return to caller
  142.           END                                    !End IF Diskerror
  143.           DELETE(Rolodex)                        !DELETE the record
  144.           IF DiskError('Record could not be Deleted')
  145.             RETURN                               !Return to caller
  146.           END                                    !End IF Diskerror
  147.         END                                      !End IF AutoIncAdd
  148.         BREAK                                    !Break from main LOOP
  149.     END                                          !End CASE FIELD
  150.  
  151.   END                                            !END MAIN PROCESS LOOP
  152.  
  153.  
  154. AutoNumber Routine
  155.   LOOP                                           !Loop for autonumbering
  156.    CLEAR(Rol:Id,1)                               !Clear Ascending to high value
  157.    SET(Rol:IdKey,Rol:IdKey)                      !For each autoincrement key
  158.    PREVIOUS(Rolodex)                             !Read last record (Ascending)
  159.    IF ERRORCODE() = BadRecErr                    !If Errorcode No Records
  160.      Rol:Id:AutoInc# = 1                         !then start numbering at 1
  161.    ELSIF ERRORCODE()                             !On any other error
  162.        GLO:Message1 = 'Unable to READ keyed record'
  163.        GLO:Message2 = 'Cannot continue update....'
  164.        GLO:Message3 = 'Error: '&ERRORCODE() & ' ' & ERROR()
  165.        ShowWarning                               !Show user the error
  166.        RETURN                                    !and return to caller
  167.    ELSE
  168.      Rol:Id:AutoInc# = Rol:Id + 1                !Save incremented value
  169.    END                                           !End IF errorcode
  170.    CLEAR(Rol:Record)                             !CLEAR Record buffer
  171.    Rol:Id = Rol:Id:AutoInc#                      !Move the incremented value
  172.    ADD(Rolodex)                                  !Add the record now
  173.    IF ERRORCODE()                                !Was there an error?
  174.      CASE ERRORCODE()                            !Process errors
  175.        OF DupKeyErr                              !Is it a duplicate key?
  176.         CYCLE                                    !then try again
  177.        ELSE                                      !Else
  178.          IF DiskError('Record could not be ADDed') !Check any other error
  179.           RETURN                                 !Return to caller
  180.        END                                       !End IF Diskerror
  181.      END                                         !End CASE errorcode
  182.    ELSE                                          !Else no error
  183.      BREAK                                       !so BREAK Loop
  184.    END                                           !End IF errorcode
  185.   END                                            !End LOOP for Autonumbering
  186.   AutoIncAdd = 1                                 !Switch AutoIncAdd ON
  187.   AutoAddPtr = POSITION(Rolodex)                 !Save the record position
  188.   RESET(Rolodex,AutoAddPtr)                      !Position to record we added
  189.   HOLD(Rolodex,4)                                !Hold the record
  190.   NEXT(Rolodex)                                  !and read it in to buffer
  191.   IF DiskError('Could not READ Record')          !Check for I/O error
  192.     RETURN                                       !And return to caller
  193.   END                                            !End IF Diskerror
  194.   Action = ChangeRecord                          !Action is now change
  195.   EXIT                                           !Exit the routine
  196.  
  197.  
  198.