home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / BUSINESS.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  4.7 KB  |  165 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: BUSINESS.PRG
  3. *               MAIN MENU
  4. *               SAMPLE BUSINESS APPLICATION SYSTEM
  5. * LAST CHANGED: 06/20/90 08:00AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8.  
  9. PROCEDURE Business
  10.    * Set up environment
  11.    CLEAR ALL
  12.    SET DEVELOPMENT on
  13.    SET DELIMITERS  off
  14.    SET SCOREBOARD  off
  15.    SET ESCAPE      off
  16.    SET CLOCK       off
  17.    SET STATUS      off
  18.    SET TALK        off
  19.    SET EXACT       off
  20.    SET BELL        off
  21.    SET CATALOG     off
  22.  
  23.    * Define help key
  24.    ON KEY LABEL F1 DO Helper
  25.  
  26.     * Save colors
  27.     PUBLIC c_save
  28.     c_save = SET("ATTRIBUTES")
  29.  
  30.    * Set display characteristics - depends on hardware
  31.    IF ISCOLOR()
  32.       c_normal = "W+/B,GR+/R,B"
  33.       c_pop    = "B/W,GR+/R,W+/R"
  34.       red      = "R/W"
  35.       blue     = "B/W"
  36.       lt_blue  = "W/BG"
  37.    ELSE
  38.       STORE "W+/N,N/W" TO c_normal, c_pop
  39.       STORE "W"   TO red, blue
  40.       STORE "N/W" TO lt_blue
  41.    ENDIF
  42.  
  43.    * Define popup
  44.    DO Main_def
  45.  
  46.    * Display menu and loop for choices
  47.    **mstrloop = .T.
  48.    DO WHILE BAR() <> 13
  49.       SET COLOR TO &c_normal.
  50.       CLEAR
  51.       DO Title
  52.       SET COLOR TO &c_pop.
  53.       ACTIVATE POPUP mainmenu
  54.    ENDDO
  55.    CLOSE ALL
  56.    CLEAR
  57. RETURN
  58. *** END MAIN PROCEDURE *******************************************************
  59.  
  60. PROCEDURE Title
  61.    CLEAR
  62.    * Draw lines and box for menu with colors for effect
  63.    @ 2,24 TO 5,53 DOUBLE COLOR &blue.
  64.    @ 2,24 FILL TO 5,53   COLOR &blue.
  65.    SET COLOR TO &red.
  66.    @ 3,27 SAY "A-T FURNITURE INDUSTRIES"
  67.    @ 4,26 SAY "dBASE IV ACCOUNTING SYSTEM"
  68.    SET COLOR TO &c_normal.
  69. RETURN
  70.  
  71. PROCEDURE Main_def
  72.    * Defines the main popup menu
  73.    DEFINE POPUP mainmenu FROM 7,27 TO 22,50;
  74.      MESSAGE "Press first letter of menu choice, " + ;
  75.              "or highlight and press <Enter>"
  76.    DEFINE BAR  1 OF mainmenu PROMPT "===== MAIN  MENU =====" SKIP
  77.    DEFINE BAR  2 OF mainmenu PROMPT "      Databases:" SKIP
  78.    DEFINE BAR  3 OF mainmenu PROMPT " EMPLOYEES"
  79.    DEFINE BAR  4 OF mainmenu PROMPT " CUSTOMERS"
  80.    DEFINE BAR  5 OF mainmenu PROMPT " VENDORS"
  81.    DEFINE BAR  6 OF mainmenu PROMPT " INVENTORY"
  82.    DEFINE BAR  7 OF mainmenu PROMPT " ORDERS"
  83.    DEFINE BAR  8 OF mainmenu PROMPT " ACCOUNTS RECEIVABLE"
  84.    DEFINE BAR  9 OF mainmenu PROMPT " AREA CODES"
  85.    DEFINE BAR 10 OF mainmenu PROMPT "     Utilities:" SKIP
  86.    DEFINE BAR 11 OF mainmenu PROMPT " PRINT INVOICES"
  87.    DEFINE BAR 12 OF mainmenu PROMPT " BACK UP/RESTORE DATA"
  88.    DEFINE BAR 13 OF mainmenu PROMPT " RETURN TO dBASE"
  89.    DEFINE BAR 14 OF mainmenu PROMPT " QUIT TO DOS"
  90.    ON SELECTION POPUP mainmenu DO Main
  91. RETURN
  92.  
  93. PROCEDURE Main
  94.    * Execute case depending on user's choice
  95.    DO CASE
  96.       CASE BAR() =  3
  97.          DO Employee
  98.       CASE BAR() =  4
  99.          DO Cust
  100.       CASE BAR() =  5
  101.          DO Vendors
  102.       CASE BAR() =  6
  103.          DO Goods
  104.       CASE BAR() =  7
  105.          DO Orders
  106.       CASE BAR() =  8
  107.          DO Acct_rec
  108.       CASE BAR() =  9
  109.          DO Areacode
  110.       CASE BAR() =  11
  111.          DO Invoices
  112.       CASE BAR() =  12
  113.          DO Back_res
  114.       CASE BAR() =  13 .OR. BAR() = 14
  115.          RELEASE ALL
  116.          SET CLOCK ON
  117.          IF BAR() = 13
  118.          * Reset colors to Control Center/dot prompt colors
  119.          DO Colo_rese
  120.              RETURN TO MASTER
  121.          ELSE
  122.             QUIT
  123.          ENDIF
  124.    ENDCASE
  125. RETURN
  126.  
  127. PROCEDURE Colo_rese
  128. PRIVATE old_color, c_messages, c_titles, c_box, c_info, c_fields
  129.  
  130. old_color = c_save
  131.  
  132. * Set the Primary colors
  133. SET COLOR TO &old_color.
  134.  
  135. * Remove primary colors and start at the secondary colors
  136. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  137.  
  138. comma = AT(",",old_color)
  139. c_messages = LEFT(old_color, comma-1)        && Get MESSAGES color
  140. old_color = STUFF(old_color, 1, comma, "")    && Remove MESSAGES color
  141.  
  142. comma = AT(",",old_color)
  143. c_titles = LEFT(old_color, comma-1)        && Get TITLES color
  144. old_color = STUFF(old_color, 1, comma, "")    && Remove TITLES color
  145.  
  146. comma = AT(",",old_color)
  147. c_box = LEFT(old_color, comma-1)        && Get BOX color
  148. old_color = STUFF(old_color, 1, comma, "")    && Remove BOX color
  149.  
  150. comma = AT(",",old_color)
  151. c_info = LEFT(old_color, comma-1)        && Get INFORMATION color
  152. old_color = STUFF(old_color, 1, comma, "")    && Remove INFORMATION color
  153.  
  154. comma = AT(",",old_color)
  155. c_fields = old_color                && Get FIELDS color
  156.  
  157. SET COLOR OF MESSAGES    TO &c_messages.
  158. SET COLOR OF TITLES      TO &c_titles.
  159. SET COLOR OF BOX         TO &c_box.
  160. SET COLOR OF INFORMATION TO &c_info.
  161. SET COLOR OF FIELDS      TO &c_fields.
  162. RETURN
  163.  
  164. *** END BUSINESS.PRG *********************************************************
  165.