home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / MISC / CONVERT / CONVERT.OPL < prev    next >
Encoding:
Text File  |  1992-03-03  |  9.6 KB  |  503 lines
  1. app Convert
  2.     icon "\opd\convert"
  3. enda
  4.  
  5. PROC convert:
  6. Rem Convert is shareware.  The right of Gareth
  7. Rem Morgan to be identified as the creator of this work
  8. Rem is asserted by him in accordance with the Copyright
  9. Rem Designs & Patent Act 1988.
  10. Rem The program may be used for 28 days, but if
  11. Rem used after that a fee of £3.00 Stg or $5.00 US
  12. Rem or the equivalent in other currencies should
  13. Rem be sent to G Morgan, Shop Farm, 
  14. Rem St Brides Major, Mid-Glam, CF32 0SF
  15. Rem Wales, UK.  All registration fees
  16. Rem will be donated to Grangetown Citizens
  17. Rem Advice Bureau.  The program may be
  18. Rem freely distributed if unaltered and
  19. Rem complete.
  20. global inp,stg,rate,m%,new%,n%,cur$(6,20),cur%(6),c%
  21. global g%,st%,def$(16)
  22. lshow%:(1,9,"Convert",13,4)
  23. lshow%:(1,9,"by Gareth Morgan",13,6)
  24. lshow%:(1,0,"(c)1992. Shareware.  See ""Info"" menu.",5,8)
  25. pause -40
  26. if exist("\dat\curr.dbf")
  27.   open "\dat\curr.dbf",A,curr$,exchge$
  28. else
  29.   create "\dat\curr.dbf",A,curr$,exchge$
  30.   update:
  31. endif
  32. scurr:
  33. gat 63,71
  34. gCLOCK ON,$31
  35. do
  36.   s::
  37.   cls
  38.   minit
  39.   mcard "Convert","To "+def$,%T,"From "+def$,%F,"Other",%O
  40.   mcard "Edit","Adjust Rates",%A,"Add Currency",%C,"Set Master",%m,"Set Defaults",%D
  41.   Mcard "Info","Show terms",%S,"Print terms",%P
  42.   mcard "Quit","Quit",%Q
  43.   m%=menu
  44.   if m%=%q or m%=0
  45.     m%=sure:
  46.     if m%=%y
  47.       stop
  48.     else
  49.       goto s::
  50.     endif    
  51.   elseif m%=%a
  52.     update:
  53.     goto s::
  54.   elseif m%=%c
  55.     add:
  56.     goto s::
  57.   elseif m%=%d
  58.     def:
  59.     goto s::
  60.   elseif m%=%m
  61.     mst:
  62.     goto s::    
  63.   elseif m%=%s
  64.     shterms:
  65.     goto s::    
  66.   elseif m%=%p
  67.     pterms:
  68.     goto s::    
  69.   elseif m%=%t or m%=%f
  70.     minit
  71.     mcard "Currency",cur$(1),cur%(1),cur$(2),cur%(2),cur$(3),cur%(3),cur$(4),cur%(4),cur$(5),cur%(5),cur$(6),cur%(6)
  72.     mcard "Return","Back to main",%Q
  73.     n%=menu
  74.     if n%=%q or n%=0
  75.       goto s::   
  76.     endif  
  77.     rate:(n%)
  78.     rate=val(a.exchge$)
  79.     if m%=%t
  80.       do
  81.         inp=0
  82.         cls
  83.         lshow%:(1,8,"Amount in "+a.curr$,3,4)
  84.         at 23,4
  85.         trap input inp
  86.         stg=inp/rate
  87.         lshow%:(1,8,"Amount in "+def$,3,6)
  88.         at 23,6
  89.         print fix$(stg,2,12)
  90.         at 20,8
  91.         print "Back to main? y/N "
  92.         cursor on
  93.         g%=get
  94.         cursor off
  95.       until g%=%y or g%=%Y
  96.     else
  97.       do
  98.         inp=0
  99.         cls
  100.         lshow%:(1,8,"Amount in "+def$,3,4)
  101.         at 23,4
  102.         trap input inp
  103.         stg=inp*rate
  104.         lshow%:(1,8,"Amount in "+a.curr$,3,6)
  105.         at 23,6
  106.         print fix$(stg,2,12)
  107.         at 20,8
  108.         print "Back to main? y/N "
  109.         cursor on
  110.         g%=get
  111.         cursor off
  112.       until g%=%y or g%=%Y
  113.     endif
  114.   else
  115.     othcur:
  116.   endif
  117. until m%=%q
  118. ENDP
  119.  
  120.  
  121. PROC SURE:
  122.   dinit "Quit Convert"
  123.   dtext "","Are you sure?"
  124.   DBUTTONS "Yes",%Y,"No",%N
  125.   return dialog
  126. ENDP
  127.  
  128. proc rate:(n%)
  129. first
  130. if N%=cur%(1)
  131.   find(cur$(1))
  132. elseif N%=cur%(2)
  133.   find(cur$(2))
  134. elseif N%=cur%(3)
  135.   find(cur$(3))
  136. elseif N%=cur%(4)
  137.   find(cur$(4))
  138. elseif N%=cur%(5)
  139.   find(cur$(5))
  140. elseif N%=cur%(6)
  141.   find(cur$(6))
  142. endif
  143. endp
  144.  
  145. proc update:
  146. local u%,fl
  147. do
  148.   cls
  149.   minit
  150.   mcard "Currency",cur$(1),cur%(1),cur$(2),cur%(2),cur$(3),cur%(3),cur$(4),cur%(4),cur$(5),cur%(5),cur$(6),cur%(6)
  151.   mcard "Back","Return to Main",%Q
  152.   u%=menu
  153.   first
  154.   if u%=%q or u%=0
  155.     return
  156.   elseif u%=cur%(1)
  157.     find(cur$(1))
  158.   elseif u%=cur%(2)
  159.     find(cur$(2))
  160.   elseif u%=cur%(3)
  161.     find(cur$(3))
  162.   elseif u%=cur%(4)
  163.     find(cur$(4))
  164.   elseif u%=cur%(5)
  165.     find(cur$(5))
  166.   elseif u%=cur%(6)
  167.     find(cur$(6))
  168.   endif
  169.   fl=val(a.exchge$)
  170.   dINIT "Update rates"
  171.   dtext "Current rate",a.exchge$
  172.   dFLOAT fl,a.curr$,0,5000
  173.   n%=DIALOG
  174.   Rem if escape pressed
  175.   if n%=0
  176.     return
  177.   endif
  178.   a.exchge$=gen$(fl,9)
  179.   update
  180. until u%=%q
  181. endp
  182.  
  183. proc add:
  184.   local fl,nc$(12),r%
  185.   rem Procedure for adding currency
  186.   dINIT "Add Currency"
  187.   dedit nc$,"New Currency"
  188.   dFLOAT fl,"Rate",0,5000
  189.   n%=DIALOG
  190.   Rem if escape pressed
  191.   if n%=0
  192.     return
  193.   endif  
  194.   first
  195.   if find(nc$)
  196.     r%=ALERT(nc$+" found","Replace entry?","Cancel","Replace")
  197.     if r%=2
  198.       a.exchge$=gen$(fl,9)
  199.       a.curr$=nc$
  200.       update
  201.     endif  
  202.   else
  203.     a.exchge$=gen$(fl,9)
  204.     a.curr$=nc$
  205.     append
  206.   endif
  207. endp
  208.  
  209. proc othcur:
  210. local a%,b%,f,t,t$(10),f$(10)
  211. a%=curmen%:("From")
  212. first
  213. if a%=%q or a%=0
  214.   return
  215. elseif a%=cur%(1)
  216.   find(cur$(1))
  217. elseif a%=cur%(2)
  218.   find(cur$(2))
  219. elseif a%=cur%(3)
  220.   find(cur$(3))
  221. elseif a%=cur%(4)
  222.   find(cur$(4))
  223. elseif a%=cur%(5)
  224.   find(cur$(5))
  225. elseif a%=cur%(6)
  226.   find(cur$(6))
  227. else
  228.   print "No find"
  229.   get
  230. endif
  231. f=val(a.exchge$)
  232. f$=a.curr$
  233. b%=curmen%:("To")
  234. first
  235. if b%=%q or b%=0
  236.   return
  237. elseif b%=cur%(1)
  238.   find(cur$(1))
  239. elseif b%=cur%(2)
  240.   find(cur$(2))
  241. elseif b%=cur%(3)
  242.   find(cur$(3))
  243. elseif b%=cur%(4)
  244.   find(cur$(4))
  245. elseif b%=cur%(5)
  246.   find(cur$(5))
  247. elseif b%=cur%(6)
  248.   find(cur$(6))
  249. else
  250.   print "No find"
  251.   get  
  252. endif
  253. t=val(a.exchge$)
  254. t$=a.curr$
  255. do
  256.   inp=0
  257.   cls
  258.   lshow%:(1,8,"Amount in "+f$,3,4)
  259.   at 23,4
  260.   trap input inp
  261.   stg=inp*t/f
  262.   lshow%:(1,8,"Amount in "+t$,3,6)
  263.   at 23,6
  264.   print fix$(stg,2,12)
  265.   at 20,8
  266.   print "Back to main? y/N "
  267.   cursor on
  268.   g%=get
  269.   cursor off
  270. until g%=%y or g%=%Y
  271. endp
  272.  
  273.  
  274.  
  275. proc curmen%:(a$)
  276. local z%
  277. cls
  278. minit
  279. mcard a$,cur$(1),cur%(1),cur$(2),cur%(2),cur$(3),cur%(3),cur$(4),cur%(4),cur$(5),cur%(5),cur$(6),cur%(6)
  280. mcard "Back","Return to Main",%Q
  281. z%=menu
  282. return z%
  283. endp
  284.  
  285. proc lshow%:(fontid%,style%,text$,x%,y%)
  286.   gfont fontID%
  287.   gstyle style%
  288.   gat ((x%-1)*6),(y%*9)-2
  289.   gprint text$
  290. endp
  291.  
  292. proc def:
  293. local r%,rc%,a$(255),ch%,b$(255),c$(1),ck%,p%(32)
  294. local Master$(16)
  295. b$=""
  296. first
  297. find("Master")
  298. do
  299.  r%=r%+1
  300. until mid$(a.curr$,r%,1)=":"
  301. master$=left$(a.curr$,r%-1)
  302. first
  303. while (a.exchge$="Master") or (a.curr$=master$)
  304.   next
  305. endwh
  306. a$=a.curr$
  307. p%(1)=pos
  308. rc%=2
  309. do 
  310.   next
  311.   if (a.exchge$<>"Master") and (a.exchge$<>"")  and (a.curr$<>def$) and (a.curr$<>master$)
  312.     a$=a$+","+a.curr$
  313.     p%(rc%)=pos
  314.     rc%=rc%+1
  315.   endif
  316. until eof
  317. ch%=1
  318. do
  319.   j::
  320.   r%=1
  321.   c$=""
  322.   dinit "Default Currencies"
  323.   dchoice r%,"Currency "+gen$(ch%,1),a$
  324.   dedit c$,"Hot Key"
  325.   ck%=dialog
  326.   Rem if escape pressed
  327.   if ck%=0
  328.     return
  329.   endif
  330.   c$=lower$(c$)
  331.   position p%(r%)
  332.   ck%=1
  333.   if len(b$)>len(a.curr$)
  334.     do
  335.       if mid$(b$,ck%,len(a.curr$)+2)=":"+a.curr$+":"
  336.         alert("Currency "+a.curr$+" already","loaded.")
  337.         goto j::
  338.       endif
  339.       ck%=ck%+1  
  340.     until ck%=len(b$)-len(a.curr$)
  341.   endif
  342.   ck%=1  
  343.   if len(b$)>3
  344.     do
  345.       if (mid$(b$,ck%,3)=":"+c$+":") or (c$="q")
  346.         alert("Hot key "+c$+" already","in use.")
  347.         goto j::
  348.       endif
  349.       ck%=ck%+1  
  350.     until ck%=len(b$)-2
  351.   endif
  352.   if c$=""
  353.     alert("Hot key must","be entered.")
  354.     goto j::
  355.   endif
  356.   b$=b$+":"+a.curr$+":"+c$
  357.   ch%=ch%+1
  358. until ch%=7
  359. first
  360. find("Master")
  361. a.curr$=master$+b$
  362. update
  363. scurr:
  364. endp
  365.  
  366. proc mst:
  367. local r%,rc%,a$(255),ch%,ck%,n$(16),b$(255),old,p%(32)
  368. local loop%,last%
  369. last
  370. last%=pos
  371. first
  372. if a.exchge$<>"Master"
  373.   a$=a.curr$
  374. else
  375.   next
  376.   a$=a.curr$
  377. endif
  378. p%(1)=pos
  379. rc%=2
  380. do 
  381.   next
  382.   if (a.exchge$<>"Master") and (a.exchge$<>"")  and (a.curr$<>def$)
  383.     a$=a$+","+a.curr$
  384.     p%(rc%)=pos
  385.     rc%=rc%+1
  386.   endif
  387. until eof
  388. ALERT("All currencies will be converted to","the rate against new Master")
  389. r%=1
  390. dinit "Master Currency" 
  391. dchoice r%,"Currency ",a$
  392. rc%=dialog
  393. Rem if escape pressed
  394. if rc%=0
  395.   return
  396. endif
  397.    
  398. position p%(r%)
  399. n$=a.curr$
  400. old=val(a.exchge$)
  401. a.exchge$="1.000"
  402. update
  403. def$=n$
  404. first
  405. find("Master")
  406. b$=a.curr$
  407. ck%=1
  408. do
  409.   ck%=ck%+1
  410. until mid$(b$,ck%,1)=":"
  411. a.curr$=n$+right$(b$,len(b$)-(ck%-1))
  412. update
  413. def:
  414. rem adjust rates for new master
  415. busy "Converting rates",2
  416. first
  417. loop%=1
  418. do
  419.   if (a.curr$<>def$) and (a.exchge$<>"Master")
  420.     a.exchge$=fix$(val(a.exchge$)/old,6,12)
  421.     update
  422.   endif
  423.   position 1
  424.   loop%=loop%+1
  425.   if a.exchge$="Master"
  426.     position 2
  427.   endif
  428. until loop%=last%
  429. busy off
  430. endp
  431.  
  432. proc scurr:
  433. Rem Find master record and load the
  434. Rem default currency and up to 6
  435. Rem conversions
  436. first
  437. find("Master")
  438. c%=1
  439. do
  440.  cur$(c%)=""
  441.  c%=c%+1
  442. until c%=7
  443. c%=1
  444. st%=1
  445. def$=""
  446. do
  447.   def$=def$+MID$(a.curr$,st%,1)
  448.   st%=st%+1
  449. until mid$(a.curr$,st%,1)=":"
  450. st%=st%+1
  451. do
  452.   do
  453.     cur$(c%)=cur$(c%)+MID$(a.curr$,st%,1)
  454.     st%=st%+1
  455.   until mid$(a.curr$,st%,1)=":"
  456.   st%=st%+1
  457.   cur%(c%)=asc(MID$(a.curr$,st%,1))
  458.   st%=st%+2
  459.   c%=c%+1
  460. until c%=7
  461. endp
  462.  
  463. proc Shterms:
  464. gCLOCK OFF
  465. cls
  466. print "Convert is shareware and copyrighted"
  467. print "The program may be used for 28 days"
  468. print "After that a fee of £3 Stg or $5 US"
  469. print "or the equivalent should be sent to"
  470. print "G Morgan, Shop Farm, St Brides Major" 
  471. print "Mid-Glam, CF32 0SF Wales, UK."
  472. print "All registration fees go to Grangetown"
  473. print "Citizens Advice Bureau. The program "
  474. print "may be copied if unaltered and complete."
  475. PAUSE 0
  476. get
  477. gat 63,71
  478. gCLOCK ON,$31
  479. endp
  480.  
  481. proc pterms:
  482. Busy "Printing"
  483. trap LOPEN "PAR:A"
  484. if err=-41
  485.   busy off
  486.   alert("No printer attached","Please connect before printing")
  487.   return
  488. endif
  489. lprint "   Convert by Gareth Morgan"
  490. lprint "Convert is shareware and copyrighted"
  491. lprint "The program may be used for 28 days"
  492. lprint "After that a fee of £3 Stg or $5 US"
  493. lprint "or the equivalent should be sent to"
  494. lprint "G Morgan, Shop Farm, St Brides Major" 
  495. lprint "Mid-Glam, CF32 0SF Wales, UK."
  496. lprint "All registration fees go to Grangetown"
  497. lprint "Citizens Advice Bureau. The program "
  498. lprint "may be copied if unaltered and complete."
  499. lclose
  500. busy off
  501. endp
  502.  
  503.