home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / samples.exe / AREACODE.PRG < prev    next >
Encoding:
Text File  |  1992-03-10  |  6.3 KB  |  210 lines
  1. ******************************************************************************
  2. * PROGRAM NAME: AREACODE.PRG
  3. *               AREACODE DATABASE SCREEN
  4. *               SAMPLE BUSINESS APPLICATION PROGRAM
  5. * LAST CHANGED: 06/20/90 08:00AM
  6. * WRITTEN BY:   Borland International Inc.
  7. ******************************************************************************
  8. *       FILES USED:
  9. *       Database     =  Codes.dbf  (Area code file)
  10. *       Index file   =  Codes.mdx
  11. *         TAG: City  =  city  <= Master
  12. *         TAG: Code  =  code
  13. *       External procedure file = Library.prg
  14. ******************************************************************************
  15. * Main procedure
  16. PROCEDURE Areacode
  17.  
  18.    * Link to external procedure file of "tool" procedures
  19.    SET PROCEDURE TO Library
  20.  
  21.     * Save the environment color settings
  22.     IF TYPE("c_save") = "U"
  23.         * Do not overwrite c_save if it already exists
  24.         PUBLIC c_save
  25.                 SET CONSOLE off              
  26.         c_save = SET("ATTRIBUTES")
  27.                 SET CONSOLE on
  28.     ENDIF
  29.  
  30.    * Set up database environment
  31.    SET CONSOLE off
  32.    DO Set_env
  33.    SET CONSOLE on
  34.  
  35.    SET COLOR TO &c_standard.
  36.  
  37.    * Declare variables used:
  38.    * Database memory variables
  39.    city = SPACE(20)
  40.    code = 0
  41.    * Miscellaneous variables - used to pass parameters to Library
  42.    STORE "CODES" TO dbf
  43.    STORE "NOT AVAILABLE" TO mlist     && No mailing list available
  44.    STORE "N/A" TO cust_rpt            && No custom reports available
  45.    STORE "m->city" TO key, key1
  46.    STORE "NONE" TO key2, key3
  47.    keyname1 = "City:"
  48.    STORE "" TO keyname2, keyname3
  49.    list_flds = "CITY, CODE"
  50.    mcode     = 0
  51.    lookup_ok = .F.                    && lookup not applicable
  52.  
  53.    * Open database file and choose active index
  54.    SELECT 1
  55.    USE Codes ORDER City
  56.    GO TOP
  57.  
  58.    record_num = RECNO()
  59.    DO Load_fld    && Load initial record from database into memory variables
  60.  
  61.    * Show data screen
  62.    CLEAR
  63.    DO Dstatus
  64.    DO Backgrnd
  65.    DO Show_data
  66.  
  67.    * Define popup menus
  68.    DO Bar_def
  69.  
  70.    * Activate main popup menu - execute user choices
  71.    SET COLOR TO &c_popup.
  72.    ACTIVATE POPUP main_mnu
  73.    DO Sub_ret
  74. RETURN
  75. *** END MAIN PROCEDURE *******************************************************
  76.  
  77. *** UTILITY PROCEDURES (Proprietary to Areacode.prg) *************************
  78. PROCEDURE Filter
  79.    * Filter (group) data into subset
  80.    * Select subset to set up filter condition (Y=turn on, N=abort selection,
  81.    * T=turn off). If filter is already on, set default choice to T, show 
  82.    * window. If filter is not on, set default choice to Y, show window.
  83.    choice = IIF(filters_on,"T","Y")
  84.    DO Filt_ans
  85.    IF choice = "Y"              && Start process of choosing filter condition
  86.       mcode  = 0
  87.       ACTIVATE WINDOW alert
  88.          * Get user's filter condition selection
  89.          @  0, 0 SAY "------- ENTER FILTER CONDITION -----"
  90.          @  2, 0 SAY "Area code:" GET mcode PICTURE "999"
  91.          READ
  92.       DEACTIVATE WINDOW alert
  93.       IF 0 <> mcode             && Check whether user entered data
  94.          SET FILTER TO code = mcode
  95.       ELSE                      && User entered no data, so exit
  96.          ?? CHR(7)
  97.          filters_on = .F.
  98.          RETURN
  99.       ENDIF
  100.       GO TOP                    && Activate filter by moving record pointer
  101.       * Check whether filter condition matches any records (none matching=EOF)
  102.       filters_on = .NOT. EOF()
  103.       IF .NOT. filters_on       && Turn off filter if no matches found
  104.          ?? CHR(7)
  105.          DO Show_msg WITH "No Areacode records match the filter condition"
  106.          SET FILTER TO
  107.          GO record_num
  108.       ENDIF
  109.    ELSE
  110.       * If user selects "T", turn off filter
  111.       SET FILTER TO
  112.       filters_on = .F.
  113.    ENDIF
  114. RETURN
  115.  
  116. PROCEDURE Indexer
  117.    * Create/rebuild index
  118.    INDEX ON code TAG Code
  119.    INDEX ON city TAG City
  120.    SET ORDER TO TAG City
  121.    GO TOP
  122. RETURN
  123.  
  124. PROCEDURE Init_fld
  125.    * Initialize memory variables for data entry
  126.    city = SPACE(20)
  127.    code = 0
  128. RETURN
  129.  
  130. PROCEDURE Load_fld
  131.    * Load field values from Codes database record into memory variables
  132.    city  = city
  133.    code  = code
  134. RETURN
  135.  
  136. PROCEDURE Repl_fld
  137.    * Replace database fields with values of current memory variables
  138.    REPLACE city WITH m->city, code WITH m->code
  139. RETURN
  140.  
  141. PROCEDURE Backgrnd
  142.    * Show background screen
  143.    * Draw lines and boxes
  144.    @  1,25 TO  3,53  DOUBLE COLOR &c_blue.
  145.    @  6,7  TO  8,38  DOUBLE COLOR &c_red.
  146.    @  9,7  TO 11,38         COLOR &c_red.
  147.    @  2,26 FILL TO  2,52    COLOR &c_blue.
  148.    @  6,7  FILL TO 11,38    COLOR &c_red.
  149.    SET COLOR TO &c_data.
  150.    @  2,27 SAY "PERSONAL AREACODE SYSTEM"
  151.    @  7,10 SAY "CITY:"
  152.    @ 10,10 SAY "CODE:"
  153.    SET COLOR TO &c_standard.
  154. RETURN
  155.  
  156. PROCEDURE Show_data
  157.    * Show data
  158.    SET COLOR TO &c_fields.
  159.    @  7,17 SAY city
  160.    @ 10,17 SAY code PICTURE "999"
  161.    SET COLOR TO &c_standard.
  162. RETURN
  163.  
  164. PROCEDURE Get_data
  165.    * Show data for data entry
  166.    SET COLOR TO &c_data.
  167.    @  7,17 GET m->city PICTURE "!XXXXXXXXXXXXXXXXXXX"
  168.    @ 10,17 GET m->code PICTURE "999"
  169.    SET COLOR TO &c_standard.
  170. RETURN
  171.  
  172. PROCEDURE Colo_rese
  173. PRIVATE old_color, c_messages, c_titles, c_box, c_info, c_fields
  174.  
  175. old_color = c_save
  176.  
  177. * Set the Primary colors
  178. SET COLOR TO &old_color.
  179.  
  180. * Remove primary colors and start at the secondary colors
  181. old_color = STUFF(old_color, 1, AT("&",old_color)+2, "")
  182.  
  183. comma = AT(",",old_color)
  184. c_messages = LEFT(old_color, comma-1)        && Get MESSAGES color
  185. old_color = STUFF(old_color, 1, comma, "")    && Remove MESSAGES color
  186.  
  187. comma = AT(",",old_color)
  188. c_titles = LEFT(old_color, comma-1)        && Get TITLES color
  189. old_color = STUFF(old_color, 1, comma, "")    && Remove TITLES color
  190.  
  191. comma = AT(",",old_color)
  192. c_box = LEFT(old_color, comma-1)        && Get BOX color
  193. old_color = STUFF(old_color, 1, comma, "")    && Remove BOX color
  194.  
  195. comma = AT(",",old_color)
  196. c_info = LEFT(old_color, comma-1)        && Get INFORMATION color
  197. old_color = STUFF(old_color, 1, comma, "")    && Remove INFORMATION color
  198.  
  199. comma = AT(",",old_color)
  200. c_fields = old_color                                    && Get FIELDS color
  201.  
  202. SET COLOR OF MESSAGES    TO &c_messages.
  203. SET COLOR OF TITLES      TO &c_titles.
  204. SET COLOR OF BOX         TO &c_box.
  205. SET COLOR OF INFORMATION TO &c_info.
  206. SET COLOR OF FIELDS      TO &c_fields.
  207. RETURN
  208.  
  209. *** END AREACODE.PRG *********************************************************
  210.