home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a106 / 2.ddi / APPSRCH.PR_ / APPSRCH.bin
Encoding:
Text File  |  1994-04-28  |  13.9 KB  |  436 lines

  1. *       ╓─────────────────────────────────────────────────────────╖
  2. *       ║                                                         ║
  3. *       ║ 12/18/92             APPSRCH.SPR               10:27:17 ║
  4. *       ║                                                         ║
  5. *       ╟─────────────────────────────────────────────────────────╢
  6. *       ║                                                         ║
  7. *       ║ Walter J. Kennamer                                      ║
  8. *       ║                                                         ║
  9. *       ║ Copyright (c) 1992 Microsoft Corp.                      ║
  10. *       ║ One Microsoft Way                                       ║
  11. *       ║ Redmond, WA  98027                                      ║
  12. *       ║                                                         ║
  13. *       ║ Description:                                            ║
  14. *       ║ This program was automatically generated by GENSCRN.    ║
  15. *       ║                                                         ║
  16. *       ╙─────────────────────────────────────────────────────────╜
  17.  
  18.  
  19. #REGION 0
  20. REGIONAL m.currarea, m.talkstat, m.compstat
  21.  
  22. IF SET("TALK") = "ON"
  23.     SET TALK OFF
  24.     m.talkstat = "ON"
  25. ELSE
  26.     m.talkstat = "OFF"
  27. ENDIF
  28. m.compstat = SET("COMPATIBLE")
  29. SET COMPATIBLE FOXPLUS
  30.  
  31. m.rborder = SET("READBORDER")
  32. SET READBORDER ON
  33.  
  34. *       ╓─────────────────────────────────────────────────────────╖
  35. *       ║                                                         ║
  36. *       ║               Windows Window definitions                ║
  37. *       ║                                                         ║
  38. *       ╙─────────────────────────────────────────────────────────╜
  39. *
  40.  
  41. IF NOT WEXIST("_qbp0meoyk")
  42.     DEFINE WINDOW _qbp0meoyk ;
  43.         AT  0.000, 0.000  ;
  44.         SIZE 6.308,50.000 ;
  45.         TITLE " Search for: " ;
  46.         FONT "MS Sans Serif", 8 ;
  47.         STYLE "B" ;
  48.         FLOAT ;
  49.         NOCLOSE ;
  50.         SHADOW ;
  51.         NOMINIMIZE ;
  52.         DOUBLE
  53.     MOVE WINDOW _qbp0meoyk CENTER
  54. ENDIF
  55.  
  56.  
  57. *       ╓─────────────────────────────────────────────────────────╖
  58. *       ║                                                         ║
  59. *       ║         APPSRCH/Windows Setup Code - SECTION 2          ║
  60. *       ║                                                         ║
  61. *       ╙─────────────────────────────────────────────────────────╜
  62. *
  63.  
  64. #REGION 1
  65. IF TYPE("srchterm") $ "UL" OR EMPTY(m.srchterm)
  66.    m.srchterm = SPACE(60)
  67. ENDIF
  68. m.oksrch = 1
  69. m.fldnum = 0
  70.  
  71. DIMENSION fldarry(10,4)   && default dimensions.  AFIELDS will reset if necessary.
  72. m.fldcnt = AFIELDS(fldarry)
  73. m.startord = ORDER()
  74. m.startalias = ALIAS()
  75.  
  76. m.curord = ORDER()
  77. IF EMPTY(m.curord)
  78.    SET ORDER TO 1
  79.    m.curord = ORDER()
  80. ENDIF
  81.  
  82. FOR i = 1 TO FCOUNT()
  83.    IF FIELDS(i) == m.curord
  84.       m.fldnum = i
  85.    ENDIF
  86. ENDFOR
  87.  
  88. IF m.fldnum > 0
  89.    m.fldname = FIELDS(m.fldnum)
  90. ELSE
  91.    SET ORDER TO 1
  92.    m.fldnum  = 1
  93.    m.fldname = FIELDS(1)
  94. ENDIF
  95.  
  96. skipvar = .T.
  97.  
  98. curs_stat = (UPPER(SET("CURSOR")) = "ON")
  99. SET CURSOR ON
  100.  
  101.  
  102. *       ╓─────────────────────────────────────────────────────────╖
  103. *       ║                                                         ║
  104. *       ║              APPSRCH/Windows Screen Layout              ║
  105. *       ║                                                         ║
  106. *       ╙─────────────────────────────────────────────────────────╜
  107. *
  108.  
  109. #REGION 1
  110. IF WVISIBLE("_qbp0meoyk")
  111.     ACTIVATE WINDOW _qbp0meoyk SAME
  112. ELSE
  113.     ACTIVATE WINDOW _qbp0meoyk NOSHOW
  114. ENDIF
  115. @ 3.462,3.000 SAY "In Field:" ;
  116.     SIZE 1.000,7.833, 0.000 ;
  117.     FONT "MS Sans Serif", 8 ;
  118.     STYLE "B"
  119. @ 1.231,11.333 GET m.srchterm ;
  120.     SIZE 1.000,26.600 ;
  121.     DEFAULT " " ;
  122.     FONT "MS Sans Serif", 8 ;
  123.     PICTURE "@S60" ;
  124.     WHEN _qbp0meq22()
  125. @ 3.231,11.167 GET fldnum ;
  126.     PICTURE "@^" ;
  127.     FROM fldarry ;
  128.     SIZE 1.538,27.000 ;
  129.     DEFAULT 1 ;
  130.     FONT "MS Sans Serif", 8 ;
  131.     VALID _qbp0meq8l()
  132. @ 0.692,37.167 GET oksrch ;
  133.     PICTURE "@*VN \!OK;\?Cancel" ;
  134.     SIZE 1.769,10.000,0.462 ;
  135.     DEFAULT 1 ;
  136.     FONT "MS Sans Serif", 8 ;
  137.     STYLE "B" ;
  138.     VALID _qbp0meqgr()
  139. @ 1.231,3.000 SAY "Find:" ;
  140.     SIZE 1.000,4.833, 0.000 ;
  141.     FONT "MS Sans Serif", 8 ;
  142.     STYLE "BT" ;
  143.     COLOR RGB(0,0,0,255,255,255)
  144.  
  145. IF NOT WVISIBLE("_qbp0meoyk")
  146.     ACTIVATE WINDOW _qbp0meoyk
  147. ENDIF
  148.  
  149.  
  150. *       ╓─────────────────────────────────────────────────────────╖
  151. *       ║                                                         ║
  152. *       ║    WindowsREAD contains clauses from SCREEN appsrch     ║
  153. *       ║                                                         ║
  154. *       ╙─────────────────────────────────────────────────────────╜
  155. *
  156.  
  157. READ CYCLE ;
  158.     ACTIVATE _qbp0mer52() ;
  159.     DEACTIVATE _qbp0mer57() ;
  160.     MODAL
  161.  
  162. RELEASE WINDOW _qbp0meoyk
  163.  
  164. #REGION 0
  165.  
  166. SET READBORDER &rborder
  167.  
  168. IF m.talkstat = "ON"
  169.     SET TALK ON
  170. ENDIF
  171. IF m.compstat = "ON"
  172.     SET COMPATIBLE ON
  173. ENDIF
  174.  
  175.  
  176. *       ╓─────────────────────────────────────────────────────────╖
  177. *       ║                                                         ║
  178. *       ║              APPSRCH/Windows Cleanup Code               ║
  179. *       ║                                                         ║
  180. *       ╙─────────────────────────────────────────────────────────╜
  181. *
  182.  
  183. #REGION 1
  184. IF curs_stat
  185.    SET CURSOR ON
  186. ELSE
  187.    SET CURSOR OFF
  188. ENDIF
  189. skipvar = .F.
  190.  
  191.  
  192.  
  193. *       ╓─────────────────────────────────────────────────────────╖
  194. *       ║                                                         ║
  195. *       ║  APPSRCH/Windows Supporting Procedures and Functions    ║
  196. *       ║                                                         ║
  197. *       ╙─────────────────────────────────────────────────────────╜
  198. *
  199.  
  200. #REGION 1
  201. FUNCTION gettag
  202. *) Returns tag number corresponding to field "fldname", or 0 if there
  203. *) is not tag with the same name as "fldname."
  204. parameter fldname
  205. PRIVATE ALL
  206. m.fldname = UPPER(ALLTRIM(m.fldname))
  207. i = 1
  208. DO WHILE !EMPTY(TAG(i)) AND i < 1000
  209.    IF UPPER(TAG(i)) == m.fldname
  210.       RETURN i
  211.    ENDIF
  212.    i = i + 1
  213. ENDDO
  214. RETURN 0
  215.  
  216.  
  217. PROCEDURE waitmsg
  218. IF RECCOUNT() > 1000
  219.    WAIT WINDOW "Searching.  This may take a few moments." NOWAIT
  220. ELSE
  221.    WAIT WINDOW "Searching" NOWAIT
  222. ENDIF
  223.  
  224.  
  225.  
  226. PROCEDURE doloc
  227. PARAMETERS term, answer
  228. * See if the user wants to do a long substring search
  229.  
  230. IF NOT WEXIST("doloc")
  231.    DEFINE WINDOW doloc ;
  232.       FROM INT((srow()-9)/2),INT((scol()-63)/2) ;
  233.       TO INT((srow()-9)/2)+9,INT((scol()-63)/2)+61 ;
  234.       TITLE "Searching Options" ;
  235.       FLOAT ;
  236.       NOCLOSE ;
  237.       SHADOW ;
  238.       DOUBLE ;
  239.       COLOR SCHEME 5
  240. ENDIF
  241.  
  242. answer = .F.
  243. ACTIVATE WINDOW doloc NOSHOW
  244.  
  245. @ 6,16 GET locok ;
  246.    PICTURE "@*HT \!\<Search;\?\<Cancel" ;
  247.    SIZE 1.769,12.0,4.0 ;
  248.    DEFAULT 1
  249. @ 1,1 SAY "FoxApp was not able to find a record matching your search"
  250. @ 2,1 SAY "term while using a fast searching method.  Do you want to"
  251. @ 3,1 SAY "search for the term with slower but more thorough methods?"
  252.  
  253. IF NOT WVISIBLE("doloc")
  254.    ACTIVATE WINDOW doloc
  255. ENDIF
  256.  
  257. READ CYCLE MODAL
  258.  
  259. RELEASE WINDOW doloc
  260. answer = (locok = 1)
  261.  
  262.  
  263. *       ╓─────────────────────────────────────────────────────────╖
  264. *       ║                                                         ║
  265. *       ║ _QBP0MEQ22           m.srchterm WHEN                    ║
  266. *       ║                                                         ║
  267. *       ║ Function Origin:                                        ║
  268. *       ║                                                         ║
  269. *       ║ From Platform:       Windows                            ║
  270. *       ║ From Screen:         APPSRCH,     Record Number:    3   ║
  271. *       ║ Variable:            m.srchterm                         ║
  272. *       ║ Called By:           WHEN Clause                        ║
  273. *       ║ Snippet Number:      1                                  ║
  274. *       ║                                                         ║
  275. *       ╙─────────────────────────────────────────────────────────╜
  276. *
  277. FUNCTION _qbp0meq22     &&  m.srchterm WHEN
  278. #REGION 1
  279. m.srchterm = PADR(m.srchterm,60)
  280. SHOW GETS
  281.  
  282.  
  283. *       ╓─────────────────────────────────────────────────────────╖
  284. *       ║                                                         ║
  285. *       ║ _QBP0MEQ8L           fldnum VALID                       ║
  286. *       ║                                                         ║
  287. *       ║ Function Origin:                                        ║
  288. *       ║                                                         ║
  289. *       ║ From Platform:       Windows                            ║
  290. *       ║ From Screen:         APPSRCH,     Record Number:    4   ║
  291. *       ║ Variable:            fldnum                             ║
  292. *       ║ Called By:           VALID Clause                       ║
  293. *       ║ Snippet Number:      2                                  ║
  294. *       ║                                                         ║
  295. *       ╙─────────────────────────────────────────────────────────╜
  296. *
  297. FUNCTION _qbp0meq8l     &&  fldnum VALID
  298. #REGION 1
  299. m.fldname = FIELDS(m.fldnum)
  300. tagnum = gettag(m.fldname)     && tag number of tag with name fldname
  301.  
  302. IF tagnum > 0
  303.    SET ORDER TO TAG(m.tagnum)
  304. ELSE
  305.    SET ORDER TO 0
  306. ENDIF
  307. SHOW GETS
  308.  
  309.  
  310. *       ╓─────────────────────────────────────────────────────────╖
  311. *       ║                                                         ║
  312. *       ║ _QBP0MEQGR           oksrch VALID                       ║
  313. *       ║                                                         ║
  314. *       ║ Function Origin:                                        ║
  315. *       ║                                                         ║
  316. *       ║ From Platform:       Windows                            ║
  317. *       ║ From Screen:         APPSRCH,     Record Number:    5   ║
  318. *       ║ Variable:            oksrch                             ║
  319. *       ║ Called By:           VALID Clause                       ║
  320. *       ║ Snippet Number:      3                                  ║
  321. *       ║                                                         ║
  322. *       ╙─────────────────────────────────────────────────────────╜
  323. *
  324. FUNCTION _qbp0meqgr     &&  oksrch VALID
  325. #REGION 1
  326. skipvar = .F.
  327. IF m.oksrch = 1 AND !EMPTY(m.srchterm)
  328.    m.srchterm = ALLTRIM(m.srchterm)
  329.    WAIT CLEAR
  330.  
  331.    m.tagnum = gettag(m.fldname)
  332.    IF m.tagnum > 0
  333.       SET ORDER TO TAG(m.tagnum)
  334.    ELSE
  335.       DO waitmsg   && warn user that this may take a while
  336.    ENDIF
  337.    m.thisrec = RECNO()
  338.    DO CASE
  339.    CASE TYPE("&fldname") $ "CM"     && character or memo field
  340.       IF m.tagnum > 0
  341.          SEEK ALLTRIM(m.srchterm)
  342.          IF !FOUND()
  343.             IF m.thisrec <= RECCOUNT() AND m.thisrec > 0
  344.                GOTO m.thisrec
  345.             ENDIF
  346.             answer = .F.
  347.             DO doloc WITH m.srchterm, m.answer   && prompt for locate
  348.  
  349.             IF m.answer = .T.
  350.                DO waitmsg
  351.                GOTO TOP
  352.                LOCATE FOR UPPER(m.srchterm) $ UPPER(&fldname)
  353.             ENDIF
  354.          ENDIF
  355.       ELSE
  356.          LOCATE FOR UPPER(m.srchterm) $ UPPER(&fldname)
  357.       ENDIF
  358.    CASE TYPE("&fldname") $ "FN"     && floating or numeric
  359.       m.srchterm = CHRTRAN(m.srchterm,'"','')
  360.       m.srchterm = CHRTRAN(m.srchterm,"'","")
  361.       LOCATE FOR VAL(ALLTRIM(m.srchterm)) = &fldname
  362.    CASE TYPE("&fldname") = "D"      && date
  363.       m.srchterm = CHRTRAN(m.srchterm,'{}"()','')
  364.       m.srchterm = CHRTRAN(m.srchterm,"'",'')
  365.       m.srchterm = ALLTRIM(m.srchterm)
  366.       LOCATE FOR CTOD(srchterm) = &fldname
  367.    CASE TYPE("&fldname") = "L"      && logical
  368.       IF "T" $ UPPER(m.srchterm)
  369.          LOCATE FOR &fldname
  370.       ELSE
  371.          LOCATE FOR !&fldname
  372.       ENDIF
  373.    CASE TYPE("&fldname") = "U"      && unknown field type--should't happen
  374.       WAIT WINDOW "Field "+m.fldname+" not found"
  375.    ENDCASE
  376.    IF !FOUND()
  377.       SET CURSOR OFF
  378.       WAIT WINDOW "Not found" NOWAIT
  379.       IF m.thisrec <= RECCOUNT() AND m.thisrec > 0
  380.          GOTO m.thisrec
  381.       ENDIF
  382.    ELSE
  383.       SET CURSOR OFF
  384.       WAIT WINDOW "Found it!" NOWAIT
  385.       CLEAR READ
  386.    ENDIF
  387. ELSE
  388.    SET ORDER TO (m.startord)
  389.    CLEAR READ
  390. ENDIF
  391.  
  392.  
  393. *       ╓─────────────────────────────────────────────────────────╖
  394. *       ║                                                         ║
  395. *       ║ _QBP0MER52           Read Level Activate                ║
  396. *       ║                                                         ║
  397. *       ║ Function Origin:                                        ║
  398. *       ║                                                         ║
  399. *       ║                                                         ║
  400. *       ║ From Platform:       Windows                            ║
  401. *       ║ From Screen:         APPSRCH                            ║
  402. *       ║ Called By:           READ Statement                     ║
  403. *       ║ Snippet Number:      4                                  ║
  404. *       ║                                                         ║
  405. *       ╙─────────────────────────────────────────────────────────╜
  406. *
  407. FUNCTION _qbp0mer52     && Read Level Activate
  408. *
  409. * Activate Code from screen: APPSRCH
  410. *
  411. #REGION 1
  412. SELECT (m.startalias)
  413.  
  414.  
  415. *       ╓─────────────────────────────────────────────────────────╖
  416. *       ║                                                         ║
  417. *       ║ _QBP0MER57           Read Level Deactivate              ║
  418. *       ║                                                         ║
  419. *       ║ Function Origin:                                        ║
  420. *       ║                                                         ║
  421. *       ║                                                         ║
  422. *       ║ From Platform:       Windows                            ║
  423. *       ║ From Screen:         APPSRCH                            ║
  424. *       ║ Called By:           READ Statement                     ║
  425. *       ║ Snippet Number:      5                                  ║
  426. *       ║                                                         ║
  427. *       ╙─────────────────────────────────────────────────────────╜
  428. *
  429. FUNCTION _qbp0mer57     && Read Level Deactivate
  430. *
  431. * Deactivate Code from screen: APPSRCH
  432. *
  433. #REGION 1
  434. ?? CHR(7)
  435. RETURN .F.
  436.