home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR9
/
VARFIL.ZIP
/
VARFIL02.CLA
< prev
next >
Wrap
Text File
|
1993-06-24
|
11KB
|
198 lines
MEMBER('VARFILES')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ VARFIL02.CLA - Internal Source Module ! ║
╚════════════════════════════════════════════════════════════════════════════╝
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ UpdateRolo - !Generated Procedure ║
╚════════════════════════════════════════════════════════════════════════════╝
UpdateRolo PROCEDURE
LOC:Message STRING(30)
Action BYTE
NoMoreFields BYTE(0) !No more fields flag
SCREEN SCREEN(12,56),PRE(SCR),SHADOW,FALL,CUA,COLOR(112)
!dimensions=25,80,25,80
ROW(1,1) STRING('█▀{54}█'),COLOR(116)
ROW(12,1) STRING('█▄{54}█'),COLOR(116)
REPEAT(10)
ROW(2,1) STRING('█'),COLOR(116)
ROW(2,56) STRING('█'),COLOR(116)
.
ROW(5,13) PROMPT('Last Name:'),COLOR(113,116,120,127,127)
COL(24) ENTRY(@s20),USE(Rol:Lastname),OVR,COLOR(126,7,120)
ROW(6,12) PROMPT('First Name:'),COLOR(113,116,120,127,127)
COL(24) ENTRY(@s15),USE(Rol:FirstName),OVR,COLOR(126,7,120)
ROW(7,10) PROMPT('Phone Number:'),COLOR(113,116,120,127,127)
COL(24) ENTRY(@P### ###-####P),USE(Rol:PhoneNumber),OVR,COLOR(126,7,120)
ROW(2,14) ENTRY(@s30),USE(LOC:Message),SKIP,COLOR(126,7,120)
ROW(9,12) BUTTON(' &Ok |'),SHADOW,KEY(EnterKey),USE(?Ok),REQ,COLOR(23,71,24,31,79)
COL(32) BUTTON(' &Cancel '),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(23,71,24,31,79)
.
SavePointer STRING(10) !Position of current record
AutoAddPtr STRING(10) !Position of Autoinc record
AutoIncAdd BYTE(0) !On for Autoincrement add
CODE
CheckOpen(Rolodex) !Ensure Primary file is OPEN
CASE KEYCODE() !What Key was pressed?
OF InsKey !Insert a new record
Action = AddRecord !Set action code 1 (ADD)
LOC:Message = CENTER(GLO:InsertMsg,SIZE(LOC:Message)) !Assign ADD message
CLEAR(Rol:Record) !CLEAR Record buffer
DO AutoNumber !Set autonumber key field(s)
OF EnterKey !Process a CHANGE request
OROF MouseLeft2 !on EnterKey or double mouse
Action = ChangeRecord !Set action code 2 (CHANGE)
LOC:Message = CENTER(GLO:ChangeMsg,SIZE(LOC:Message)) !Assign CHANGE message
OF DelKey !Process a DELETE request
Action = DeleteRecord !Set action code 3 (DELETE)
LOC:Message = CENTER(GLO:DeleteMsg,SIZE(LOC:Message)) !Assign DELETE message
SavePointer = POSITION(Rolodex) !Position in PRIMARY file
END !End CASE Keycode
OPEN(Screen) !Open the FORM screen
IF Action = DeleteRecord !IF request for DELETE
DISABLE(1,FIELDS()) !Disable all screen fields
ENABLE(?OK) !Enable the OK and the
ENABLE(?Cancel) !Cancel buttons
END !End IF request for delete
DISPLAY !Display screen fields
LOOP !Begin Main process loop
CASE SELECTED() !Process selected Field
OF NoMoreFields !User pressed Enter or OK
CASE Action !Process requested Action
OF AddRecord !Action = 1 (ADD)
ADD(Rolodex) !Add Record to Primary file
OF ChangeRecord !Action = 2 (Change)
PUT(Rolodex) !Write the Record
OF DeleteRecord !Action = 3 (Delete)
DELETE(Rolodex) !Delete this record
END !End CASE Action
IF ERRORCODE() !Error check on File I/O
IF ERRORCODE() = DupKeyErr ! Duplicate key detected
IF DUPLICATE(Rol:IdKey) !check unique keys
GLO:Message3 = '[ '
GLO:Message3 = Clip(GLO:Message3) & (' Rol:Id ')
GLO:Message3 = Clip(GLO:Message3)&' ]'
END
GLO:Message1 = 'This record creates a duplicate key entry'
GLO:Message2 = 'The unique key field(s) are listed below: '
ShowWarning !inform the user
SELECT(1) !select first field
DISPLAY !re-display the screen
CYCLE !back to main loop
END !End IF Duplicate errorcode
CASE Action !Error message based on Action
OF AddRecord
GLO:Message1 = 'Error attempting to ADD Record'
OF ChangeRecord
GLO:Message1 = 'Error attempting to CHANGE Record'
OF DeleteRecord
GLO:Message1 = 'Error attempting to DELETE Record'
END !End CASE Action
GLO:Message2 = 'The file: Rolodex could not be updated'
GLO:Message3 = 'Code:'&Errorcode()&': '&Error()
ShowWarning !Notify the user
DISABLE(1,FIELDS()) !Disable all the fields
ENABLE(?Cancel) !Enable Cancel button
SELECT(?Cancel) !and place cursor on Cancel
DISPLAY !Re-display the screen
CYCLE !Re-start main LOOP
ELSE !Else no errorcode()
BREAK !Break from main Loop
END !End IF Errorcode()
END !End CASE Selected()
ACCEPT !Enable screen entry
CASE FIELD() !Process fields
OF ?Ok !On the OK button
SELECT(1) !Start with the first field
SELECT !and cycle non-stop
CYCLE !restart main process loop
OF ?Cancel !On Cancel button
IF AutoIncAdd !ADDed autoincrement record?
RESET(Rolodex,AutoAddPtr) !Re-position record pointer
NEXT(Rolodex) !Re-read the record we added
IF DiskError('Could not READ Record') !Check for file I/O error
RETURN !Return to caller
END !End IF Diskerror
DELETE(Rolodex) !DELETE the record
IF DiskError('Record could not be Deleted')
RETURN !Return to caller
END !End IF Diskerror
END !End IF AutoIncAdd
BREAK !Break from main LOOP
END !End CASE FIELD
END !END MAIN PROCESS LOOP
AutoNumber Routine
LOOP !Loop for autonumbering
CLEAR(Rol:Id,1) !Clear Ascending to high value
SET(Rol:IdKey,Rol:IdKey) !For each autoincrement key
PREVIOUS(Rolodex) !Read last record (Ascending)
IF ERRORCODE() = BadRecErr !If Errorcode No Records
Rol:Id:AutoInc# = 1 !then start numbering at 1
ELSIF ERRORCODE() !On any other error
GLO:Message1 = 'Unable to READ keyed record'
GLO:Message2 = 'Cannot continue update....'
GLO:Message3 = 'Error: '&ERRORCODE() & ' ' & ERROR()
ShowWarning !Show user the error
RETURN !and return to caller
ELSE
Rol:Id:AutoInc# = Rol:Id + 1 !Save incremented value
END !End IF errorcode
CLEAR(Rol:Record) !CLEAR Record buffer
Rol:Id = Rol:Id:AutoInc# !Move the incremented value
ADD(Rolodex) !Add the record now
IF ERRORCODE() !Was there an error?
CASE ERRORCODE() !Process errors
OF DupKeyErr !Is it a duplicate key?
CYCLE !then try again
ELSE !Else
IF DiskError('Record could not be ADDed') !Check any other error
RETURN !Return to caller
END !End IF Diskerror
END !End CASE errorcode
ELSE !Else no error
BREAK !so BREAK Loop
END !End IF errorcode
END !End LOOP for Autonumbering
AutoIncAdd = 1 !Switch AutoIncAdd ON
AutoAddPtr = POSITION(Rolodex) !Save the record position
RESET(Rolodex,AutoAddPtr) !Position to record we added
HOLD(Rolodex,4) !Hold the record
NEXT(Rolodex) !and read it in to buffer
IF DiskError('Could not READ Record') !Check for I/O error
RETURN !And return to caller
END !End IF Diskerror
Action = ChangeRecord !Action is now change
EXIT !Exit the routine