home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a012 / 1.ddi / CHAP19.EXE / CHP1918.PRG < prev   
Encoding:
Text File  |  1991-04-30  |  4.0 KB  |  145 lines
  1. /*
  2.    Listing 19.18  Employee array example
  3.    Author: Joe Booth
  4.    Excerpted from "Clipper 5: A Developer's Guide"
  5.    Copyright (c) 1991 M&T Books
  6.                       501 Galveston Drive
  7.                       Redwood City, CA 94063-4728
  8.                       (415) 366-3600
  9. */
  10.  
  11.  
  12.    LOCAL mdept:=space(6)
  13.    PRIVATE employees:={}
  14.    use EMPLOYEE new index DEPT_ORD
  15.    @ 2,6 get mdept pict "!!!!!!"
  16.    setcursor(1)
  17.    read
  18.    if lastkey() <> 27
  19.       seek mdept
  20.       while !eof()  .and. EMPLOYEE->dept_id = mdept
  21.          Aadd(employees,full_name+"  "+dtoc(hired)+" "+;
  22.                  str(salary,12,2)+"  "+str(recno(),6) )
  23.          skip +1
  24.       enddo
  25.    endif
  26.  
  27.  
  28.  
  29.     // The variables keepgoing, elt, and pos will be updated
  30.     // by the A_UDF called from ACHOICE. As a result, they
  31.     // must be declared as PRIVATE rather than LOCAL.
  32.  
  33.     LOCAL x,mname,mdate,mamt,mrow,mrec
  34.     PRIVATE keepgoing := .T.,elt:=1,pos:=0,tags[len(employees)]
  35.     afill(tags,.T.)
  36.     while keepgoing
  37.        x :=achoice(6,15,22,65,employees,tags,"A_UDF",elt,pos)
  38.        if x > 0
  39.           mname := substr(employees[x],1,25)
  40.           mdate := ctod(substr(employees[x],28,8))
  41.           mamt  := val(substr(employees[x],37,12))
  42.           mrec  := val(right(employees[x],6))
  43.           mrow  := row()
  44.           @ mrow,15 get mname
  45.           @ mrow,42 get mdate
  46.           @ mrow,51 get mamt
  47.           read
  48.           if lastkey() <> 27
  49.              select EMPLOYEE
  50.              goto mrec
  51.              replace EMPLOYEE->full_name with mname,;
  52.                      EMPLOYEE->hired with mdate,;
  53.                      EMPLOYEE->salary with mamt
  54.              employees[x] :=mname+"  "+dtoc(mdate)+" "+;
  55.                             str(mamt,12,2)+"  "+str(mrec,6)
  56.           endif
  57.        endif
  58.     enddo
  59.  
  60.  
  61.       function a_udf(mode,element,position)
  62.       LOCAL lk:=lastkey()
  63.       #include "ACHOICE.CH"
  64.       #include "INKEY.CH"
  65.  
  66.       // Private variables ELT,POS, and KEEPGOING are
  67.       // passed from the program containing the ACHOICE
  68.       // function call.
  69.  
  70.       elt := element                 // update element
  71.       pos := position                // and position
  72.       if mode = AC_EXCEPT            // Keystroke exception
  73.          do case
  74.          case lk = K_ESC             // ESCAPE key
  75.             keepgoing = .f.          // Tell LOOP to exit
  76.             return AC_ABORT
  77.          case lk = 13 .or. lk = 32   // ENTER or space
  78.             return AC_SELECT
  79.          case chr(lk)$"Ss"           // Sort array
  80.             sort_it()
  81.             return AC_ABORT
  82.          case chr(lk)$"Ff"           // Find an item
  83.             find_it()
  84.             return AC_ABORT
  85.          endcase
  86.       endif
  87.       return AC_CONT
  88.  
  89. function sort_it
  90. LOCAL which:=1
  91. @ 6,15 clear to 22,65
  92. @ 6,15 prompt "Name"
  93. @ 6,43 prompt "Date"
  94. @ 6,52 prompt "Salary"
  95. menu to which
  96. do case
  97. case which = 1
  98.    asort(employees)
  99. case which = 2
  100.    asort(employees,,,{|x,y|substr(x,28,8)<substr(y,28,8)} )
  101. case which = 3
  102.    asort(employees,,,{|x,y|substr(x,37,12)<substr(y,37,12)} )
  103. endcase
  104. return NIL
  105.  
  106. function find_it
  107. LOCAL mname:=space(25),myear:=year(date())
  108. LOCAL mop_code :="<",mamt:=0.0,jj,tag_me,find_one:=.F.
  109. @ 6,15 clear to 22,65
  110. @ 6,15 get mname
  111. @ 6,48 get myear     pict "99"
  112. @ 6,51 get mop_code  pict "!"  ;
  113.        valid mop_code $"<>= " .or. lastkey() = K_UP
  114. @ 6,52 get mamt      pict "999999.99"
  115. read
  116. afill(tags,.F.)
  117. for jj=1 to len(tags)
  118.    tag_me := .t.
  119.    if !empty( mname )
  120.       tag_me := (upper(mname) $ upper(substr(employees[jj],1,25)))
  121.    endif
  122.    if !empty( myear )
  123.       tag_me := (year(ctod(substr(employees[jj],28,8)))=myear)
  124.    endif
  125.    if !empty( mamt )
  126.       x := val(substr(employees[jj],37,12))
  127.       do case
  128.       case mop_code = "<"
  129.          tag_me := (x<mamt)
  130.       case mop_code = "="
  131.          tag_me := (x=mamt)
  132.       case mop_code = ">"
  133.          tag_me := (x>mamt)
  134.       endcase
  135.    endif
  136.    tags[jj] := tag_me
  137.    if tag_me
  138.       find_one :=.T.
  139.    endif
  140. next
  141. if !find_one
  142.    afill(tags,.T.)
  143. endif
  144. return NIL
  145.