Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive   : DB4LESS3.ZIP
Filename : EMPRATE.PRG

********************************************************************************
* Program......: EMPRATE
* Author.......: Bruce Troutman
* Date.........: 12-04-88
* Notice.......: (c) Interco International, Ltd.
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: Employee Rate File Manager

* Notes........:
********************************************************************************

SET CONSOLE OFF
IF TYPE("gn_apgen") = "U" && We were not called from another APGEN program
CLEAR ALL
CLEAR WINDOW
CLOSE ALL
gn_apgen = 1
ELSE
gn_apgen = gn_apgen + 1
PRIVATE gc_bell, gc_carry, gc_clock, gc_century, gc_confirm, gc_deli,;
gc_escape, gc_instruc, gc_safety, gc_status, gc_score, gc_talk
ENDIF

*-- Window for pause message box (ON ERROR)
DEFINE WINDOW Pause FROM 15,00 TO 19,79 DOUBLE
ON ERROR DO PAUSE WITH [Error occurred on line ]+LTRIM(STR(LINE())) +[ of procedure ]+Program()
ON KEY LABEL F1 DO quickhlp

*-- Store initial SETs to variables
gc_bell =SET("BELL")
gc_carry =SET("CARRY")
gc_clock =SET("CLOCK")
gc_century=SET("CENTURY")
gc_confirm=SET("CONFIRM")
gc_deli =SET("DELIMITERS")
gc_escape =SET("ESCAPE")
gc_instruc=SET("INSTRUCT")
gc_safety =SET("SAFETY")
gc_status =SET("STATUS")
gc_score =SET("SCOREBOARD")
gc_talk =SET("TALK")

SET CLOCK OFF
SET COLOR TO
CLEAR
SET CONSOLE ON

*-- Sets for application
SET BELL ON
SET CARRY OFF
SET CENTURY OFF
SET CONFIRM OFF
SET DELIMITERS TO ""
SET DELIMITER OFF
SET ESCAPE ON
***SET INSTRUCT OFF ** remove for RunTime
SET SAFETY ON
SET SCOREBOARD OFF
SET STATUS OFF
SET TALK OFF

*-- Set global variables
gn_barv = 0 && Initialize bar value variable
gn_error = 0 && Variable to store error() number
gn_send = 0 && Return variable from popup
gc_brdr = "2" && Border style for menu box - See Procedure
lc_heading = "Employee Rate file Manager" && Menu heading string
ll_color = ISCOLOR()

CLEAR
SET ESCAPE ON
SET STATUS ON
*-- Set colors
IF ll_color
SET COLOR OF NORMAL TO w+/b
SET COLOR OF MESSAGES TO w+/b
SET COLOR OF TITLES TO w+/b
SET COLOR OF HIGHLIGHT TO b/w
SET COLOR OF BOX TO b/w
SET COLOR OF INFORMATION TO b/w
SET COLOR OF FIELDS TO b/w
ENDIF

USE EMPRATE INDEX EMPRATE
SET ORDER TO EMPID

*-- Define the main popup menu for Quickapp
SET BORDER TO DOUBLE
DEFINE POPUP quick FROM 7,27
DEFINE BAR 1 OF quick PROMPT " Add Information" MESSAGE "Add records to database EMPRATE"
DEFINE BAR 2 OF quick PROMPT " Change Information" MESSAGE "Edit records in database EMPRATE"
DEFINE BAR 3 OF quick PROMPT " Browse Information" MESSAGE "Browse database EMPRATE"
DEFINE BAR 4 OF quick PROMPT " Discard Marked Records " MESSAGE "Purge deleted records in database EMPRATE"
DEFINE BAR 5 OF quick PROMPT " Reindex Database" MESSAGE "Reindex database EMPRATE"
DEFINE BAR 6 OF quick PROMPT " Exit From Emprate" MESSAGE "Exit program to dBASE"
ON SELECTION POPUP quick DO Action WITH BAR()


*-- Window to cover work surface during edit, append, etc.
DEFINE WINDOW work FROM 0,0 TO 21,79 NONE

*-- Window for area below menu heading & for running reports/labels in
DEFINE WINDOW desktop FROM 4,0 TO 21,79 NONE

DEFINE WINDOW printemp FROM 10,25 TO 15,56

*-- Display heading centered on the screen.
DO menubox WITH lc_heading

*-- Show the menu so we don't get a flash if the user hits arrow keys or ESC
SHOW POPUP quick
SAVE SCREEN TO quick
*-- Display Quickapp menu centered on the screen.
DO WHILE gn_barv <> 6 && Prevent user from exiting with arrow keys or ESC
ACTIVATE POPUP quick
ENDDO

* Restore SET environment the best we can
SET BELL &gc_bell.
SET CARRY &gc_carry.
SET CLOCK TO
SET CLOCK &gc_clock.
SET CENTURY &gc_century.
SET CONFIRM &gc_confirm.
SET DELIMITERS &gc_deli.
SET ESCAPE &gc_escape.
*** SET INSTRUCT &gc_instruc. ** Remove for RunTime
SET STATUS &gc_status.
SET SAFETY &gc_safety.
SET SCORE &gc_score.
SET TALK &gc_talk.
SET FORMAT TO

