home *** CD-ROM | disk | FTP | other *** search
/ PC Plus SuperCD (UK) 1996 May / PCPLUS115.ISO / pcplus / delphi / calc3 / calc3.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-01-02  |  8.3 KB  |  333 lines
  1. unit Calc3;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, StdCtrls;
  8.  
  9. type
  10.   TCalcForm = class(TForm)
  11.     DisplayEd: TEdit;
  12.     Btn8: TButton;
  13.     Btn6: TButton;
  14.     Btn4: TButton;
  15.     Btn2: TButton;
  16.     Btn0: TButton;
  17.     Btn9: TButton;
  18.     Btn7: TButton;
  19.     Btn5: TButton;
  20.     Btn3: TButton;
  21.     Btn1: TButton;
  22.     BtnEquals: TButton;
  23.     BtnDiv: TButton;
  24.     BtnMult: TButton;
  25.     BtnMinus: TButton;
  26.     BtnPlus: TButton;
  27.     BtnDot: TButton;
  28.     ClearBtn: TButton;
  29.     procedure Btn0Click(Sender: TObject);
  30.     procedure Btn1Click(Sender: TObject);
  31.     procedure Btn2Click(Sender: TObject);
  32.     procedure Btn3Click(Sender: TObject);
  33.     procedure Btn4Click(Sender: TObject);
  34.     procedure Btn5Click(Sender: TObject);
  35.     procedure Btn6Click(Sender: TObject);
  36.     procedure Btn7Click(Sender: TObject);
  37.     procedure Btn8Click(Sender: TObject);
  38.     procedure Btn9Click(Sender: TObject);
  39.     procedure ClearBtnClick(Sender: TObject);
  40.     procedure FormActivate(Sender: TObject);
  41.     procedure BtnPlusClick(Sender: TObject);
  42.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  43.     procedure BtnEqualsClick(Sender: TObject);
  44.     procedure BtnDivClick(Sender: TObject);
  45.     procedure BtnMultClick(Sender: TObject);
  46.     procedure BtnMinusClick(Sender: TObject);
  47.     procedure BtnDotClick(Sender: TObject);
  48.   private
  49.     { Private declarations }
  50.     EnterNewFigures: boolean;{ flag if new number is being entered }
  51.     { The following Methods aren't event-handlers and are
  52.     not bound to specific visual objects }
  53.     procedure UpdateResult( newOp : char );
  54.     procedure AppendNumber( numCh : char );
  55.     procedure ReInit;
  56.  
  57.   public
  58.     { Public declarations }
  59.  
  60.   end;
  61.  
  62. { TMemory is a non-visual class which simply stores the previous value
  63. which appeared in the calculator's edit box. Say, for example, we had
  64. a TMemory object called PrevVal, we can now pick and operator, such
  65. as '+' and then enter a new value, called NewVal. When we press the
  66. '=' button (or another operator button such as '+' or '-'), the edit
  67. box can be updated to show the total of PrevVal + NewVal ).    }
  68. TMemory = class(TObject)
  69.   total : real;
  70.   function gettotal : real;
  71.   procedure settotal( r : real );
  72. end;
  73.  
  74.  
  75. { Stores the currently selected operator such as '+' or '-' }
  76. TOperation = class(TObject)
  77.   op : char;
  78.   function getop : char;
  79.   procedure setop( c : char );
  80. end;
  81.  
  82.  
  83. var
  84.   CalcForm: TCalcForm;
  85.   LastResult : TMemory;
  86.   LastOp : TOperation;
  87.  
  88. implementation
  89.  
  90. {$R *.DFM}
  91.  
  92. { Methods of the TMemory class. Set and read the internal variable }
  93. function TMemory.gettotal : real;
  94. begin
  95.  gettotal := total;
  96. end;
  97.  
  98. procedure TMemory.settotal( r : real );
  99. begin
  100.  total := r;
  101. end;
  102.  
  103.  
  104.  
  105. { Methods of the TOperation class }
  106. function TOperation.getop : char;
  107. begin
  108.  getop := op;
  109. end;
  110.  
  111. procedure TOperation.setop( c : char );
  112. begin
  113.  op := c;
  114. end;
  115.  
  116. { ------------- general-purpose routines ---------------- }
  117.  
  118. { warn user if an erroneous value has been entered - e.g. '1..5' and
  119. allows them to edit the value before continuing }
  120. procedure InputError( TE: TEdit; errcode : integer );
  121. var
  122.    Msg : string;
  123. begin
  124.     if TE.Text = '' Then
  125.        Msg := 'You must enter a value'
  126.     else
  127.        Msg :=  'Invalid character: ' + Copy(TE.Text, errcode, 1);
  128.     MessageDlg(Msg, mtError,
  129.             [mbOk], 0);
  130.     TE.SetFocus;
  131.     TE.SelStart := errcode-1;
  132.     TE.SelLength := 1;
  133. end;
  134.  
  135. { checks to see if the value in the edit box is valid. if so,
  136. the value is returned in the variable, realValue and the function
  137. returns True. Otherwise, it returns false }
  138. function CurrentNumberOK( TE: TEdit; var realValue : real ) : boolean;
  139. var
  140.  rv : real;
  141.  errcode : integer;
  142. begin
  143.    Val(TE.Text, rv, errcode);
  144.    if errcode = 0 then
  145.    begin
  146.       realValue := rv;
  147.       CurrentNumberOK := true;
  148.    end
  149.    else
  150.    begin
  151.       InputError(TE, errcode );
  152.       CurrentNumberOK := false;
  153.    end;
  154. end;
  155.  
  156. procedure TCalcForm.ReInit;
  157. { Clear memory, clear edit field }
  158. begin
  159.   DisplayEd.Text := '';
  160.   LastResult.settotal(0.0);
  161.   LastOp.setOp('+');
  162.   EnterNewFigures := true;
  163. end;
  164.  
  165. procedure TCalcForm.UpdateResult( newOp : char );
  166. { When an operator (newOp) is chosen, this method performs the current
  167. calculation and updates the Op field of the LastOp object so that
  168. this is avalable for use in the current calculation }
  169. var
  170.    lastNum : real;
  171.    lastOperator : char;
  172.    newNum : real;
  173.    total : real;
  174.    strTotal : string;
  175. begin
  176.   newNum := 0.0;
  177.  
  178. { The code in this method only executes if the contents of the
  179.   edit field are valid. If an error is encountered, nothing is done.
  180.   This gives the user the chance to correct the error before
  181.   continuing }
  182.   if CurrentNumberOK( DisplayEd, newNum ) then
  183.   begin
  184.       { retrieve the previous value and operator needed for this
  185.       calculation }
  186.     lastNum := LastResult.gettotal;
  187.     lastOperator := LastOp.getop;
  188.     { use a CASE statment to select the appropriate calculation }
  189.     case lastOperator of
  190.       '+': total := lastNum + newNum;
  191.       '-': total := lastNum - newNum;
  192.       '/': total := lastNum / newNum;
  193.       '*': total := lastNum * newNum;
  194.       else total := lastNum; { i.e. if '=' was selected}
  195.     end;
  196.     { Convert the real value, total, to the string value,
  197.       strTotal and display it in the edit box }
  198.     Str(total:2:2, strTotal );
  199.     DisplayEd.Text := strTotal;
  200.     { update the lastOp and lastResult objects,
  201.       ready for the next calculation }
  202.     lastOp.setOp( newOp );
  203.     lastResult.settotal(total);
  204.     { set the EnterNewFigures variable to true. This is used in the
  205.     AppendNumber method }
  206.     EnterNewFigures := true;
  207.   end;
  208. end;
  209.  
  210. procedure TCalcForm.AppendNumber( numCh : char );
  211. { If a calculation has just been completed, the EnterNewFigures
  212.   variable is True. So the edit box is cleared to let the user
  213.   start entering a new number. Otherwise, digits are appended
  214.   to the contents of the edit box }
  215. begin
  216.    if EnterNewFigures = true then
  217.    begin
  218.       DisplayEd.Text := '';
  219.       EnterNewFigures := false;
  220.    end;
  221.       DisplayEd.Text := DisplayEd.Text + numCh;
  222. end;
  223.  
  224. { the form's event-handling code }
  225. { Each button sends a number to be added to the edit box }
  226. procedure TCalcForm.Btn0Click(Sender: TObject);
  227. begin
  228.      AppendNumber( '0' );
  229. end;
  230.  
  231. procedure TCalcForm.Btn1Click(Sender: TObject);
  232. begin
  233.      AppendNumber( '1' );
  234. end;
  235.  
  236. procedure TCalcForm.Btn2Click(Sender: TObject);
  237. begin
  238.      AppendNumber( '2' );
  239. end;
  240.  
  241. procedure TCalcForm.Btn3Click(Sender: TObject);
  242. begin
  243.      AppendNumber( '3' );
  244. end;
  245.  
  246. procedure TCalcForm.Btn4Click(Sender: TObject);
  247. begin
  248.      AppendNumber( '4' );
  249. end;
  250.  
  251. procedure TCalcForm.Btn5Click(Sender: TObject);
  252. begin
  253.      AppendNumber( '5' );
  254. end;
  255.  
  256. procedure TCalcForm.Btn6Click(Sender: TObject);
  257. begin
  258.      AppendNumber( '6' );
  259. end;
  260.  
  261. procedure TCalcForm.Btn7Click(Sender: TObject);
  262. begin
  263.      AppendNumber( '7' );
  264. end;
  265.  
  266. procedure TCalcForm.Btn8Click(Sender: TObject);
  267. begin
  268.      AppendNumber( '8' );
  269. end;
  270.  
  271. procedure TCalcForm.Btn9Click(Sender: TObject);
  272. begin
  273.      AppendNumber( '9' );
  274. end;
  275.  
  276. procedure TCalcForm.ClearBtnClick(Sender: TObject);
  277. begin
  278.   ReInit;
  279. end;
  280.  
  281. procedure TCalcForm.FormActivate(Sender: TObject);
  282. { When the calculator is first run, we create the two
  283. objects, LastResult and LastOp and call ReInit to do some
  284. setup tasks }
  285. begin
  286.   LastResult := TMemory.Create;
  287.   LastOp := TOperation.Create;
  288.   ReInit;
  289. end;
  290.  
  291.  
  292. procedure TCalcForm.FormClose(Sender: TObject; var Action: TCloseAction);
  293. { When the calculator is closed, we 'clean up' by destroying the objects
  294. we created in the FormActivate method }
  295. begin
  296.  LastResult.Free;
  297.  LastOp.Free;
  298. end;
  299.  
  300. { The operator buttons }
  301.  
  302. procedure TCalcForm.BtnEqualsClick(Sender: TObject);
  303. begin
  304.      UpdateResult( '=' );
  305. end;
  306.  
  307. procedure TCalcForm.BtnDivClick(Sender: TObject);
  308. begin
  309.      UpdateResult( '/' );
  310. end;
  311.  
  312. procedure TCalcForm.BtnMultClick(Sender: TObject);
  313. begin
  314.      UpdateResult( '*' );
  315. end;
  316.  
  317. procedure TCalcForm.BtnPlusClick(Sender: TObject);
  318. begin
  319.      UpdateResult( '+' );
  320. end;
  321.  
  322. procedure TCalcForm.BtnMinusClick(Sender: TObject);
  323. begin
  324.      UpdateResult( '-' );
  325. end;
  326.  
  327. procedure TCalcForm.BtnDotClick(Sender: TObject);
  328. begin
  329.      AppendNumber( '.' );
  330. end;
  331.  
  332. end.
  333.