home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 5 / 05.iso / a / a087 / 5.ddi / UTILITY.PR_ / UTILITY.bin
Encoding:
Text File  |  1994-02-02  |  11.8 KB  |  509 lines
  1. *:*********************************************************************
  2. *:
  3. *: Procedure file: C:\ORGANIZE\UTILITY.PRG
  4. *:
  5. *:         System: Organizer Application
  6. *:         Author: Microsoft Corporation
  7. *:      Copyright (c) 1992, Microsoft Corporation
  8. *:  Last modified: 11/30/92
  9. *:
  10. *:  Procs & Fncts: SETUP
  11. *:               : CLEANUP
  12. *:               : LOCATEDB
  13. *:               : CHECKFPT
  14. *:               : STRIPEXT
  15. *:               : STRIPPATH
  16. *:               : ERRORHANDLER
  17. *:               : CLEARHLP
  18. *:               : CLOSDBFS
  19. *:               : SETCOLORS
  20. *:               : ORG2
  21. *:
  22. *:          Calls: SETCOLORS      (procedure in UTILITY.PRG)
  23. *:
  24. *:    Other Files: ORGHELP.DBF
  25. *:
  26. *:      Documented 06/01/91 at 10:52               FoxDoc  version 2.07ß
  27. *:*********************************************************************
  28.  
  29. *!*********************************************************************
  30. *!
  31. *!      Procedure: SETUP
  32. *!
  33. *!      Called by: IDLEREAD.PRG                  
  34. *!
  35. *!*********************************************************************
  36. PROCEDURE setup
  37. PRIVATE mpath
  38.  
  39. ON KEY LABEL F1 HELP
  40. CLEAR PROGRAM
  41. CLEAR GETS
  42. IF m.module <> "convert"
  43.     DO setcolors
  44. ENDIF
  45.  
  46. IF NOT FILE(m.macrosave)
  47.     SAVE MACROS TO (m.macrosave)
  48. ENDIF
  49.  
  50. CLEAR MACROS
  51.  
  52. IF WVISIBLE("command")
  53.     HIDE WINDOW "command"
  54. ENDIF
  55.  
  56. m.area = SELECT()
  57. RELEASE WINDOW 'help'
  58. SET HELP TO "orghelp.dbf"
  59. SET HELP ON
  60. SET UDFPARMS TO VALUE
  61. SET DATE AMERICAN
  62.  
  63. m.deli = SET("TEXTMERGE",1)
  64. SET TEXTMERGE DELIMITERS TO
  65. m.memow = SET("MEMOWIDTH")
  66. SET MEMOWIDTH TO 256
  67. m.escap = SET("ESCAPE")
  68. m.noti  = SET("NOTIFY")
  69. m.exact = SET("EXACT")
  70. SET EXACT ON
  71. m.safety = SET("SAFETY")
  72. SET SAFETY OFF
  73. m.deci = SET("DECIMALS")
  74. SET DECIMALS TO 18
  75. mdevice = SET("DEVICE")
  76. SET DEVICE TO SCREEN
  77. RETURN
  78.  
  79. *!*********************************************************************
  80. *!
  81. *!      Procedure: CLEANUP
  82. *!
  83. *!      Called by: IDLEREAD.PRG                  
  84. *!               : ERRORHANDLER   (procedure in UTILITY.PRG)
  85. *!
  86. *!          Calls: CLOSDBFS       (procedure in UTILITY.PRG)
  87. *!
  88. *!    Other Files: M.OLDHELP
  89. *!               : LOCFILE(M.OLDHELP,
  90. *!               : M.OLDRESO
  91. *!               : LOCFILE(M.OLDRESO,
  92. *!
  93. *!*********************************************************************
  94. PROCEDURE cleanup
  95. PRIVATE m.delilen, m.ldelimi, m.rdelimi
  96.  
  97. release window family
  98. release window accnts
  99. release window controls
  100. release window restaurs
  101. release window clients
  102. release window credit
  103. release window trans
  104. set message to
  105.  
  106. IF FILE(m.macrosave)
  107.     RESTORE MACROS FROM (m.macrosave)
  108.     DELETE FILE (m.macrosave)
  109. ENDIF
  110.  
  111. m.delilen = LEN(m.deli)
  112. m.ldelimi = SUBSTR(m.deli,1,;
  113.     IIF(MOD(m.delilen,2)=0,m.delilen/2,CEILING(m.delilen/2)))
  114. m.rdelimi = SUBSTR(m.deli,;
  115.     IIF(MOD(m.delilen,2)=0,m.delilen/2+1,CEILING(m.delilen/2)+1))
  116. SET TEXTMERGE DELIMITERS TO m.ldelimi, m.rdelimi
  117.  
  118. SELECT (m.area)
  119. IF m.escap = "ON"
  120.     SET ESCAPE ON
  121. ELSE
  122.     SET ESCAPE OFF
  123. ENDIF
  124. IF m.noti = "ON"
  125.     SET NOTIFY ON
  126. ELSE
  127.     SET NOTIFY OFF
  128. ENDIF
  129. IF m.talkstat = "ON"
  130.     SET TALK ON
  131. ENDIF
  132. IF m.exact = "OFF"
  133.     SET EXACT OFF
  134. ENDIF
  135. IF m.safety = "ON"
  136.     SET SAFETY ON
  137. ENDIF
  138. SET DECIMALS TO m.deci
  139. IF m.memow > 0
  140.     SET MEMOWIDTH TO m.memow
  141. ENDIF
  142. SET DEVICE TO &mdevice
  143. DO clearhlp
  144.  
  145. ON KEY LABEL F1
  146. ON ERROR
  147. RETURN
  148.  
  149. *!*********************************************************************
  150. *!
  151. *!      Procedure: LOCATEDB
  152. *!
  153. *!          Calls: CHECKFPT       (procedure in UTILITY.PRG)
  154. *!
  155. *!*********************************************************************
  156. FUNCTION locatedb
  157. PARAMETER m.dbf, m.fpt
  158. PRIVATE m.where, mpath, m.start, m.end
  159. IF USED(m.dbf)
  160.     SELECT (m.dbf)
  161.     RETURN .T.
  162. ENDIF
  163. IF FILE(m.dbf+".DBF")
  164.     IF NOT checkfpt(m.fpt)
  165.         RETURN .F.
  166.     ENDIF
  167. ELSE
  168.     m.where = GETFILE("DBF", "Where is "+UPPER(m.dbf)+;
  169.         " database?")
  170.     IF EMPTY(m.where)
  171.         RETURN .F.
  172.     ENDIF
  173.     mpath = SET("PATH")
  174.     mpath = mpath + IIF(EMPTY(mpath),"",";") +;
  175.         SUBSTR(m.where,1,RAT("\",m.where))
  176.     SET PATH TO &mpath
  177.     m.start = RAT("\",m.where)+1
  178.     m.end   = RAT(".",m.where)
  179.     IF LOWER(SUBSTR(m.where,m.start,m.end-m.start)) = m.dbf
  180.         IF NOT checkfpt(m.fpt)
  181.             RETURN .F.
  182.         ENDIF
  183.     ELSE
  184.         WAIT WINDOW "Incorrect databases selected" NOWAIT
  185.         RETURN .F.
  186.     ENDIF
  187. ENDIF
  188. RETURN .T.
  189.  
  190. *!*********************************************************************
  191. *!
  192. *!      Procedure: CHECKFPT
  193. *!
  194. *!      Called by: LOCATEDB       (procedure in UTILITY.PRG)
  195. *!
  196. *!*********************************************************************
  197. FUNCTION checkfpt
  198. PARAMETER m.fpt
  199. IF m.fpt = 0
  200.     SELECT 0
  201.     USE (m.dbf)
  202.     RETURN .T.
  203. ENDIF
  204. IF FILE(m.dbf+".FPT")
  205.     SELECT 0
  206.     USE (m.dbf)
  207. ELSE
  208.     WAIT WINDOW UPPER(m.dbf)+" memo file missing." NOWAIT
  209.     RETURN .F.
  210. ENDIF
  211. RETURN .T.
  212.  
  213. *!*********************************************************************
  214. *!
  215. *!      Procedure: STRIPEXT
  216. *!
  217. *!      Called by: IDLEREAD.PRG                  
  218. *!
  219. *!*********************************************************************
  220. *
  221. * STRIPEXT - Strip the extension from a file name.
  222. *
  223. * Description:
  224. * Use the algorithm employed by FoxPRO itself to strip a
  225. * file of an extension (if any): Find the rightmost dot in
  226. * the filename.  If this dot occurs to the right of a "\"
  227. * or ":", then treat everything from the dot rightward
  228. * as an extension.  Of course, if we found no dot,
  229. * we just hand back the filename unchanged.
  230. *
  231. * Parameters:
  232. * filename - character string representing a file name
  233. *
  234. * Return value:
  235. * The string "filename" with any extension removed
  236. *
  237. FUNCTION stripext
  238. PARAMETER m.filename
  239. PRIVATE m.dotpos, m.terminator
  240. m.dotpos = RAT(".", m.filename)
  241. m.terminator = MAX(RAT("\", m.filename), RAT(":", m.filename))
  242. IF m.dotpos > m.terminator
  243.     m.filename = LEFT(m.filename, m.dotpos-1)
  244. ENDIF
  245. RETURN m.filename
  246.  
  247. *!*********************************************************************
  248. *!
  249. *!      Procedure: STRIPPATH
  250. *!
  251. *!      Called by: IDLEREAD.PRG                  
  252. *!
  253. *!*********************************************************************
  254. *
  255. * STRIPPATH - Strip the path from a file name.
  256. *
  257. * Description:
  258. * Find positions of backslash in the name of the file.  If there is one
  259. * take everything to the right of its position and make it the new file
  260. * name.  If there is no slash look for colon.  Again if found, take
  261. * everything to the right of it as the new name.  If neither slash
  262. * nor colon are found then return the name unchanged.
  263. *
  264. * Parameters:
  265. * filename - character string representing a file name
  266. *
  267. * Return value:
  268. * The string "filename" with any path removed
  269. *
  270. FUNCTION strippath
  271. PARAMETER m.filename
  272. PRIVATE m.slashpos, m.namelen, m.colonpos
  273. m.slashpos = RAT("\", m.filename)
  274. IF m.slashpos <> 0
  275.     m.namelen  = LEN(m.filename) - m.slashpos
  276.     m.filename = RIGHT(m.filename, m.namelen)
  277. ELSE
  278.     m.colonpos = RAT(":", m.filename)
  279.     IF m.colonpos <> 0
  280.         m.namelen  = LEN(m.filename) - m.colonpos
  281.         m.filename = RIGHT(m.filename, m.namelen)
  282.     ENDIF
  283. ENDIF
  284. RETURN m.filename
  285.  
  286. *!*********************************************************************
  287. *!
  288. *!      Procedure: ERRORHANDLER
  289. *!
  290. *!      Called by: IDLEREAD.PRG                  
  291. *!
  292. *!          Calls: CLEARHLP       (procedure in UTILITY.PRG)
  293. *!               : CLEANUP        (procedure in UTILITY.PRG)
  294. *!               : CLOSDBFS       (procedure in UTILITY.PRG)
  295. *!
  296. *!*********************************************************************
  297. PROCEDURE errorhandler
  298. PARAMETER m.messg, m.lineno
  299. PRIVATE m.fromrow, m.fromcol, m.torow, m.tocol
  300.  
  301. DO CASE 
  302. CASE ERROR() = 216
  303.     *
  304.     * Extended display mode not available.
  305.     *
  306.     WAIT WINDOW "Extended mode not available" NOWAIT
  307.     RETURN
  308. CASE ERROR() = 109
  309.     *
  310.     * Record in use by another.
  311.     *
  312.     WAIT WINDOW "Attempt to LOCK record Aborted" NOWAIT
  313.     m.islocked = .T.
  314.     SHOW GETS
  315.     RETURN
  316. CASE ERROR() = 108
  317.     *
  318.     * File is in use by another.
  319.     * Can also be a result of collision in APPEND BLANK.
  320.     *
  321.     RETRY
  322. CASE ERROR() = 202 AND (WONTOP('labels') OR WONTOP('reports'))
  323.     WAIT WINDOW 'Invalid path or file name' NOWAIT
  324.     RETURN
  325. ENDCASE
  326.  
  327. m.fromrow = INT((SROW()-6)/2)
  328. m.fromcol = INT((SCOL()-50)/2)
  329. m.torow   = m.fromrow + 6
  330. m.tocol   = m.fromcol + 50
  331.  
  332. DEFINE WINDOW alert;
  333.     FROM m.fromrow, m.fromcol TO m.torow, m.tocol;
  334.     FLOAT NOGROW NOCLOSE NOZOOM    SHADOW DOUBLE;
  335.     COLOR SCHEME 7
  336.  
  337. ACTIVATE WINDOW alert
  338.  
  339. @ 0,0 CLEAR
  340. @ 1,0 SAY PADC(ALLTRIM(m.messg), WCOLS())
  341. IF NOT EMPTY(m.lineno)
  342.     @ 2,0 SAY PADC("Program: "+Program(1)+;
  343.         " Line Number: "+STR(m.lineno, 4), WCOLS())
  344. ENDIF
  345. @ 3,0 SAY PADC("Press any key to cleanup and exit...", WCOLS())
  346. WAIT ""
  347.  
  348. POP MENU _MSYSMENU
  349.  
  350. DO clearhlp
  351. DO cleanup
  352. SET COLOR OF SCHEME 1 TO
  353.  
  354. CLEAR READ ALL
  355. CLEAR WINDOWS
  356. DO closdbfs
  357.  
  358. ON ERROR
  359. ON ESCAPE
  360. ON KEY LABEL F1
  361. CANCEL
  362. RETURN
  363.  
  364. *!*********************************************************************
  365. *!
  366. *!      Procedure: CLEARHLP
  367. *!
  368. *!      Called by: ERRORHANDLER   (procedure in UTILITY.PRG)
  369. *!
  370. *!           Uses: OLDHELP.DBF    
  371. *!               : OLDRESO.DBF    
  372. *!
  373. *!    Other Files: LOCFILE(OLDHELP,
  374. *!               : LOCFILE(OLDRESO,
  375. *!
  376. *!*********************************************************************
  377. *
  378. * CLEARHLP
  379. *
  380. PROCEDURE clearhlp
  381. IF NOT EMPTY(m.oldhelp)
  382.     RELEASE WINDOW 'HELP'
  383.     SET HELP TO LOCFILE(m.oldhelp, "DBF", "Where is "+m.oldhelp+" help file?")
  384.     IF m.helpset = "ON"
  385.         SET HELP ON
  386.     ELSE
  387.         SET HELP OFF
  388.     ENDIF
  389. ELSE
  390.     SET HELP OFF
  391. ENDIF
  392. IF NOT EMPTY(m.oldreso)
  393. *    SET RESO TO LOCFILE(m.oldreso, "DBF", "Where is "+m.oldreso+" resource file?")
  394. ENDIF
  395. IF m.hidecomm
  396.     SHOW WINDOW "Command"
  397. ENDIF
  398. IF m.resoset = "OFF"
  399.     SET RESOURCE OFF
  400. ELSE
  401.     SET RESOURCE ON
  402. ENDIF
  403. RETURN
  404.  
  405. *!*********************************************************************
  406. *!
  407. *!      Procedure: CLOSDBFS
  408. *!
  409. *!      Called by: CLEANUP        (procedure in UTILITY.PRG)
  410. *!               : ERRORHANDLER   (procedure in UTILITY.PRG)
  411. *!
  412. *!*********************************************************************
  413. PROCEDURE closdbfs
  414. IF USED('factors')
  415.     SELECT factors
  416.     USE
  417. ENDIF
  418. IF USED('units')
  419.     SELECT units
  420.     USE
  421. ENDIF
  422. IF USED('clients')
  423.     SELECT clients
  424.     USE
  425. ENDIF
  426. IF USED('personal')
  427.     SELECT personal
  428.     USE
  429. ENDIF
  430. IF USED('details')
  431.     SELECT details
  432.     USE
  433. ENDIF
  434. IF USED('reports')
  435.     SELECT reports
  436.     USE
  437. ENDIF
  438. IF USED('restaurs')
  439.     SELECT restaurs
  440.     USE
  441. ENDIF
  442. IF USED('labels')
  443.     SELECT labels
  444.     USE
  445. ENDIF
  446. IF USED('credcard')
  447.     SELECT credcard
  448.     USE
  449. ENDIF
  450. IF USED('carduser')
  451.     SELECT carduser
  452.     USE
  453. ENDIF
  454. IF USED('letters')
  455.     SELECT letters
  456.     USE
  457. ENDIF
  458. IF USED('cards2')
  459.     SELECT cards2
  460.     USE
  461. ENDIF
  462. RETURN
  463.  
  464. *!*********************************************************************
  465. *!
  466. *!      Procedure: SETCOLORS
  467. *!
  468. *!      Called by: UTILITY.PRG                   
  469. *!
  470. *!*********************************************************************
  471. *
  472. * SETCOLORS - Set background color of controls in COLOR SCHEME 1.
  473. *
  474. * Description:
  475. * In order to make the hot keys on controls appear more distinctly
  476. * change the background color of hot keys to match the
  477. * background color of the enabled controls.
  478. *
  479. PROCEDURE setcolors
  480. PRIVATE m.colors, m.sixth, m.seventh, m.eigth, ;
  481.     m.nineth, pair7, pair9, m.background, m.forground
  482.  
  483. m.colors = SCHEME(1)
  484.  
  485. m.sixth  = AT(',',m.colors, 6)
  486. m.seventh= AT(',',m.colors, 7)
  487. m.eigth  = AT(',',m.colors, 8)
  488. m.nineth = AT(',',m.colors, 9)
  489.  
  490. m.pair7  = SUBSTR(m.colors,m.sixth+1,m.seventh-m.sixth-1)
  491. m.pair9  = SUBSTR(m.colors,m.eigth+1,m.nineth-m.eigth-1)
  492.  
  493. m.background = SUBSTR(pair9,AT('/',pair9)+1)
  494. m.pair7  = STUFF(pair7,AT('/',pair7)+1,LEN(pair7),"") + m.background
  495.  
  496. IF pair7 = pair9                                 && i.e., forground colors are same
  497.     m.forground = SUBSTR(pair7,1,AT('/',pair7)-1)
  498.     IF m.forground <> 'W+'
  499.         pair7 = 'W+/'+m.background
  500.     ELSE
  501.         pair7 = 'R+/'+m.background
  502.     ENDIF
  503. ENDIF
  504.  
  505. SET COLOR OF SCHEME 1 TO ,,,,,,&pair7
  506. RETURN
  507.  
  508. *: EOF: UTILITY.PRG
  509.