home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE4NL / SAMPLES.ZIP / ZAKEN.PRG < prev    next >
Encoding:
Text File  |  1993-05-18  |  4.8 KB  |  167 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: ZAKEN.PRG
  3. *               MAIN MENU
  4. *               SAMPLE BUSINESS APPLICATION SYSTEM
  5. * LAST CHANGED: 080692
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8.  
  9. PROCEDURE Zaken
  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.    SET LDCHECK     off
  23.    SET DATE BRITISH
  24.  
  25.    * Define help key
  26.    ON KEY LABEL F1 DO Helper
  27.  
  28.     * Save colors
  29.     PUBLIC c_save
  30.     c_save = SET("ATTRIBUTES")
  31.  
  32.    * Set display characteristics - depends on hardware
  33.    IF ISCOLOR()
  34.       c_normal = "W+/B,GR+/R,B"
  35.       c_pop    = "B/W,GR+/R,W+/R"
  36.       red      = "R/W"
  37.       blue     = "B/W"
  38.       lt_blue  = "W/BG"
  39.    ELSE
  40.       STORE "W+/N,N/W" TO c_normal, c_pop
  41.       STORE "W"   TO red, blue
  42.       STORE "N/W" TO lt_blue
  43.    ENDIF
  44.  
  45.    * Define popup
  46.    DO Main_def
  47.  
  48.    * Display menu and loop for choices
  49.    **mstrloop = .T.
  50.    DO WHILE BAR() <> 13
  51.       SET COLOR TO &c_normal.
  52.       CLEAR
  53.       DO Title
  54.       SET COLOR TO &c_pop.
  55.       ACTIVATE POPUP mainmenu
  56.    ENDDO
  57.    CLOSE ALL
  58.    CLEAR
  59. RETURN
  60. *** END MAIN PROCEDURE *******************************************************
  61.  
  62. PROCEDURE Title
  63.    CLEAR
  64.    * Draw lines and box for menu with colors for effect
  65.    @ 2,24 TO 5,53 DOUBLE COLOR &blue.
  66.    @ 2,24 FILL TO 5,53   COLOR &blue.
  67.    SET COLOR TO &red.
  68.    @ 3,27 SAY "  A&T MEUBELINDUSTRIE"
  69.    @ 4,26 SAY "dBASE IV REKENINGSYSTEEM"
  70.    SET COLOR TO &c_normal.
  71. RETURN
  72.  
  73. PROCEDURE Main_def
  74.    * Defines the main popup menu
  75.    DEFINE POPUP mainmenu FROM 7,27 TO 22,50;
  76.      MESSAGE "Druk op eerste letter van de optie " + ;
  77.              "of markeer en druk op <Enter>"
  78.    DEFINE BAR  1 OF mainmenu PROMPT "===== HOOFDMENU =====" SKIP
  79.    DEFINE BAR  2 OF mainmenu PROMPT "      Databases:" SKIP
  80.    DEFINE BAR  3 OF mainmenu PROMPT " WERKNEMERS"
  81.    DEFINE BAR  4 OF mainmenu PROMPT " KLANTEN"
  82.    DEFINE BAR  5 OF mainmenu PROMPT " LEVERANCIERS"
  83.    DEFINE BAR  6 OF mainmenu PROMPT " MAGAZIJN"
  84.    DEFINE BAR  7 OF mainmenu PROMPT " BESTELLINGEN"
  85.    DEFINE BAR  8 OF mainmenu PROMPT " LOPENDE REKENINGEN"
  86.    DEFINE BAR  9 OF mainmenu PROMPT " NETNUMMERS"
  87.    DEFINE BAR 10 OF mainmenu PROMPT "     Functies:" SKIP
  88.    DEFINE BAR 11 OF mainmenu PROMPT " FACTUUR AFDRUKKEN"
  89.    DEFINE BAR 12 OF mainmenu PROMPT " RESERVE/TERUGZETTEN"
  90.    DEFINE BAR 13 OF mainmenu PROMPT " TERUG NAAR dBASE"
  91.    DEFINE BAR 14 OF mainmenu PROMPT " EINDE EN NAAR DOS"
  92.    ON SELECTION POPUP mainmenu DO Main
  93. RETURN
  94.  
  95. PROCEDURE Main
  96.    * Execute case depending on user's choice
  97.    DO CASE
  98.       CASE BAR() =  3
  99.          DO Personel
  100.       CASE BAR() =  4
  101.          DO Klnt
  102.       CASE BAR() =  5
  103.          DO Leveran
  104.       CASE BAR() =  6
  105.          DO Goederen
  106.       CASE BAR() =  7
  107.          DO Bestel
  108.       CASE BAR() =  8
  109.          DO Rekn_rec
  110.       CASE BAR() =  9
  111.          DO Netnum
  112.       CASE BAR() =  11
  113.          DO Facturen
  114.       CASE BAR() =  12
  115.          DO Back_res
  116.       CASE BAR() =  13 .OR. BAR() = 14
  117.          RELEASE ALL
  118.          SET CLOCK ON
  119.          IF BAR() = 13
  120.          * Reset colors to Control Center/dot prompt colors
  121.          DO Colo_rese
  122.              RETURN TO MASTER
  123.          ELSE
  124.             QUIT
  125.          ENDIF
  126.    ENDCASE
  127. RETURN
  128.  
  129. PROCEDURE Colo_rese
  130. PRIVATE old_color, c_messages, c_titles, c_box, c_info, c_fields
  131.  
  132. old_color = c_save
  133.  
  134. * Set the Primary colors
  135. SET COLOR TO &old_color.
  136.  
  137. * Remove primary colors and start at the secondary colors
  138. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  139.  
  140. comma = AT(",",old_color)
  141. c_messages = LEFT(old_color, comma-1)        && Get MESSAGES color
  142. old_color = STUFF(old_color, 1, comma, "")    && Remove MESSAGES color
  143.  
  144. comma = AT(",",old_color)
  145. c_titles = LEFT(old_color, comma-1)        && Get TITLES color
  146. old_color = STUFF(old_color, 1, comma, "")    && Remove TITLES color
  147.  
  148. comma = AT(",",old_color)
  149. c_box = LEFT(old_color, comma-1)        && Get BOX color
  150. old_color = STUFF(old_color, 1, comma, "")    && Remove BOX color
  151.  
  152. comma = AT(",",old_color)
  153. c_info = LEFT(old_color, comma-1)        && Get INFORMATION color
  154. old_color = STUFF(old_color, 1, comma, "")    && Remove INFORMATION color
  155.  
  156. comma = AT(",",old_color)
  157. c_fields = old_color                && Get FIELDS color
  158.  
  159. SET COLOR OF MESSAGES    TO &c_messages.
  160. SET COLOR OF TITLES      TO &c_titles.
  161. SET COLOR OF BOX         TO &c_box.
  162. SET COLOR OF INFORMATION TO &c_info.
  163. SET COLOR OF FIELDS      TO &c_fields.
  164. RETURN
  165.  
  166. *** END ZAKEN.PRG *********************************************************
  167.