home *** CD-ROM | disk | FTP | other *** search
/ DOS Wares / doswares.zip / doswares / DATABASE / DBASE5 / CUA_SAMP.ZIP / CALC.PRG < prev    next >
Encoding:
Text File  |  1994-06-24  |  10.9 KB  |  336 lines
  1.  
  2. *.............................................................................
  3. *
  4. *   Program Name: CALC.PRG            Copyright: Borland International
  5. *   Date Created: 12/12/93             Language: dBASE 5.0
  6. *   Time Created: 15:02:45               Author: Borland dBASE R&D
  7. *   /brief/library.src
  8. *.............................................................................
  9.  
  10. #include "DKEYS.HDB"
  11.  
  12. #define kBell  CHR(7)
  13. #define kPoint SET("POINT")
  14.  
  15. #define ALLTRIM(kStr)  LTRIM(RTRIM(kStr))
  16.  
  17. *.........................................................
  18. * Procedure Name:   Calc
  19. * Parameters:       None
  20. * Ext Memvars:      None
  21. * Description:      Main procedure for calculator program
  22. *.........................................................
  23. PROCEDURE Calc
  24.     PRIVATE lVoid
  25.  
  26.     SET TALK OFF    
  27.  
  28.     IF TYPE( "_CmdWindow.dbCalc.Top" ) # "N"
  29.         DO DefCalc
  30.     ENDIF
  31.     
  32.     lVoid = _CmdWindow.dbCalc.bequal.SetFocus()
  33.     lVoid = _CmdWindow.dbCalc.Open()    
  34.  
  35. RETURN
  36.  
  37.  
  38. *...............................................
  39. * Procedure Name:   DefCalc
  40. * Parameters:       None
  41. * Ext Memvars:      None
  42. * Description:      Defines the calculator form
  43. *...............................................
  44. PROCEDURE DefCalc
  45.     
  46.     #include "DBCALC.DFM"
  47.     _CmdWindow.dbCalc = m->dbCalc
  48.  
  49. RETURN
  50.  
  51.  
  52. *.............................................
  53. * Procedure Name:   BuMinus
  54. * Parameters:       None
  55. * Ext Memvars:      _CmdWindow.dbCalc.e.Text
  56. * Description:      processes "+/-" key
  57. *.............................................
  58. PROCEDURE BuMinus
  59.     PRIVATE cStr, nVal
  60.     
  61.     cStr = ""
  62.     nVal = 0.0
  63.     
  64.     cStr = CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text))
  65.     nVal = VAL(m->cStr)
  66.     nVal = m->nVal * (-1)
  67.     cStr = MakeNum(m->nVal)
  68.     
  69.     _CmdWindow.dbCalc.e.Text = m->cStr
  70.  
  71. RETURN
  72.  
  73.  
  74. *.......................................................
  75. * Procedure Name:   BClear
  76. * Parameters:       None
  77. * Ext Memvars:      _CmdWindow.dbCalc
  78. * Description:      Clears the values in the calculator
  79. *.......................................................
  80. PROCEDURE BClear
  81.     PRIVATE lVoid
  82.  
  83.     _CmdWindow.dbCalc.b1.Enabled      = .T.
  84.     _Cmdwindow.dbCalc.b2.Enabled      = .T.
  85.     _Cmdwindow.dbCalc.b3.Enabled      = .T.
  86.     _Cmdwindow.dbCalc.b4.Enabled      = .T.
  87.     _Cmdwindow.dbCalc.b5.Enabled      = .T.
  88.     _Cmdwindow.dbCalc.b6.Enabled      = .T.
  89.     _Cmdwindow.dbCalc.b7.Enabled      = .T.
  90.     _Cmdwindow.dbCalc.b8.Enabled      = .T.
  91.     _Cmdwindow.dbCalc.b9.Enabled      = .T.
  92.     _Cmdwindow.dbCalc.b0.Enabled      = .T.
  93.     _Cmdwindow.dbCalc.bplus.Enabled   = .T.
  94.     _Cmdwindow.dbCalc.bequal.Enabled  = .T.
  95.     _Cmdwindow.dbCalc.bminus.Enabled  = .T.
  96.     _Cmdwindow.dbCalc.buminus.Enabled = .T.
  97.     _Cmdwindow.dbCalc.btimes.Enabled  = .T.
  98.     _Cmdwindow.dbCalc.bDec.Enabled    = .T.
  99.     _Cmdwindow.dbCalc.bdivide.Enabled = .T.
  100.  
  101.     _CmdWindow.dbCalc.lastValue =  0
  102.     _CmdWindow.dbCalc.lastKeyOp = .F.
  103.     _CmdWindow.dbCalc.lastOp    = ""
  104.     _CmdWindow.dbCalc.lDec      = .F.
  105.  
  106.     _CmdWindow.dbCalc.e.Text  =  SPACE(15) + "0"
  107. RETURN
  108.  
  109.  
  110. *...........................................
  111. * Procedure Name:   PressOp
  112. * Parameters:       None
  113. * Ext Memvars:      _CmdWindow.dbCalc
  114. * Description:      Processes operator keys 
  115. *...........................................
  116. PROCEDURE PressOp
  117. PARAMETER cKey    
  118.     PRIVATE lVoid
  119.     
  120.     IF (_CmdWindow.dbCalc.lastKeyOp) .OR. ISBLANK(_CmdWindow.dbCalc.lastOp)
  121.         _CmdWindow.dbCalc.lastValue = VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  122.     ELSE
  123.         DO CASE
  124.             CASE _CmdWindow.dbCalc.lastOp = "+"
  125.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue + VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  126.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  127.             CASE _CmdWindow.dbCalc.lastOp = "-"
  128.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue - VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  129.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  130.             CASE _CmdWindow.dbCalc.lastOp = "*"
  131.                 _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue * VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  132.                 _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  133.             CASE _CmdWindow.dbCalc.lastOp = "/"
  134.                 IF VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text))) # 0
  135.                     _CmdWindow.dbCalc.lastValue = _CmdWindow.dbCalc.lastValue / VAL(CvtPoint(ALLTRIM(_CmdWindow.dbCalc.e.Text)))
  136.                     _CmdWindow.dbCalc.e.Text   = MakeNum(_CmdWindow.dbCalc.lastValue)
  137.                 ELSE
  138.                     ?? kBell
  139.                     _CmdWindow.dbCalc.e.Text          = "E" + SPACE(15)
  140.                     _CmdWindow.dbCalc.b1.Enabled      = .F.
  141.                     _Cmdwindow.dbCalc.b2.Enabled      = .F.
  142.                     _Cmdwindow.dbCalc.b3.Enabled      = .F.
  143.                     _Cmdwindow.dbCalc.b4.Enabled      = .F.
  144.                     _Cmdwindow.dbCalc.b5.Enabled      = .F.
  145.                     _Cmdwindow.dbCalc.b6.Enabled      = .F.
  146.                     _Cmdwindow.dbCalc.b7.Enabled      = .F.
  147.                     _Cmdwindow.dbCalc.b8.Enabled      = .F.
  148.                     _Cmdwindow.dbCalc.b9.Enabled      = .F.
  149.                     _Cmdwindow.dbCalc.b0.Enabled      = .F.
  150.                     _Cmdwindow.dbCalc.bplus.Enabled   = .F.
  151.                     _Cmdwindow.dbCalc.bequal.Enabled  = .F.
  152.                     _Cmdwindow.dbCalc.bminus.Enabled  = .F.
  153.                     _Cmdwindow.dbCalc.buminus.Enabled = .F.
  154.                     _Cmdwindow.dbCalc.btimes.Enabled  = .F.
  155.                     _Cmdwindow.dbCalc.bDec.Enabled    = .F.
  156.                     _Cmdwindow.dbCalc.bdivide.Enabled = .F.
  157.                 ENDIF
  158.         ENDCASE
  159.     ENDIF
  160.     
  161.     _CmdWindow.dbCalc.lastKeyOp = .T.
  162.     
  163.     IF TYPE("cKey") = "C"
  164.         _CmdWindow.dbCalc.lastOp = m->cKey
  165.     ELSE    
  166.         _CmdWindow.dbCalc.lastOp = RIGHT(ALLTRIM(This.Text), 1)
  167.     ENDIF    
  168.     
  169.     IF _CmdWindow.dbCalc.lastOp = "="
  170.         _CmdWindow.dbCalc.lastOp = ""
  171.     ENDIF
  172. RETURN        
  173.  
  174.  
  175. *.......................................................
  176. * Procedure Name:   NumClick
  177. * Parameters:       None
  178. * Ext Memvars:      _CmdWindow.dbCalc.e.Text
  179. * Description:      Processes numbers in the calculator
  180. *.......................................................
  181. PROCEDURE NumClick
  182. PARAMETERS cNum
  183.     PRIVATE cNStr, lVoid
  184.     
  185.     IF TYPE("cNum") # "C"
  186.         cNum = RIGHT(This.Text, 1)
  187.     ENDIF
  188.     
  189.     cNum = ALLTRIM(m->cNum)     
  190.  
  191.     IF _CmdWindow.dbCalc.lastKeyOp
  192.         IF m->cNum # kPoint
  193.             _CmdWindow.dbCalc.e.Text = MakeNum(VAL(m->cNum))
  194.             _CmdWindow.dbCalc.lDec      = .F.
  195.         ELSE
  196.             _CmdWindow.dbCalc.e.Text   = MakeNum(0)
  197.             _CmdWindow.dbCalc.lDec      = .T.
  198.         ENDIF
  199.         _CmdWindow.dbCalc.lastKeyOp = .F.        
  200.     ELSE
  201.         IF m->cNum # kPoint
  202.             cNStr = ALLTRIM(_CmdWindow.dbCalc.e.Text)
  203.  
  204.             IF (_CmdWindow.dbCalc.lDec) .AND. (.NOT.(kPoint $ m->cNStr)) .AND. (LEN(m->cNStr) < 16)
  205.                 cNStr = m->cNStr + kPoint
  206.             ENDIF
  207.             
  208.             IF LEN(m->cNStr) < 16
  209.                 IF m->cNStr == "0"
  210.                     cNStr = ""
  211.                 ENDIF    
  212.                 cNStr = m->cNStr + m->cNum
  213.             ENDIF
  214.             
  215.             _CmdWindow.dbCalc.e.Text = SPACE(16 - LEN(m->cNStr)) + m->cNStr
  216.         ELSE
  217.             _CmdWindow.dbCalc.lDec = .T.
  218.         ENDIF    
  219.     ENDIF
  220. RETURN
  221.  
  222.  
  223. *......................................
  224. * Procedure Name:   CalClose
  225. * Parameters:       None
  226. * Ext Memvars:      dbCalc
  227. * Description:      Release Calculator
  228. *......................................
  229. PROCEDURE CalClose
  230.     lVoid = _CmdWindow.dbCalc.Close()
  231.     lVoid = _CmdWindow.dbCalc.Release()
  232.     _CmdWindow.dbCalc = .F.
  233.     RELEASE dbCalc
  234. RETURN
  235.  
  236.  
  237. *............................................................
  238. * Procedure Name:   ClcAbout
  239. * Parameters:       None
  240. * Ext Memvars:      None
  241. * Description:      Displays an about box for the calculator
  242. *............................................................
  243. PROCEDURE ClcAbout
  244.     PRIVATE lVoid
  245.     
  246.     #include "CLCABOUT.DFM"
  247.     
  248.     lVoid = ClcAbout.ReadModal()
  249.     lVoid = ClcAbout.Release()
  250.     RELEASE ClcAbout
  251. RETURN    
  252.  
  253. *.........................................................................
  254. * Procedure Name:   bCopy
  255. * Parameters:       None
  256. * Ext Memvars:      _Clipboard
  257. * Description:      Copies the current value of _CmdWindow.dbCalc.e to the Clipboard
  258. *.........................................................................
  259. PROCEDURE bCopy
  260.     PRIVATE cNum
  261.     
  262.     cNum = ALLTRIM(_CmdWindow.dbCalc.e.Text)
  263.  
  264.     _Clipboard.InsertLine = m->cNum
  265.     _Clipboard.ExtendSelection = .T.
  266.     _Clipboard.Column = 1
  267.     _Clipboard.ExtendSelection = .F.
  268. RETURN
  269.     
  270.  
  271. *............................................................................
  272. * Function Name:    MakeNum
  273. * Parameters:       nVal, a numeric
  274. * Ext Memvars:      None
  275. * Return Value:     string
  276. * Description:      converts nVal to a padded string
  277. *............................................................................
  278. FUNCTION MakeNum
  279. PARAMETERS nVal
  280.     PRIVATE cStr
  281.         
  282.     cStr = ALLTRIM(STR(m->nVal, 16, 14))
  283.  
  284.     IF (kPoint $ m->cStr) .AND. (.NOT.("E" $ m->cStr))
  285.         DO WHILE RIGHT(m->cStr,1) = "0"
  286.             cStr = LEFT(m->cStr, LEN(m->cStr) - 1)
  287.         ENDDO
  288.  
  289.         IF (RIGHT(m->cStr,1) = kPoint)
  290.             cStr = LEFT(m->cStr, LEN(m->cStr) - 1)
  291.         ENDIF
  292.     ENDIF    
  293.     
  294.     cStr = SPACE(16 - LEN(m->cStr)) + m->cStr
  295. RETURN m->cStr
  296.  
  297.  
  298. *..........................................................................
  299. * Function Name:    CvtPoint
  300. * Parameters:       string of a number
  301. * Ext Memvars:      None
  302. * Return Value:     string, number with "." as decimal point
  303. * Description:      Takes a numeric string and makes sure that the decimal
  304. *                   point is a ".".  Helps the calculator work 
  305. *                   internationally.
  306. *..........................................................................
  307. FUNCTION CvtPoint
  308. PARAMETERS cStr
  309.     PRIVATE cRet
  310.     
  311.     cRet = ""
  312.         
  313.     IF (kPoint $ m->cStr) .AND. (kPoint # ".")
  314.         cRet = STUFF(m->cStr, AT(kPoint, m->cStr), 1, ".")
  315.     ELSE
  316.         cRet = m->cStr    
  317.     ENDIF
  318.     
  319. RETURN m->cRet
  320.  
  321.  
  322. *......................................................................
  323. * Procedure Name:   IDEHelp
  324. * Parameters:       None
  325. * Ext Memvars:      None
  326. * Description:      Calls the help system with current object's HelpID
  327. *......................................................................
  328. PROCEDURE IDEHelp
  329.     PRIVATE lVoid
  330.     
  331.     _SysHelp.HelpID = This.HelpID
  332.     lVoid = _SysHelp.ReadModal()
  333. RETURN    
  334.  
  335.  
  336.