home *** CD-ROM | disk | FTP | other *** search
/ Delphi Programmer's Power Pack / Delphi Volume 1.iso / e_to_l / fbuilder / delphi / demos / calcfrm1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-09-15  |  5.0 KB  |  204 lines
  1. { FormulaBuilder                }
  2. { YGB Software, Inc.            }
  3. { Copyright 1995 Clayton Collie }
  4. { All rights reserved           }
  5.  
  6. { Demo of a calculator. Supports Variables }
  7. unit Calcfrm1;
  8. interface
  9. uses
  10.   FBCalc, FBComp,
  11.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  12.   Forms, Dialogs, Buttons, StdCtrls, ExtCtrls;
  13.  
  14. type
  15.   TcalcForm = class(TForm)
  16.     Bevel1: TBevel;
  17.     Button7: TSpeedButton;
  18.     Button8: TSpeedButton;
  19.     Button9: TSpeedButton;
  20.     Button4: TSpeedButton;
  21.     Button5: TSpeedButton;
  22.     Button6: TSpeedButton;
  23.     Button1: TSpeedButton;
  24.     Button2: TSpeedButton;
  25.     Button3: TSpeedButton;
  26.     Button0: TSpeedButton;
  27.     PlusMinusBtn: TSpeedButton;
  28.     PeriodBtn: TSpeedButton;
  29.     MultBtn: TSpeedButton;
  30.     MinusBtn: TSpeedButton;
  31.     DivBtn: TSpeedButton;
  32.     PlusBtn: TSpeedButton;
  33.     StatusPanel: TPanel;
  34.     Bevel2: TBevel;
  35.     LParenBtn: TSpeedButton;
  36.     RParenBtn: TSpeedButton;
  37.     ExponenBtn: TSpeedButton;
  38.     EqualBtn: TSpeedButton;
  39.     Bevel3: TBevel;
  40.     ExitBtn: TBitBtn;
  41.     ClearBtn: TBitBtn;
  42.     BackBtn: TBitBtn;
  43.     FormulaField: TComboBox;
  44.     VariablesBtn: TBitBtn;
  45.     Panel2: TPanel;
  46.     FunctionNames: TListBox;
  47.     CalcBtn: TBitBtn;
  48.     Expression: TExpression;
  49.     procedure Button7Click(Sender: TObject);
  50.     procedure FormCreate(Sender: TObject);
  51.     procedure PlusMinusBtnClick(Sender: TObject);
  52.     procedure ClearBtnClick(Sender: TObject);
  53.     procedure LParenBtnClick(Sender: TObject);
  54.     procedure CalcBtnClick(Sender: TObject);
  55.     procedure BackBtnClick(Sender: TObject);
  56.     procedure VariablesBtnClick(Sender: TObject);
  57.     procedure FormDestroy(Sender: TObject);
  58.     procedure FunctionNamesDblClick(Sender: TObject);
  59.     procedure EqualBtnClick(Sender: TObject);
  60.   private
  61.     { Private declarations }
  62.     Procedure DoCalculation;
  63.    public
  64.     { Public declarations }
  65.   end;
  66.  
  67.  
  68.   Procedure DisplayCalc;
  69.  
  70.   Var calcForm : TCalcForm;
  71.  
  72. implementation
  73. uses vardlg,fbmisc;
  74. {$R *.DFM}
  75.  
  76. Procedure DisplayCalc;
  77. var calcFm : TCalcForm;
  78. begin
  79.   CalcFm := TCalcForm.Create(NIL);
  80.   CalcFm.ShowModal;
  81.   CalcFm.Free;
  82. end;
  83.  
  84. Function GetFuncNames(vname    : pchar;
  85.                       vtype    : byte;
  86.                       parms    : pchar;
  87.                       minPrms  : byte;
  88.                       EnumData : longint):integer; export;
  89. var proto,tmp : string[60];
  90.     i     : integer;
  91.     list  : TStringList absolute EnumData;
  92.  
  93. begin
  94.   { Were interested only in math functions }
  95.   if not (vType in [vtInteger,vtFloat]) then exit;
  96.   tmp   := strpas(parms);
  97.   for i := 1 to length(tmp) do
  98.       if not (tmp[i] in ['I','F']) then exit;
  99.   {if pos }
  100.   Proto := ShortPrototype(strpas(vname),tmp,length(tmp),minprms);
  101.   if not Assigned(list) then
  102.      List := TStringList.Create;
  103.   List.Add( proto );
  104. end;
  105.  
  106. Function getFunctionPrototypes : TStringList;
  107. begin
  108.   Result := TStringList.Create;
  109.   FBEnumFunctions(getFuncNames,longint(Result));
  110. end;
  111.  
  112.  
  113. procedure TcalcForm.Button7Click(Sender: TObject);
  114. var s : string[4];
  115. begin
  116.   s := (Sender as TSpeedButton).Caption[2];
  117.   if pos(s,'*^+-/') > 0 then s := ' '+s+' ';
  118.   FormulaField.text := FormulaField.text + s;
  119. end;
  120.  
  121. procedure TcalcForm.FormCreate(Sender: TObject);
  122. var theList : TStringList;
  123. begin
  124.   thelist := getFunctionPrototypes;
  125.   FunctionNames.Items.AddStrings(thelist);
  126.   thelist.free;
  127. end;
  128.  
  129. Procedure TCalcForm.DoCalculation;
  130. var s : string[75];
  131. begin
  132.  if (FormulaField.text = '') then exit;
  133.   with Expression do begin
  134.      Formula := FormulaField.Text;
  135.      if Status = EXPR_SUCCESS then
  136.      begin
  137.         s := Expression.AsString;
  138.         FormulaField.items.add(FormulaField.text);
  139.        {StatusPanel.caption := '> ' + s;}
  140.         FormulaField.Text := s;
  141.      end
  142.     else
  143.       StatusPanel.caption := '> Error : ' + StatusText;
  144.   end;
  145. end;
  146.  
  147. procedure TCalcForm.PlusMinusBtnClick(Sender: TObject);
  148. begin
  149.   FormulaField.text := '-1 * (' + FormulaField.text + ')';
  150. end;
  151.  
  152. procedure TcalcForm.ClearBtnClick(Sender: TObject);
  153. begin
  154.   FormulaField.text := '';
  155. end;
  156.  
  157. procedure TcalcForm.LParenBtnClick(Sender: TObject);
  158. begin
  159.  FormulaField.text := FormulaField.text + (sender as TSpeedButton).caption[1];
  160. end;
  161.  
  162. procedure TcalcForm.CalcBtnClick(Sender: TObject);
  163. begin
  164.   DoCalculation;
  165. end;
  166.  
  167. procedure TcalcForm.BackBtnClick(Sender: TObject);
  168. var s   : string;
  169.     len : integer;
  170.  
  171. begin
  172.   s := FormulaField.Text;
  173.   len := length(s);
  174.   if (len > 0) then
  175.      FormulaField.text := copy(s,1,pred(len));
  176. end;
  177.  
  178.  
  179. procedure TcalcForm.VariablesBtnClick(Sender: TObject);
  180. begin
  181.   ManageVariables(Expression.Handle);
  182. end;
  183.  
  184. procedure TcalcForm.FormDestroy(Sender: TObject);
  185. begin
  186.   Expression.Free;
  187. end;
  188.  
  189. procedure TcalcForm.FunctionNamesDblClick(Sender: TObject);
  190. begin
  191.   with functionNames do
  192.     if ItemIndex > -1 then
  193.        FormulaField.Text := FormulaField.Text + FunctionNames.Items[ItemIndex];
  194.  
  195. end;
  196.  
  197. procedure TcalcForm.EqualBtnClick(Sender: TObject);
  198. begin
  199.   DoCalculation;
  200. end;
  201.  
  202. end.
  203.  
  204.