home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a031 / template.exe / AS_POSIT.COD < prev    next >
Encoding:
Text File  |  1992-03-10  |  11.9 KB  |  400 lines
  1. //
  2. // Module Name: AS_POSIT.COD
  3. // Description: Record positioning (Ask at runtime)
  4. //
  5. {
  6. //
  7. // Enum string constants for international translation
  8. //
  9. enum pause_msg1 = "Database not in use. ",
  10.      pause_msg2 = "Can't use this option - No index files are open.",
  11.      pause_msg3 = "All fields were blank.",
  12.      pause_msg4 = "Record not found.",
  13.      order_msg1 = "Index order: "
  14.      order_msg2 = "Database is in natural order",
  15.      order_msg3 = "Listed below are the first 16 fields.",
  16.      fld_string = "= Char  = Date  = Logic = Num   = Float = Memo          ",
  17.      Posit_bar1 = " Position by ",
  18.      Posit_bar3 = " SEEK Record",    Posit_msg3 = "Search on index key",
  19.      Posit_bar4 = " GOTO Record",    Posit_msg4 = "Position to specific record",
  20.      Posit_bar5 = " LOCATE Record ", Posit_msg5 = "Locate record for condition",
  21.      Posit_bar6 = " Change index order  ", Posit_msg6 = "Reassign current index order",
  22.      Posit2_wnd1 = "Key expression:",
  23.      Posit2_wnd2 = " Index Order  Natural Order ",
  24.      Posit2_wnd3 = "Enter the key expression to search for:",
  25.      Posit2_bar1 = " GOTO:",
  26.      Posit2_bar3 = " TOP",       Posit2_msg3 = "GOTO Top of File",
  27.      Posit2_bar4 = " BOTTOM",    Posit2_msg4 = "GOTO Bottom of File",
  28.      Posit2_bar5 = " Record # ", Posit2_msg5 = "GOTO A Specific Record",
  29.      Posit2_wnd4 = "Max. Record # = ",
  30.      Posit2_wnd5 = "Record to GOTO",
  31.      Posit2_wnd6 = "ie. ALL, NEXT <n>, and REST",
  32.      Posit2_wnd7 = "Scope:",
  33.      Posit2_wnd8 = "For:  ",
  34.      Posit2_wnd9 = "While:"
  35. ;
  36. var ln_frow, ln_fcol;
  37. }
  38. PROCEDURE Position
  39. *{replicate("-",69)}
  40. * Record positioning (Ask at runtime)
  41. *{replicate("-",69)}
  42.  
  43.   IF LEN(DBF()) = 0{tabto(41)}&& Make sure a DBF is open
  44.     DO Pause WITH "{pause_msg1}"
  45.     RETURN
  46.   ENDIF
  47.  
  48.   IF EOF(){tabto(41)}&& If end of file, go to top
  49.     GOTO TOP
  50.   ENDIF
  51.  
  52.   ll_deli = SET("DELIMITERS") = "ON"
  53.   SET DELIMITERS OFF
  54.   ll_space = SET("SPACE") = "ON"
  55.   SET SPACE ON
  56.  
  57. // Frame row position
  58. {ln_frow=8;}
  59. // Frame col position
  60. {ln_fcol=30;//28}
  61.   ln_type   = 0{tabto(41)}&& Sublevel selection
  62.   ln_rkey   = READKEY(){tabto(41)}&& Test for ESC or Return
  63.   ln_rec    = RECNO(){tabto(41)}&& DBF record number
  64.   ln_num    = 0{tabto(41)}&& For input of a number
  65.   ll_logic  =.T.{tabto(41)}&& For input of a logical
  66.   ld_date   = DATE(){tabto(41)}&& For input of a date
  67.   lc_option = '0'{tabto(41)}&& Main option ie. Seek, Goto and Locate
  68.   lc_ln1    = SPACE(100){tabto(41)}&& For input of a character
  69.  
  70.   *-- Scope ie. ALL, REST, NEXT <n>
  71.   STORE SPACE(10) TO lc_scp
  72.  
  73.   *-- 1 = Character SEEK, 2 = For clause, 3 = While clause
  74.   STORE SPACE(40) TO lc_ln2, lc_ln3
  75.   lc_temp  = ""
  76.   gc_scope = ""
  77.   @ 0,00 SAY "{order_msg1}"+IIF(""=ORDER(),"{order_msg2}",ORDER())
  78.   @ 1,00 SAY "{order_msg3}"
  79.   lc_temp=REPLICATE(CHR(196),19)
  80.   @ 2,0 SAY CHR(218)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp+CHR(194)+lc_temp
  81.   ln_num=240
  82.  
  83.   *-- Build a list of fields in the current DBF
  84.   DO WHILE ln_num < 560
  85.     lc_temp = FIELD( (ln_num-240)/20 +1)
  86.     @ (ln_num/80),MOD(ln_num,80) SAY CHR(179)+;
  87.                                      lc_temp+SPACE(11-LEN(lc_temp))+;
  88.                                      SUBSTR("{fld_string}",;
  89.                                      AT(TYPE(lc_temp),"CDLNFMU")*8-7,8)
  90.     ln_num=ln_num+20
  91.   ENDDO
  92.   ln_num=1
  93.  
  94.   DEFINE POPUP Posit1 FROM {ln_frow},{ln_fcol}
  95.     DEFINE BAR 1 OF Posit1 PROMPT "{posit_bar1}" SKIP
  96.     DEFINE BAR 2 OF Posit1 PROMPT REPLICATE(CHR(196),21) SKIP
  97.     DEFINE BAR 3 OF Posit1 PROMPT "{posit_bar3}" MESSAGE "{posit_msg3}" SKIP FOR ""=ORDER()
  98.     DEFINE BAR 4 OF Posit1 PROMPT "{posit_bar4}" MESSAGE "{posit_msg4}"
  99.     DEFINE BAR 5 OF Posit1 PROMPT "{posit_bar5}" MESSAGE "{posit_msg5}"
  100.     DEFINE BAR 6 OF Posit1 PROMPT REPLICATE(CHR(196),21) SKIP
  101.     DEFINE BAR 7 OF Posit1 PROMPT "{posit_bar6}" MESSAGE "{posit_msg6}"
  102.     DEFINE BAR 8 OF Posit1 PROMPT " Done positioning " ;
  103.       MESSAGE "Press return here, when ready " +;
  104.               "(ESC cancels selections, except index order)"
  105.   ON SELECTION POPUP Posit1 DEACTIVATE POPUP
  106.  
  107.   SET CONFIRM ON
  108.   gn_send = 0
  109.   DO WHILE gn_send = 0
  110.  
  111.     ACTIVATE POPUP Posit1
  112.     gn_send = BAR()
  113.     lc_option = ltrim(str(gn_send)){tabto(41)}&& Convert bar# to string
  114.  
  115.     IF gn_send = 0
  116.       gc_scope=""
  117.       GOTO ln_rec
  118.       EXIT
  119.     ENDIF
  120.  
  121.     gn_send=0
  122.  
  123.     DO CASE
  124.  
  125.       CASE lc_option='3'{tabto(41)}&& Seek record
  126.  
  127.         IF LEN(NDX(1))=0 .AND. LEN(MDX(1))=0
  128.           DO Pause WITH "{pause_msg2}"
  129.           LOOP
  130.         ENDIF
  131.         lc_ln1=SPACE(100)
  132.         DEFINE WINDOW Posit2 FROM {ln_frow},{ln_fcol-16} TO {ln_frow+9},{ln_fcol+37} DOUBLE
  133.         ACTIVATE WINDOW Posit2
  134.         keyexpr=""
  135.         lc_type = Get_Type( ORDER() )
  136.         @ 1,1 SAY "{posit2_wnd1}"
  137.         @ 2,1
  138.         ?? keyexpr FUNCTION "V50"
  139.         SET CONFIRM ON
  140.         @ 5,1 SAY "{posit2_wnd3}"
  141.         DO CASE
  142.           CASE lc_type = "C"
  143.             @ 6,1 GET lc_ln1 FUNCTION "S50"
  144.           CASE lc_type = "D"
  145.             @ 6,1 GET ld_date FUNCTION "D"
  146.           CASE lc_type = "L"
  147.             @ 6,1 GET ll_logic
  148.           CASE lc_type = "N" .OR. lc_type = "F"
  149.             @ 6,1 GET ln_num PICTURE "################.####"
  150.         ENDCASE
  151.         SET CURSOR ON
  152.         READ
  153.         SET CURSOR OFF
  154.         SET CONFIRM OFF
  155.         RELEASE WINDOWS Posit2
  156.  
  157.         IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  158.           DO CASE
  159.             CASE lc_type = "C"
  160.               SEEK TRIM(lc_ln1)
  161.             CASE lc_type = "D"
  162.               SEEK ld_date
  163.             CASE lc_type = "L"
  164.               SEEK ll_logic
  165.             CASE lc_type = "N" .OR. lc_type = "F"
  166.               SEEK ln_num
  167.           ENDCASE
  168.         ELSE
  169.           GOTO TOP
  170.           LOOP
  171.         ENDIF
  172.  
  173.       CASE lc_option='4'{tabto(41)}&& Go to
  174.  
  175.         ln_type=1
  176.         DEFINE POPUP Posit2 FROM {ln_frow},{ln_fcol}
  177.           DEFINE BAR 1 OF Posit2 PROMPT "{posit2_bar1}" SKIP
  178.           DEFINE BAR 2 OF Posit2 PROMPT REPLICATE(CHR(196),10) SKIP
  179.           DEFINE BAR 3 OF Posit2 PROMPT "{posit2_bar3}" MESSAGE "{posit2_msg3}"
  180.           DEFINE BAR 4 OF Posit2 PROMPT "{posit2_bar4}" MESSAGE "{posit2_msg4}"
  181.           DEFINE BAR 5 OF Posit2 PROMPT "{posit2_bar5}" MESSAGE "{posit2_msg5}"
  182.         ON SELECTION POPUP Posit2 DEACTIVATE POPUP
  183.  
  184.         ACTIVATE POPUP posit2
  185.         gn_send = BAR()
  186.         ln_type = gn_send
  187.         gn_send=0
  188.         IF ln_type <> 0{tabto(41)}&& If the user selected a bar
  189.  
  190.           DO CASE
  191.  
  192.             CASE ln_type=5{tabto(41)}&& GOTO A Specific Record
  193.  
  194.               DEFINE WINDOW Posit2 FROM {ln_frow},{ln_fcol-4} TO {ln_frow+5},{ln_fcol+20} DOUBLE
  195.               ACTIVATE WINDOW Posit2
  196.               ln_num=0
  197.               @ 3,1 SAY "{posit2_wnd4}"+LTRIM(STR(RECCOUNT()))
  198.               @ 1,1 SAY "{posit2_wnd5}" GET ln_num PICT "######" RANGE 1,RECCOUNT()
  199.               SET CURSOR ON
  200.               READ
  201.               SET CURSOR OFF
  202.               IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  203.                 GOTO ln_num
  204.               ENDIF
  205.               RELEASE WINDOWS Posit2
  206.  
  207.             CASE ln_type=4{tabto(41)}&& GOTO Bottom of file
  208.               GOTO BOTTOM
  209.  
  210.             CASE ln_type=3{tabto(41)}&& GOTO Top of file
  211.               GOTO TOP
  212.  
  213.           ENDCASE
  214.  
  215.         ENDIF
  216.  
  217.       CASE lc_option='5'{tabto(41)}&& Locate
  218.  
  219.         DEFINE WINDOW Posit2 FROM {ln_frow},{ln_fcol-14} TO {ln_frow+6},{ln_fcol+36} DOUBLE
  220.         ACTIVATE WINDOW Posit2
  221.         @ 1,19 SAY "{posit2_wnd6}"
  222.         @ 1,01 SAY "{posit2_wnd7}" GET lc_scp
  223.         @ 2,01 SAY "{posit2_wnd8}" GET lc_ln2
  224.         @ 3,01 SAY "{posit2_wnd9}" GET lc_ln3
  225.         SET CURSOR ON
  226.         READ
  227.         SET CURSOR OFF
  228.  
  229.         IF .NOT. (READKEY() = 12 .OR. READKEY() = 268)
  230.           lc_temp=TRIM(lc_scp)
  231.           lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln2)) > 0," FOR "+TRIM(lc_ln2),"")
  232.           lc_temp=lc_temp + IIF(LEN(TRIM(lc_ln3)) > 0," WHILE "+TRIM(lc_ln3),"")
  233.           IF .NOT. ISBLANK( lc_temp )
  234.             LOCATE &lc_temp.
  235.             IF .NOT. EOF()
  236.               gc_scope=lc_temp
  237.             ENDIF
  238.           ELSE
  239.             DO Pause WITH "{pause_msg3}"
  240.           ENDIF
  241.         ENDIF
  242.         RELEASE WINDOW Posit2
  243.  
  244.       CASE lc_option='7'{tabto(41)}&& Change index order
  245.         DO Showtag
  246.         IF LASTKEY() = 27
  247.           LOOP
  248.         ENDIF
  249.         GOTO TOP
  250.         ln_rec=RECNO()
  251.         @ 0,00
  252.         @ 0,00 SAY "{order_msg1}"+IIF(""=ORDER(),"{order_msg2}",ORDER())
  253.  
  254.       CASE lc_option='8'{tabto(41)}&& User wants to exit
  255.         gn_send=1{tabto(41)}&& Signal end of loop
  256.  
  257.     ENDCASE
  258.  
  259.     IF EOF()
  260.       DO Pause WITH "{pause_msg4}"
  261.       GOTO ln_rec
  262.       gn_send=0
  263.     ENDIF
  264.   ENDDO
  265.   SET CURSOR ON
  266.   IF ll_deli
  267.     SET DELIMITERS ON
  268.   ENDIF
  269.   IF .NOT. ll_space
  270.     SET SPACE OFF
  271.   ENDIF
  272.   SET CONFIRM {if Set_Confrm then}ON{else}OFF{endif}
  273.   IF ISBLANK( lc_scp )
  274.     gc_scope="REST "+gc_scope
  275.   ENDIF
  276.  
  277. RETURN
  278. *--EOP: Position
  279.  
  280. PROCEDURE Showtag
  281. *{replicate("-",69)}
  282. * Display a list of tags for the current file
  283. *{replicate("-",69)}
  284.   PRIVATE cnt, idxexp, length
  285.  
  286.   cnt    = 1{tabto(41)}&& Count of index tags
  287.   idxexp = ""{tabto(41)}&& Index tag expression
  288.   length = 12{tabto(41)}&& Minimum tag width
  289.  
  290.   DEFINE POPUP Showtag FROM 8,10
  291.     DEFINE BAR 1 OF Showtag PROMPT "{substr(Posit2_wnd2,1,12)}" SKIP
  292.     DEFINE BAR 3 OF Showtag PROMPT "{substr(Posit2_wnd2,14)}"
  293.  
  294.     *-- For each TAG define a menu bar
  295.     DO WHILE .NOT. ISBLANK( TAG( cnt ) )
  296.       scnt = LTRIM(STR(cnt+4)){tabto(41)}&& Add four to bar number
  297.       string = SUBSTR(TAG(cnt)+SPACE(10),1,11)+CHR(179)+" "+LEFT(KEY(cnt),47)
  298.       IF length < LEN(string){tabto(41)}&& Adjust popup width as needed
  299.         length = LEN(string)
  300.       ENDIF
  301.  
  302.       DEFINE BAR &scnt. OF Showtag PROMPT string
  303.       cnt = cnt + 1
  304.     ENDDO
  305.  
  306.     DEFINE BAR 2 OF Showtag PROMPT REPLICATE(CHR(205),length+1) SKIP
  307.     DEFINE BAR 4 OF Showtag ;
  308.       PROMPT REPLICATE(CHR(196),11)+CHR(194)+REPLICATE(CHR(196),length-11) SKIP
  309.   ON SELECTION POPUP Showtag DEACTIVATE POPUP
  310.  
  311.   IF cnt > 1{tabto(41)}&& If the DBF has tags
  312.  
  313.     xx=4{tabto(41)}&& Right arrow
  314.     DO WHILE xx = 4 .OR. xx = 19{tabto(41)}&& Ignore esacpe from arrow keys
  315.       ACTIVATE POPUP Showtag
  316.       idxexp = PROMPT()
  317.       xx=LASTKEY()
  318.     ENDDO
  319.  
  320.     IF BAR() <> 0{tabto(41)}&& If user selected a tag
  321.       IF LTRIM(RTRIM(idxexp))="{rtrim(substr(Posit2_wnd2,15))}"
  322.         SET ORDER TO
  323.       ELSE
  324.         lc_ord = TRIM(LEFT(idxexp,10))
  325.         lc_exp = TRIM(SUBSTR(idxexp,14))
  326.         SET ORDER TO &lc_ord.
  327.       ENDIF
  328.     ENDIF
  329.  
  330.   ENDIF
  331.   RELEASE POPUP Showtag
  332.  
  333. RETURN
  334. *--EOP: Showtag
  335.  
  336. FUNCTION Get_Type
  337. PARAMETER tagname
  338. *{replicate("-",69)}
  339. * Determine the type of the tag name.
  340. * Also will set the value of <keyexpr> for the calling routine.
  341. *{replicate("-",69)}
  342.   PRIVATE ll_exact, ll_talk, keytype, lc_temp, offset, ;
  343.           ln_error
  344.   
  345.   IF SET( "TALK" ) = "ON"
  346.     SET TALK OFF
  347.     ll_talk = .T.
  348.   ELSE
  349.     ll_talk = .F.
  350.   ENDIF
  351.   ll_exact = SET("EXACT") = "ON"
  352.   SET EXACT ON
  353.  
  354.   keytype  = "U"{tabto(41)}&& Assume undefined tag
  355.   lc_temp  = "U"{tabto(41)}&& Assume error occured with undefined key
  356.   offset   = 1{tabto(41)}&& Counter for tags in DBF
  357.   ndxflag  = .T.
  358.   ln_error = 0
  359.  
  360.   DO WHILE .NOT. ISBLANK( TAG( offset ) )
  361.  
  362.     IF TAG(offset) = tagname
  363.       lc_temp = TYPE( KEY( offset ) )
  364.       ln_error = 0
  365.       ON ERROR ln_error = ERROR()
  366.  
  367.       DO CASE
  368.         CASE lc_temp="C"
  369.           SEEK "A"
  370.         CASE lc_temp="D"
  371.           SEEK DATE()
  372.         CASE lc_temp="L"
  373.           SEEK .T.
  374.         CASE lc_temp="N" .OR. lc_temp="F"
  375.           SEEK 1
  376.       ENDCASE
  377.  
  378.       ON ERROR
  379.       IF ln_error = 0
  380.          keytype = lc_temp
  381.          keyexpr = KEY(offset)
  382.          EXIT
  383.       ENDIF
  384.     ENDIF
  385.  
  386.     offset = offset + 1
  387.  
  388.   ENDDO
  389.  
  390.   IF .NOT. ll_exact
  391.     SET EXACT OFF
  392.   ENDIF
  393.   IF ll_talk
  394.     SET TALK ON
  395.   ENDIF
  396.  
  397. RETURN( keytype )
  398. *--EOP: Get_Type( Tagname )
  399. // EOP AS_POSIT.COD
  400.