IF gn_apgen = 1 && We were not called from another APGEN program
CLEAR WINDOW
CLEAR POPUP
CLEAR ALL
CLOSE ALL
ELSE
RELEASE WINDOWS work, desktop
RELEASE SCREEN quick
RELEASE POPUP quick
gn_apgen = gn_apgen - 1
ENDIF
ON ERROR
ON KEY LABEL F1
RETURN
* EOP: EMPRATE.PRG

********************************************************************************
* Procedures...: EMPRATE.Prc
* Author.......: Bruce Troutman
* Date.........: 12-04-88
* Notice.......: (c) Interco International, Ltd.
* dBASE Ver....:
* Generated by.: APGEN version 1.0
* Description..: Employee Rate File Manager

* Notes........:
********************************************************************************

*-- Here is a sample procedure file to show the power of procdures.
*-- This example - Menubox displays a menu heading box with a centered heading.
PROCEDURE MenuBox
PARAMETER lc_m_name
*-- Parameter lc_m_name - is the title variable for the menu
SET CLOCK OFF
@ 1,0 FILL TO 2,79 COLOR n/n
DO CASE
CASE gc_brdr = "0"
@ 1,0 CLEAR TO 3,79
CASE gc_brdr = "1"
@ 1,0 TO 3,79
CASE gc_brdr = "2"
lc_color = IIF(ISCOLOR(),"b/w", "W+/N")
@ 1,0 TO 3,79 DOUBLE COLOR &lc_color.
ENDCASE
SET CLOCK TO 2,68
@ 2,1 SAY SUBSTR(CDOW(DATE()),1,3)+'. '+DTOC(DATE())+' '
@ 2,41 - (LEN(lc_m_name)/2) SAY lc_m_name
lc_color = IIF(ISCOLOR(),"w+/b", "W+/N")
@ 2,1 FILL TO 2,78 COLOR &lc_color.
RETURN


PROCEDURE get_sele
*-- Get the user selection & store BAR into variable
gn_send = BAR() && Variable for print testing
DEACTIVATE POPUP
RETURN

PROCEDURE Action
PARAMETERS bar
*-- Get the user selection & store BAR into variable
gn_barv = bar
SET MESSAGE TO
IF LTRIM( STR( gn_barv)) $ "123"
*-- Set format file EMPRATE for edit/append/browse
SET FORMAT TO EMPRATE
ENDIF
DO CASE
CASE gn_barv = 1
*-- Add information
SET MESSAGE TO 'Appending records to file EMPRATE'
APPEND
CASE gn_barv = 2
*-- Change information
SET MESSAGE TO 'Editing file EMPRATE'
EDIT
CASE gn_barv = 3
*-- Browse information
SET MESSAGE TO 'Browsing file EMPRATE'
BROWSE FORMAT
CASE gn_barv = 4
*-- Remove information (Pack file emprate)
ACTIVATE WINDOW desktop
@ 2,0 SAY "Packing database EMPRATE to REMOVE records marked for deletion..."
@ 3,0
SET TALK ON
PACK
GO TOP
?
WAIT
SET TALK OFF
DEACTIVATE WINDOW desktop
CASE gn_barv = 5
*-- Reindex emprate
ACTIVATE WINDOW desktop
@ 3,0 SAY "Reindexing database EMPRATE..."
@ 4,0
SET TALK ON
REINDEX
GO TOP
?
WAIT
SET TALK OFF
DEACTIVATE WINDOW desktop
CASE gn_barv = 6
DEACTIVATE POPUP
ENDCASE
SET MESSAGE TO
IF gc_status = "OFF"
SET STATUS ON
ENDIF
SET FORMAT TO
RESTORE SCREEN FROM quick
RETURN

PROCEDURE Pause
PARAMETER lc_msg
*-- Parameters : lc_msg = message line
IF TYPE("lc_message")="U"
gn_error=ERROR()
ENDIF
lc_msg = lc_msg
lc_option='0'
ACTIVATE WINDOW Pause
IF gn_error > 0
IF TYPE("lc_message")="U"
@ 0,1 SAY [An error has occurred !! - Error message: ]+MESSAGE()
ELSE
@ 0,1 SAY [Error # ]+lc_message
ENDIF
ENDIF
@ 1,1 SAY lc_msg
WAIT " Press any key to continue..."
DEACTIVATE WINDOW Pause
RETURN


PROCEDURE quickhlp
*-- If you want to include help for a quickapp uncomment the lines below and
*-- put your help @ say's into the case statements
*ACTIVATE WINDOW desktop
*CLEAR
DO CASE
CASE BAR() = 1
CASE BAR() = 2
CASE BAR() = 3
CASE BAR() = 4
CASE BAR() = 5
CASE BAR() = 6
ENDCASE
*WAIT
*DEACTIVATE WINDOW desktop
RETURN

* EOF: EMPRATE.PRG