home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 October / Chip_2001-10_cd1.bin / zkuste / delphi / kompon / d123456 / CHEMPLOT.ZIP / TPlot / Functons.pas < prev    next >
Pascal/Delphi Source File  |  2001-07-24  |  8KB  |  253 lines
  1. unit Functons;
  2.  
  3. {$I Plot.inc}
  4.  
  5. {-----------------------------------------------------------------------------
  6. The contents of this file are subject to the Q Public License
  7. ("QPL"); you may not use this file except in compliance
  8. with the QPL. You may obtain a copy of the QPL from 
  9. the file QPL.html in this distribution, derived from:
  10.  
  11. http://www.trolltech.com/products/download/freelicense/license.html
  12.  
  13. The QPL prohibits development of proprietary software. 
  14. There is a Professional Version of this software available for this. 
  15. Contact sales@chemware.hypermart.net for more information.
  16.  
  17. Software distributed under the QPL is distributed on an "AS IS" basis,
  18. WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the QPL for
  19. the specific language governing rights and limitations under the QPL.
  20.  
  21. The Original Code is: Functions.pas, released 12 April 2001.
  22.  
  23. The Initial Developer of the Original Code is Mat Ballard.
  24. Portions created by Mat Ballard are Copyright (C) 1999 Mat Ballard.
  25. Portions created by Microsoft are Copyright (C) 1998, 1999 Microsoft Corp.
  26. All Rights Reserved.
  27.  
  28. Contributor(s): Mat Ballard                 e-mail: mat.ballard@chemware.hypermart.net.
  29.  
  30. Last Modified: 03/04/2001
  31. Current Version: 2.00
  32.  
  33. You may retrieve the latest version of this file from:
  34.  
  35.         http://Chemware.hypermart.net/
  36.  
  37. This work was created with the Project JEDI VCL guidelines:
  38.  
  39.         http://www.delphi-jedi.org/Jedi:VCLVCL
  40.  
  41. in mind. 
  42.  
  43. Purpose:
  44. To create new series from existing series using mathematical expressions.
  45.  
  46. Known Issues: This requires FUNCTIONS to be defined in Plot.inc, and for the
  47.   TParser10 to be installed in the TPlot/Parser10 subdirectory.
  48. -----------------------------------------------------------------------------}
  49.  
  50. interface
  51.  
  52. uses
  53.   Classes, SysUtils,
  54. {$IFDEF WINDOWS}
  55.   WinTypes, WinProcs,
  56.   Buttons, Controls, Forms, Graphics, StdCtrls,
  57. {$ENDIF}
  58. {$IFDEF WIN32}
  59.   Windows,
  60.   Buttons, Controls, Forms, Graphics, StdCtrls,
  61. {$ENDIF}
  62. {$IFDEF LINUX}
  63.   QButtons, QControls, QForms, QGraphics, QStdCtrls,
  64. {$ENDIF}
  65.   Parser10,
  66.  
  67.   Misc, Plotdefs;
  68.  
  69. type
  70.   TFunctionsForm = class(TForm)
  71.     HelpBitBtn: TBitBtn;
  72.     CancelBitBtn: TBitBtn;
  73.     OKBitBtn: TBitBtn;
  74.     SeriesLabel: TLabel;
  75.     FunctionMemo: TMemo;
  76.     FunctionComboBox: TComboBox;
  77.     InsertBitBtn: TBitBtn;
  78.     FunctionHintLabel: TLabel;
  79.     TestBitBtn: TBitBtn;
  80.     procedure FormCreate(Sender: TObject);
  81.     procedure InsertBitBtnClick(Sender: TObject);
  82.     procedure FunctionComboBoxClick(Sender: TObject);
  83.     procedure TestBitBtnClick(Sender: TObject);
  84.   private
  85.     { Private declarations }
  86.   public
  87.     SeriesCount: Integer;
  88. {You have to set the SeriesCount for Test-ing to work}
  89. {$IFNDEF LANG_ENGLISH}
  90.     procedure DoCaptionsFromResource;
  91. {$ENDIF}
  92.     procedure DoHintsFromResource;
  93.   end;
  94.  
  95. var
  96.   FunctionsForm: TFunctionsForm;
  97.  
  98. implementation
  99.  
  100. {$R *.dfm}
  101.  
  102. const
  103.   FUNCTION_MAX = 30;
  104.   {Functions: array [0..FUNCTION_MAX] of string =
  105.     ['PI', 'COS', 'SIN', 'SINH', 'COSH',
  106.     'TAN', 'COTAN', 'ARCTAN', 'ARG', 'EXP',
  107.     'LN', 'LOG10', 'LOG2', 'LOGN', 'SQRT',
  108.     'SQR', 'POWER', 'INTPOWER', 'MIN', 'MAX',
  109.     'ABS', 'TRUNC', 'INT', 'CEIL', 'FLOOR',
  110.     'HEAV', 'SIGN', 'ZERO', 'PH', 'RND',
  111.     'RANDOM'];}
  112.  
  113.   FunctionHints: array [0..FUNCTION_MAX] of string =
  114.      (sFHint0, sFHint1, sFHint2, sFHint3, sFHint4,
  115.       sFHint5, sFHint6, sFHint7, sFHint8, sFHint9,
  116.       sFHint10, sFHint11, sFHint12, sFHint13, sFHint14,
  117.       sFHint15, sFHint16, sFHint17, sFHint18, sFHint19,
  118.       sFHint20, sFHint21, sFHint22, sFHint23, sFHint24,
  119.       sFHint25, sFHint26, sFHint27, sFHint28, sFHint29,
  120.       sFHint30);
  121.  
  122.  
  123. {------------------------------------------------------------------------------
  124.     Procedure: TFunctionsForm.FormCreate
  125.   Description: standard FormCreate procedure
  126.        Author: Mat Ballard
  127.  Date created: 04/25/2000
  128. Date modified: 04/25/2000 by Mat Ballard
  129.       Purpose: sets the position and populates the Color combo
  130.  Known Issues:
  131.  ------------------------------------------------------------------------------}
  132. procedure TFunctionsForm.FormCreate(Sender: TObject);
  133. var
  134.   i: Integer;
  135. begin
  136. {$IFNDEF LANG_ENGLISH}
  137.   DoCaptionsFromResource;
  138. {$ENDIF}
  139.   DoHintsFromResource;
  140. {set combo and edit box widths:}
  141.   for i := 0 to Self.ComponentCount - 1 do
  142.     if (Self.Components[i] is TBitBtn) then
  143.       TControl(Self.Components[i]).Width := 97;
  144.   FunctionComboBox.Width := 97;
  145.   SetDialogGeometry(TForm(Self), TControl(OKBitBtn), HelpBitBtn.Left);
  146.   FunctionMemo.Width := OKBitBtn.Left + OKBitBtn.Width - HelpBitBtn.Left;
  147.   FunctionComboBox.ItemIndex := 0;
  148.   FunctionHintLabel.Caption := FunctionHints[0];
  149. end;
  150.  
  151. {------------------------------------------------------------------------------
  152.     Procedure: TFunctionsForm.DoCaptionsFromResource
  153.   Description: standard loading of labels from resources
  154.        Author: Mat Ballard
  155.  Date created: 06/25/2001
  156. Date modified: 06/25/2001 by Mat Ballard
  157.       Purpose: display in different languages
  158.  Known Issues:
  159.  ------------------------------------------------------------------------------}
  160. {$IFNDEF LANG_ENGLISH}
  161. procedure TFunctionsForm.DoCaptionsFromResource;
  162. begin
  163.   Self.Caption := sFunctions;
  164.   InsertBitBtn.Caption := sInsert;
  165.   TestBitBtn.Caption := sTest;
  166.   HelpBitBtn.Caption := sHelp;
  167.   OKBitBtn.Caption := sOK;
  168.   CancelBitBtn.Caption := sCancel;
  169. end;
  170. {$ENDIF}
  171.  
  172. {------------------------------------------------------------------------------
  173.     Procedure: TFunctionsForm.DoHintsFromResource
  174.   Description: standard loading of labels from resources
  175.        Author: Mat Ballard
  176.  Date created: 06/25/2001
  177. Date modified: 06/25/2001 by Mat Ballard
  178.       Purpose: display in different languages
  179.  Known Issues:
  180.  ------------------------------------------------------------------------------}
  181. procedure TFunctionsForm.DoHintsFromResource;
  182. begin
  183.   InsertBitBtn.Hint := sInsertHint;
  184.   FunctionComboBox.Hint := sAvailableFunctions;
  185.   FunctionMemo.Hint := sFunctionMemoHint;
  186.   TestBitBtn.Hint := sTestHint;
  187. end;
  188.  
  189. procedure TFunctionsForm.InsertBitBtnClick(Sender: TObject);
  190. begin
  191.   with FunctionMemo do
  192.   begin
  193.     if (SelLength > 0) then
  194.       SelText := FunctionComboBox.Text + '(' +SelText + ')'
  195.      else
  196. {$IFDEF MSWINDOWS}
  197.       Lines[CaretPos.y] :=
  198.         Copy (Lines[CaretPos.y], 1, CaretPos.x) +
  199.         FunctionComboBox.Text + '() + ' +
  200.         Copy (Lines[CaretPos.y], CaretPos.x+1, 999);
  201. {$ENDIF}
  202. {$IFDEF LINUX}
  203.       Lines[CaretPos.Line] :=
  204.         Copy (Lines[CaretPos.Line], 1, CaretPos.Col) +
  205.         FunctionComboBox.Text + '() + ' +
  206.         Copy (Lines[CaretPos.Line], CaretPos.Col+1, 999);
  207. {$ENDIF}
  208.   end;
  209. end;
  210.  
  211. procedure TFunctionsForm.FunctionComboBoxClick(Sender: TObject);
  212. begin
  213.   FunctionHintLabel.Caption := FunctionHints[FunctionComboBox.ItemIndex];
  214. end;
  215.  
  216. {------------------------------------------------------------------------------
  217.     Procedure: TFunctionsForm.TestBitBtnClick
  218.   Description: checks the validity of the user's mathematical expression
  219.        Author: Mat Ballard
  220.  Date created: 06/25/2001
  221. Date modified: 06/25/2001 by Mat Ballard
  222.       Purpose: must be used before "OK" is enabled
  223.  Known Issues:
  224.  ------------------------------------------------------------------------------}
  225. procedure TFunctionsForm.TestBitBtnClick(Sender: TObject);
  226. var
  227.   i: Integer;
  228.   TheParser: TParser;
  229.   TheExpression: String;
  230.   TheData: array [0..99] of PParserFloat;
  231. begin
  232.   TheParser := TParser.Create(nil);
  233.   TheExpression := '';
  234. {read the equation:}
  235.   for i := 0 to FunctionMemo.Lines.Count-1 do
  236.     TheExpression := TheExpression + FunctionMemo.Lines[i];
  237.   TheExpression := Misc.CleanString(TheExpression, ' ');
  238.  
  239. {try to run the Parser:}
  240.   try
  241. {Set up the variables:}
  242.     for i := 0 to SeriesCount-1 do
  243.       TheData[i] := TheParser.SetVariable(Format(UpperCase(sSeries) + '%d', [i]), 0);
  244. {Set up equation:}
  245.     TheParser.Expression := TheExpression;
  246.     OKBitBtn.Enabled := TRUE;
  247.   finally
  248.     TheParser.Free;
  249.   end;
  250. end;
  251.  
  252. end.
  253.