home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
High Voltage Shareware
/
high1.zip
/
high1
/
DIR9
/
VARFIL.ZIP
/
VARFIL01.CLA
< prev
next >
Wrap
Text File
|
1993-06-24
|
22KB
|
428 lines
MEMBER('VARFILES')
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ VARFIL01.CLA - Internal Source Module ! ║
╚════════════════════════════════════════════════════════════════════════════╝
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ Mainmenu - !Generated Procedure ║
╚════════════════════════════════════════════════════════════════════════════╝
Mainmenu PROCEDURE
SCREEN SCREEN(17,38),PRE(SCR),CENTER,SHADOW,ZOOM,CUA,COLOR(112)
!dimensions=25,80,25,80
ROW(1,1) STRING('█▀{36}█'),COLOR(113)
ROW(17,1) STRING('█▄{36}█'),COLOR(113)
REPEAT(15)
ROW(2,1) STRING('█'),COLOR(113)
ROW(2,38) STRING('█'),COLOR(113)
.
ROW(6,12) BUTTON(' &View Rolodex '),SHADOW,USE(?View_Rolodex),COLOR(23,71,24,31,79)
ROW(9,10) BUTTON(' &Select User File '),SHADOW,USE(?Select_User_File),COLOR(23,71,24,31,79)
ROW(15,16) BUTTON(' E&xit |'),SHADOW,USE(?Exit),COLOR(23,71,24,31,79)
.
EMBED('~~Mainmenu~1~Data Section~1~~')
opening SCREEN(25,80),PRE(ope),CENTER,FADE,CUA,COLOR(113)
!dimensions=25,80,25,80
.
ENDEMBED
CODE
EMBED('~~Mainmenu~1~Setup Procedure~3~~')
Open(Opening)
loop
If Glo:RoloFile <> '' then Break.
GetUser
.
ENDEMBED
OPEN(Screen) !Open the screen
LOOP !Loop through screen fields
DISPLAY
CASE SELECTED() !Jump to field setup routine
END !End CASE
ACCEPT !Enable mouse and keyboard
CASE KEYCODE()
END
CASE FIELD() !Jump to field edit routine
OF ?View_Rolodex !Edit field
BrowseRolo
OF ?Select_User_File !Edit field
GetUser
OF ?Exit !Edit field
RETURN
END !End CASE
END !End LOOP
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ GetUser - !Generated Procedure ║
╚════════════════════════════════════════════════════════════════════════════╝
GetUser PROCEDURE
Queue QUEUE
STRING(40)
END
ButtonIsDisabled BYTE !Flag to allow button enable
SCREEN SCREEN(25,46),PRE(SCR),CUA,COLOR(112)
!dimensions=25,80,25,80
ROW(1,1) STRING('█▀{44}█'),COLOR(113)
ROW(3,7) STRING('Select A User from the List Below'),COLOR(113)
ROW(25,1) STRING('█▄{44}█'),COLOR(113)
REPEAT(23)
ROW(2,1) STRING('█'),COLOR(113)
ROW(2,46) STRING('█'),COLOR(113)
.
ROW(6,16) LIST(10,16),FROM(Queue),USE(?List),IMM,COLOR(48,15,120)
ROW(20,8) BUTTON(' &Insert |'),SHADOW,KEY(InsKey),USE(?Insert),COLOR(23,71,24,31,79)
COL(19) BUTTON(' &Change |'),SHADOW,USE(?Change),COLOR(23,71,24,31,79)
COL(30) BUTTON(' &Delete |'),SHADOW,KEY(DelKey),USE(?Delete),COLOR(23,71,24,31,79)
ROW(23,13) BUTTON(' &Select |'),SHADOW,KEY(EnterKey),USE(?Select),COLOR(23,71,24,31,79)
COL(26) BUTTON(' &Cancel |'),SHADOW,KEY(EscKey),USE(?Cancel),COLOR(23,71,24,31,79)
.
CODE
CheckOpen(Users) !Ensure Users file is open
OPEN(Screen) !Open the screen
BeginBrowse(?List) !Begin a browse session
LOOP !Process browse requests
CASE BrowseAction(Users,Use:UserKey,Queue) !Browse the file
OF FormatQueue !Format a QUEUE element
Queue = ' ' & FORMAT(Use:Username,@s12) !Format the QUEUE line
OF ProcessField !Process a field
CASE FIELD() !Jump to edit routine
OF ?List !Process the list field
CASE KEYCODE() !Jump to keycode routine
OF InsKey !For the insert key
GET(Users,0) !Dereference current record
Do UpdateProcedure ! Call the update procedure
OF CtrlEnter !Or the Ctrl-Enter key
Do UpdateProcedure ! Call the update procedure
OF MouseLeft2 !On mouse double click
OROF EnterKey !or the enter key
SELECT(?Select) ! Select the Select button
PRESS(EnterKey) ! And complete it.
END !End CASE
OF ?Insert !Process the Insert Button
GET(Users,0)
SETKEYCODE(InsKey) !Set action to Insert
Do UpdateProcedure ! Call the update procedure
SELECT(?List) !Reselect the List field
OF ?Change !Process the Change Button
SETKEYCODE(EnterKey) !Set action to Change
Do UpdateProcedure ! Call the update procedure
SELECT(?List) !Reselect the List field
OF ?Select !Process the Select button
EMBED('~~GetUser~4~5~9~~')
Glo:RoloFile = Use:FileName
ENDEMBED !Select button Edit Routine
BREAK
OF ?Cancel !Process the Select button
BREAK
END !End CASE FIELD()
OF NoRecords !No records to browse
DISPLAY
DISABLE(?Change) ! Disable the change button
DISABLE(?Delete) ! Disable the delete button
ButtonIsDisabled = TRUE
IF RECORDS(Users) !If file is not empty
IF ?List <> 1 ! And list is not first
SELECT(1) ! Select the first field
ELSE ! From the first field
SELECT(?Insert) ! Select the Insert Button
END ! End IF
ELSE !If file is empty
GET(Users,0) ! Dereference current record
SETKEYCODE(InsKey) ! Ask for a new record
Do UpdateProcedure ! Call the update procedure
IF RECORDS(Users) = 0 ! If a record was not added
BREAK
END ! End IF
END !End IF
END !End CASE
END !End LOOP
EndBrowse !End the browse session
FREE(Queue) !Free the Queue memory
UpdateProcedure ROUTINE
UpdateUser
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ UpdateUser - !Generated Procedure ║
╚════════════════════════════════════════════════════════════════════════════╝
UpdateUser PROCEDURE
LOC:Message STRING(30)
Action BYTE
NoMoreFields BYTE(0) !No more fields flag
SCREEN SCREEN(13,58),PRE(SCR),SHADOW,FALL,CUA,COLOR(112)
!dimensions=25,80,25,80
ROW(1,1) STRING('█▀{56}█'),COLOR(116)
ROW(13,1) STRING('█▄{56}█'),COLOR(116)
REPEAT(11)
ROW(2,1) STRING('█'),COLOR(116)
ROW(2,58) STRING('█'),COLOR(116)
.
ROW(2,17) ENTRY(@s30),USE(LOC:Message),SKIP,COLOR(126,7,120)
ROW(5,7) PROMPT('User Name:'),COLOR(113,116,120,127,127)
COL(18) ENTRY(@s12),USE(Use:Username),REQ,OVR,COLOR(126,7,120)
ROW(7,7) PROMPT('File Name:'),COLOR(113,116,120,127,127)
COL(18) ENTRY(@s35),USE(Use:FileName),REQ,OVR,COLOR(126,7,120)
ROW(10,15) BUTTON(' &Ok |'),SHADOW,KEY(EnterKey),USE(?Ok),REQ,COLOR(23,71,24,31,79)
COL(35) 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(Users) !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(Use:Record) !CLEAR Record buffer
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(Users) !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(Users) !Add Record to Primary file
OF ChangeRecord !Action = 2 (Change)
PUT(Users) !Write the Record
OF DeleteRecord !Action = 3 (Delete)
DELETE(Users) !Delete this record
END !End CASE Action
IF ERRORCODE() !Error check on File I/O
IF ERRORCODE() = DupKeyErr ! Duplicate key detected
IF DUPLICATE(Use:UserKey) !check unique keys
GLO:Message3 = '[ '
GLO:Message3 = Clip(GLO:Message3) & (' Use:Username ')
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: Users 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
BREAK !Break from main LOOP
END !End CASE FIELD
END !END MAIN PROCESS LOOP
OMIT('╝')
╔════════════════════════════════════════════════════════════════════════════╗
║ BrowseRolo - !Generated Procedure ║
╚════════════════════════════════════════════════════════════════════════════╝
BrowseRolo PROCEDURE
Queue QUEUE
STRING(74)
.
ButtonIsDisabled BYTE !Flag to allow button enable
SCREEN SCREEN(19,74),PRE(SCR),CENTER,EXPAND(10),ZOOM,CUA,COLOR(112)
!dimensions=25,80,25,80
ROW(1,1) STRING('█▀{72}█'),COLOR(113)
ROW(2,22) STRING('Rolodex List For :')
ROW(19,1) STRING('█▄{72}█'),COLOR(113)
REPEAT(17)
ROW(2,1) STRING('█'),COLOR(113)
ROW(2,74) STRING('█'),COLOR(113)
.
ROW(5,9) LIST(10,58),FROM(Queue),USE(?List),IMM,COLOR(48,15,120)
ROW(2,41) ENTRY(@s12),USE(Use:Username),REQ,OVR,SKIP,COLOR(126,7,120)
ROW(17,8) BUTTON(' &Insert |'),SHADOW,USE(?Insert),COLOR(23,71,24,31,79)
COL(22) BUTTON(' &Change |'),SHADOW,USE(?Change),COLOR(23,71,24,31,79)
COL(36) BUTTON(' &Delete |'),SHADOW,USE(?Delete),COLOR(23,71,24,31,79)
COL(60) BUTTON(' E&xit |'),SHADOW,KEY(EscKey),USE(?Exit),COLOR(23,71,24,31,79)
.
CODE
CheckOpen(Rolodex) !Ensure Rolodex file is open
FREE(Queue) !Make sure Queue is empty
OPEN(Screen) !Open the screen
EMBED('~~BrowseRolo~1~Setup Screen~3~~')
Display(?use:username)
ENDEMBED
BeginBrowse(?List) !Begin a browse session
LOOP !Process browse requests
CASE BrowseAction(Rolodex,Rol:NameKey,Queue) !Browse the file
OF FormatQueue !Format a queue element
Queue = ' ' & FORMAT(Rol:FirstName,@s15) & |
' ' & FORMAT(Rol:Lastname,@s20) & |
' ' & FORMAT(Rol:PhoneNumber,@P### ###-####P) !Format the listbox queue
OF ProcessField !Process a field
IF SELECTED() <> FIELD() ! If a new field is selected
CASE SELECTED() ! Jump to setup routine
END ! End CASE SELECTED()
END ! End IF
CASE FIELD() !Jump to edit routine
OF ?List !Process the list field
CASE KEYCODE() ! Jump to keycode routine
OF InsKey ! For the insert key
GET(Rolodex,0) ! Dereference current record
DO UpdateProcedure ! Call the update procedure
OF DelKey ! For the delete key
DO UpdateProcedure ! Call the update procedure
OF EnterKey ! Or the enter key
OROF MouseLeft2 ! Or a double mouse click
DO UpdateProcedure ! Call the update procedure
END ! End CASE
OF ?Insert !Process the Insert Button
GET(Rolodex,0) ! Dereference current record
SETKEYCODE(InsKey) ! Set action to Insert
Do UpdateProcedure ! Call the update procedure
SELECT(?List) ! Reselect the List field
OF ?Change !Process the Change Button
SETKEYCODE(EnterKey) ! Set action to Change
Do UpdateProcedure ! Call the update procedure
SELECT(?List) ! Reselect the List field
OF ?Delete !Process the Delete Button
SETKEYCODE(DelKey) ! Set action to Delete
DO UpdateProcedure ! Call the update procedure
SELECT(?List) ! Reselect the List field
OF ?Exit !Process the Exit button
BREAK ! Return to caller
END !End CASE FIELD()
OF NoRecords !No records to browse
DISPLAY
DISABLE(?Change) ! Disable the change button
DISABLE(?Delete) ! Disable the delete button
ButtonIsDisabled = TRUE
IF RECORDS(Rolodex) ! If file is not empty
IF ?List <> 1 ! And list is not first
SELECT(1) ! Select the first field
ELSE ! Else
SELECT(?Insert) ! Select the Insert Button
END ! End IF
ELSE ! Else if file is empty
GET(Rolodex,0) ! Dereference current record
SETKEYCODE(InsKey) ! Ask for a new record
DO UpdateProcedure ! Call the update procedure
IF POSITION(Rol:NameKey) = '' ! If record not added
BREAK ! Return to caller
ELSE ! Else record was added
ENABLE(?Change) ! Disable the change button
ENABLE(?Delete) ! Disable the delete button
ButtonIsDisabled = FALSE
END ! End IF
END ! End IF
END ! End CASE
END !End LOOP
EndBrowse !End the browse session
FREE(Queue) !Free the Queue memory
EMBED('~~BrowseRolo~1~End of Procedure~1~~')
Close(Rolodex)
ENDEMBED
UpdateProcedure ROUTINE
UpdateRolo
