你能否善用身边的一切资源?请大家进来测试一下吧!顺便散分。 (300分)

支持铁盒子
高!手!如!云!
 
TO 楼主:
以下是第三方控件 TParser 源代码,大伙研究研究,可以到
http://vcl.vclxx.org/DELPHI/D32FREE/PARSER10.ZIP 下载,也可以参考以下帖子:
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1918531 :
{*********************************************************}
{ }
{ TParser 10.1 for Borland Delphi }
{ }
{ A component for parsing and evaluating }
{ mathematical expressions specified at runtime }
{ }
{ Renate Schaaf (schaaf@math.usu.edu), 1993 }
{ Alin Flaider (aflaidar@datalog.ro), 1996 }
{ Stefan Hoffmeister }
{ Stefan.Hoffmeister@Uni-Passau.de, 1997 }
{ }
{ }
{ See PARSER10.TXT for documentation }
{ }
{*********************************************************}
unit Parser10;

{$IFDEF Win32}
{$H+,S-} { long strings, no stack-checking}
{$ENDIF}

{.$DEFINE DEBUG} { by default make it lean and efficient }
{$IFNDEF DEBUG}
{$D-} {$L-} {$Q-} {$R-} {$S-}
{$ENDIF}

{$I+} { I/O checking ON }

interface

uses
SysUtils,
Classes;

type
{ a couple of unfortunately necessary global declarations }
ParserFloat = double; { please do NOT use "real", only single, double, extended}
PParserFloat = ^ParserFloat;

TToken=( variab, constant,
minus,
sum, diff, prod, divis, modulo, IntDiv,
integerpower, realpower,
square, third, fourth,
FuncOneVar, FuncTwoVar);

POperation = ^TOperation;
{ functions that are added to the engine MUST have this declaration }
{ make sure that the procedure is declared far !!! }
TMathProcedure = procedure(AnOperation: POperation);
TOperation = record
{ MUST use pointers (!), because argument and destination are linked... }
Arg1, Arg2 : PParserFloat;
Dest : PParserFloat;

NextOperation : POperation;

Operation: TMathProcedure;
Token : TToken;
end;

EMathParserError = class(Exception); { create a new exception class and... }

{ ... some descendants }
ESyntaxError = class(EMathParserError);
EExpressionHasBlanks = class(EMathParserError);
EExpressionTooComplex = class(EMathParserError);
ETooManyNestings = class(EMathParserError);
EMissMatchingBracket = class(EMathParserError);
EBadName = class(EMathParserError);
EParserInternalError = class(EMathParserError); { hopefully we will never see this one }


{ we COULD use Forms and the TExceptionEvent therein,
but that would give us all the VCL overhead.
Consequentially we just redeclare an appropriate event }
TParserExceptionEvent = procedure (Sender: TObject; E: Exception) of object;



TCustomParser = class(TComponent)
private
{ some pre-allocated space for variables }
FA,
FB,
FC,
FD,
FE,
FX,
FY,
FT: ParserFloat;
private
FExpression : string;
FPascalNumberformat: boolean;
FParserError : boolean;

FVariables: TStringList;

FStartOperationList: POperation;

FOnParserError : TParserExceptionEvent;

function CalcValue: extended;
procedure SetExpression(const AnExpression: string);
procedure SetVar(const VarName: string; const Value: extended);
protected
{ lists of available functions, see .Create for example use }
FunctionOne : TStringList; { functions with ONE argument, e.g. exp() }
FunctionTwo : TStringList; { functions with TWO arguments, e.g. max(,) }

{ predefined variables - could be left out }
property A: ParserFloat read FA write FA;
property B: ParserFloat read FB write FB;
property C: ParserFloat read FC write FC;
property D: ParserFloat read FD write FD;
property E: ParserFloat read FE write FE;
property T: ParserFloat read FT write FT;
property X: ParserFloat read FX write FX;
property Y: ParserFloat read FY write FY;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;

function ParseExpression(const AnExpression: string): boolean;
procedure FreeExpression;

{ The PParserFloat returned points to the place in memory where the
variable actually sits; to speed up assignment you can DIRECTLY
assign data to the memory area. }
function SetVariable(VarName: string; const Value: extended): PParserFloat;
function GetVariable(const VarName: string): extended;

procedure AddFunctionOneParam(const AFunctionName: string; const Func: TMathProcedure);
procedure AddFunctionTwoParam(const AFunctionName: string; const Func: TMathProcedure);

procedure ClearVariables;
procedure ClearVariable(const AVarName: string);
function VariableExists(const AVarName: string): boolean;

procedure ClearFunctions;
procedure ClearFunction(const AFunctionName: string);

property ParserError: boolean read FParserError;
property LinkedOperationList: POperation read FStartOperationList;

property Variable[const VarName: string]: extended read GetVariable write SetVar;
published
property Value: extended read CalcValue stored false;

{ setting Expression automatically parses it
Warning: exceptions MAY be raised, if OnParserError is NOT assigned,
otherwise the event will be triggered in case of an error }
property Expression: string read FExpression write SetExpression;
property PascalNumberformat: boolean read FPascalNumberformat write FPascalNumberformat default true;
property OnParserError: TParserExceptionEvent read FOnParserError write FOnParserError;
end;




TParser = class(TCustomParser)
public
{ overrides to add the properties below as variables
and adds all the functions }
constructor Create(AOwner: TComponent); override;

{ returns the string with the blanks inside removed }
class function RemoveBlanks(const s: string): string;
published
{ predefined variables - could be left out }
property A;
property B;
property C;
property D;
property E;
property T;
property X;
property Y;
end;



procedure Register;

implementation

{$DEFINE UseMath}
{ Note: if you do not have the MATH unit simply remove the conditional define
the component will continue to work, just a bit slower }

uses
{$IFDEF UseMath}
Math,
{$ENDIF}
P10Build;

procedure Register;
begin
RegisterComponents('Samples', [TParser]);
end;
(*
{$IFDEF VER80}
{$R *.D16}
{$ELSE}
{$IFDEF VER90}
{$R *.D32}
{$ENDIF}
{$ENDIF}
*)

{****************************************************************}
{ }
{ Following are "built-in" calculation procedures }
{ }
{****************************************************************}
{
Naming convention for functions:

Name of built-in function, prepended with an underscore.
Example:

ln --> _ln

Passed arguments / results:

If the function takes any arguments - i.e. if it has been added to
either the FunctionOne or the FunctionTwo list:

- First argument --> arg1^
- Second argument --> arg2^

The result of the operation must ALWAYS be put into

dest^


Note: These are POINTERS to floats.
}



{****************************************************************}
{ }
{ These are mandatory procedures - never remove them }
{ }
{****************************************************************}

{ do nothing - this only happens if the "term" is just a number
or a variable; otherwise this procedure will never be called }
procedure _nothing(AnOp: POperation); far;
begin
end;

procedure _Add(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arg1^ + arg2^;
end;

procedure _Subtract(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arg1^ - arg2^;
end;

procedure _Multiply(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arg1^ * arg2^;
end;

procedure _RealDivide(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arg1^ / arg2^;
end;

procedure _Modulo(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := trunc(arg1^) mod trunc(arg2^);
end;

procedure _IntDiv(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := trunc(arg1^) div trunc(arg2^);
end;

procedure _Negate(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := -arg1^;
end;

procedure _IntPower(AnOp: POperation); far;
{$IFNDEF UseMath}
var
n, i: longint;
{$ENDIF}
begin

{$IFNDEF UseMath}
with AnOp^ do
begin
n := trunc(abs(arg2^))-1;

case n of
-1: dest^ := 1;
0: dest^ := arg1^;
else
dest^ := arg1^;
for i := 1 to n do
dest^ := dest^ * arg1^;
end;

if arg2^ < 0 then
dest^ := 1 / dest^;

end;
{$ELSE}
with AnOp^ do
dest^ := IntPower(arg1^, trunc(arg2^));
{$ENDIF}
end;

procedure _square(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := sqr(arg1^);
end;

procedure _third(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arg1^ * arg1^ * arg1^;
end;

procedure _forth(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := sqr(sqr(arg1^));
end;

procedure _power(AnOp: POperation); far;
begin
with AnOp^ do
begin
{$IFNDEF UseMath}
if arg1^ = 0 then
dest^ := 0
else
dest^ := exp(arg2^*ln(arg1^));
{$ELSE}
dest^ := Power(arg1^, arg2^);
{$ENDIF}
end;
end;


{****************************************************************}
{ }
{ These are OPTIONAL procedures - you may remove them, though }
{ it is preferable to not register them for use }
{ }
{****************************************************************}
procedure _sin(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := sin(arg1^);
end;

procedure _cos(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := cos(arg1^);
end;

procedure _arctan(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := arctan(arg1^);
end;

procedure _arg(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ < 0 then
dest^ := arctan(arg2^/arg1^)+Pi
else
if arg1^>0 then
dest^ := arctan(arg2^/arg1^)
else
if arg2^ > 0 then
dest^ := 0.5 * Pi
else
dest^ := -0.5 * Pi;
end;

procedure _sinh(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := (exp(arg1^)-exp(-arg1^))*0.5;
end;

procedure _cosh(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := (exp(arg1^)+exp(-arg1^))*0.5;
end;

procedure _cotan(AnOp: POperation); far;
begin
with AnOp^ do
{$IFNDEF UseMath}
dest^ := cos(arg1^) / sin(arg1^);
{$ELSE}
dest^ := cotan(arg1^);
{$ENDIF}
end;

procedure _tan(AnOp: POperation); far;
begin
with AnOp^ do
{$IFNDEF UseMath}
dest^ := sin(arg1^) / cos(arg1^);
{$ELSE}
dest^ := tan(arg1^);
{$ENDIF}
end;

procedure _exp(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := exp(arg1^);
end;

procedure _ln(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := ln(arg1^);
end;

procedure _log10(AnOp: POperation); far;
const
_1_ln10 = 0.4342944819033;
begin
with AnOp^ do
{$IFDEF UseMath}
dest^ := log10(arg1^);
{$ELSE}
dest^ := ln(arg1^) * _1_ln10;
{$ENDIF}
end;

procedure _log2(AnOp: POperation); far;
const
_1_ln2 = 1.4426950409;
begin
with AnOp^ do
{$IFDEF UseMath}
dest^ := log2(arg1^);
{$ELSE}
dest^ := ln(arg1^) * _1_ln2;
{$ENDIF}
end;

procedure _logN(AnOp: POperation); far;
begin
with AnOp^ do
{$IFDEF UseMath}
dest^ := logN(arg1^, arg2^);
{$ELSE}
dest^ := ln(arg1^) / ln(arg2^);
{$ENDIF}
end;

procedure _sqrt(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := sqrt(arg1^);
end;


procedure _abs(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := abs(arg1^);
end;

procedure _min(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ < arg2^ then
dest^ := arg1^
else
dest^ := arg2^;
end;

procedure _max(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ < arg2^ then
dest^ := arg2^
else
dest^ := arg1^;
end;

procedure _heaviside(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ < 0 then
dest^ := 0
else
dest^ := 1;
end;

procedure _sign(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ < 0 then
dest^ := -1
else
if arg1^ > 0 then
dest^ := 1.0
else
dest^ := 0.0;
end;

procedure _zero(AnOp: POperation); far;
begin
with AnOp^ do
if arg1^ = 0.0 then
dest^ := 0.0
else
dest^ := 1.0;
end;

procedure _trunc(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := int(arg1^)
end;

procedure _ceil(AnOp: POperation); far;
begin
with AnOp^ do
if frac(arg1^) > 0 then
dest^ := int(arg1^ + 1)
else
dest^ := int(arg1^);
end;

procedure _floor(AnOp: POperation); far;
begin
with AnOp^ do
if frac(arg1^) < 0 then
dest^ := int(arg1^ - 1)
else
dest^ := int(arg1^);
end;

procedure _rnd(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := Random * int(arg1^);
end;

procedure _random(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := Random;
end;

procedure _radius(AnOp: POperation); far;
begin
with AnOp^ do
dest^ := sqrt(sqr(arg1^)+sqr(arg2^));
end;

procedure _phase(AnOp: POperation); far;
var
a: ParserFloat;
begin
with AnOp^ do
begin
a := arg1^ / (2/pi);
dest^ := (2*pi) * (a-round(a));
end;
end;

{****************************************************************}
{ }
{ TCustomParser }
{ }
{ A base class which does not publish the variable properties }
{ and adds no functions by default }
{ }
{****************************************************************}
function TCustomParser.ParseExpression(const AnExpression: string):boolean;
var
OperationLoop: POperation;
begin
FreeExpression;
FExpression := AnExpression;

if AnExpression <> '' then
begin
Result := false;

try
ParseFunction( AnExpression,

FVariables,

FunctionOne,
FunctionTwo,

FPascalNumberformat,

FStartOperationList,
Result);

FParserError := Result;

except
on E: Exception do
begin
FParserError := true;

if Assigned(FOnParserError) then
begin
FOnParserError(Self, E);
exit;
end
else
raise;
end;
end;

Result := not Result;

OperationLoop := FStartOperationList;
while OperationLoop <> nil do
begin
with OperationLoop^ do
begin
case Token of

variab,
constant: Operation := _nothing;

minus: Operation := _negate;

sum: Operation := _add;
diff: Operation := _subtract;
prod: Operation := _multiply;
divis: Operation := _RealDivide;

modulo: Operation := _Modulo;
intdiv: Operation := _IntDiv;

integerpower: Operation := _IntPower;
realpower: Operation := _Power;

square: Operation := _square;
third: Operation := _third;
fourth: Operation := _forth;

FuncOneVar, FuncTwoVar: { job has been done in build already !};
end; {case}

OperationLoop := NextOperation;
end; {with OperationLoop^}

end; {while OperationLoop<>nil}
end;
end;

constructor TCustomParser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

FPascalNumberformat := true;

FVariables := TStringList.Create;
with FVariables do
begin
Sorted := true;
Duplicates := dupIgnore;
end;

FunctionOne := TStringList.Create;
with FunctionOne do
begin
Sorted := true;
Duplicates := dupError;
end;

FunctionTwo := TStringList.Create;
with FunctionTwo do
begin
Sorted := true;
Duplicates := dupError;
end;

end;

destructor TCustomParser.Destroy;
begin
FreeExpression;

ClearVariables;
FVariables.Free;

FunctionOne.Free;
FunctionTwo.Free;

inherited Destroy;
end;




procedure TCustomParser.SetVar(const VarName: string; const Value: extended);
begin
SetVariable(VarName, Value);
end;

function TCustomParser.SetVariable(VarName: string; const Value: extended): PParserFloat;
var
i: integer;
begin
{ always convert to uppercase }
VarName := UpperCase(VarName);

with FVariables do
if Find(VarName, i) then
begin
Result := PParserFloat(Objects);
Result^ := Value;
end
else
begin
if Length(Varname) = 1 then
case VarName[1] of
'A': Result := @FA;
'B': Result := @FB;
'C': Result := @FC;
'D': Result := @FD;
'E': Result := @FE;
'T': Result := @FT;
'X': Result := @FX;
'Y': Result := @FY;
else { case }
{ is the variable name a valid identifier? }
if not IsValidIdent(VarName) then
raise EBadName.Create(VarName);

{ unravelled loop for improved (string!) performance! }

{ check whether the variable contains any of the operators (DIV and MOD)
this would confuse the parser... }
if pos('+', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('-', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('*', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('/', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('^', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('DIV', VarName) <> 0 then
raise EBadName.Create(VarName);

if pos('MOD', VarName) <> 0 then
raise EBadName.Create(VarName);

new(Result);
end { case }
else
begin
{ is the variable name a valid identifier? }
if not IsValidIdent(VarName) then
raise EBadName.Create(VarName);

new(Result);
end;

Result^ := Value;

AddObject(VarName, TObject(Result));
end
end;

function TCustomParser.GetVariable(const VarName: string): extended;
var
i: integer;
begin
with FVariables do
if Find(UpperCase(VarName), i) then
Result := PParserFloat(Objects)^
else
Result := 0.0;
end;

procedure TCustomParser.AddFunctionOneParam(const AFunctionName: string; const Func: TMathProcedure);
begin
if IsValidIdent(AFunctionName) then
FunctionOne.AddObject(UpperCase(AFunctionName), TObject(@Func))
else
raise EBadName.Create(AFunctionName);
end;

procedure TCustomParser.AddFunctionTwoParam(const AFunctionName: string; const Func: TMathProcedure);
begin
if IsValidIdent(AFunctionName) then
FunctionTwo.AddObject(UpperCase(AFunctionName), TObject(@Func))
else
raise EBadName.Create(AFunctionName);
end;

procedure TCustomParser.ClearVariables;
var
i: integer;
APPFloat: PParserFloat;
AString: string; { disregard stack consumption }
begin
with FVariables do
begin
i := Count;
while i > 0 do
begin
dec(i);
AString := Strings;
if (Length(AString) <> 1) or
(not (AString[1] in ['A'..'E', 'T', 'X', 'Y'])) then
begin
APPFloat := PParserFloat(Objects);
if APPFloat <> nil then
dispose( APPFloat ); { dispose only user-defined variables }
end;
end;

Clear;
end;

with FVariables do
begin
i := Count;
while i > 0 do
begin
dec(i);
AString := Strings;
if (Length(AString) <> 1) or
(not (AString[1] in ['A'..'E', 'T', 'X', 'Y'])) then
begin
APPFloat := PParserFloat(Objects);
if APPFloat <> nil then
dispose( APPFloat ); { dispose only user-defined variables }
end;
end;

Clear;
end;

SetExpression(''); { invalidate expression }
end;

procedure TCustomParser.ClearVariable(const AVarName: string);
var
index: integer;
begin
with FVariables do
begin
if Find(AVarName, index) then
begin
if (Length(AVarName) <> 1) and
(not (AVarName[1] in ['A'..'E', 'T', 'X', 'Y'])) then
dispose( PParserFloat(Objects[index]) ); { dispose only user-defined variables }

Delete(index);
end;
end;

SetExpression(''); { invalidate expression }
end;

function TCustomParser.VariableExists(const AVarName: string): boolean;
var
index: integer;
begin
Result := FVariables.Find(UpperCase(AVarName), index);
end;

procedure TCustomParser.ClearFunctions;
begin
FunctionOne.Clear;
FunctionTwo.Clear;

SetExpression(''); { invalidate expression }
end;

procedure TCustomParser.ClearFunction(const AFunctionName: string);
var
index: integer;
begin
with FunctionOne do
begin
if Find(AFunctionName, index) then
begin
Delete(index);
SetExpression(''); { invalidate expression }
exit;
end;
end;

with FunctionTwo do
begin
if Find(AFunctionName, index) then
begin
Delete(index);
SetExpression(''); { invalidate expression }
end;
end;
end;


procedure TCustomParser.FreeExpression;
var
LastOP,
NextOP: POperation;
begin
LastOP := FStartOperationList;

while LastOP <> nil do
begin
NextOP := LastOP^.NextOperation;

while NextOP <> nil do
with NextOP^ do
begin
if (Arg1 = lastop^.Arg1) or (Arg1 = lastop^.Arg2) or (Arg1 = lastop^.Dest) then
Arg1 := nil;

if (Arg2 = lastop^.Arg1) or (Arg2 = lastop^.Arg2) or (Arg2 = lastop^.Dest) then
Arg2 := nil;

if (Dest = lastop^.Arg1) or (Dest = lastop^.Arg2) or (Dest = lastop^.Dest) then
Dest := nil;

NextOP := NextOperation;
end;

with LastOP^, FVariables do
begin
if IndexOfObject( TObject(Arg1)) >= 0 then Arg1 := nil;
if IndexOfObject( TObject(Arg2)) >= 0 then Arg2 := nil;
if IndexOfObject( TObject(Dest)) >= 0 then Dest := nil;

if (Dest <> nil) and (Dest <> Arg2) and (Dest <> Arg1) then
dispose(Dest);

if (Arg2 <> nil) and (Arg2 <> Arg1) then
dispose(Arg2);

if (Arg1 <> nil) then
dispose(Arg1);
end;

NextOP := LastOP^.NextOperation;
dispose(LastOP);
LastOP := NextOP;
end;

FStartOperationList := nil;
end;

procedure TCustomParser.SetExpression(const AnExpression: string);
begin
ParseExpression(AnExpression); { this implies FExpression := AnExpression }
end;


function TCustomParser.CalcValue: extended;
var
LastOP: POperation;
begin
if FStartOperationList <> nil then
begin
LastOP := FStartOperationList;

while LastOP^.NextOperation <> nil do
begin
with LastOP^ do
begin
Operation(LastOP);
LastOP := NextOperation;
end;
end;
LastOP^.Operation(LastOP);

Result := LastOP^.Dest^;
end
else
Result := 0;
end;


{****************************************************************}
{ }
{ TCustomParser }
{ }
{****************************************************************}
constructor TParser.Create(AOwner: TComponent);
begin
inherited Create(AOwner);

with FVariables do
begin
AddObject( 'A', TObject(@FA));
AddObject( 'B', TObject(@FB));
AddObject( 'C', TObject(@FC));
AddObject( 'D', TObject(@FD));
AddObject( 'E', TObject(@FE));
AddObject( 'X', TObject(@FX));
AddObject( 'Y', TObject(@FY));
AddObject( 'T', TObject(@FT));
end;

with FunctionOne do
begin
{$DEFINE SpeedCompare} { compare speed against older versions with less functions }

AddObject('TAN', TObject(@_tan));
AddObject('SIN', TObject(@_sin));
AddObject('COS', TObject(@_cos));
AddObject('SINH', TObject(@_sinh));
AddObject('COSH', TObject(@_cosh));
AddObject('ARCTAN', TObject(@_arctan));
{$IFNDEF SpeedCompare}
AddObject('COTAN', TObject(@_cotan));
AddObject('ARG', TObject(@_arg));
{$ENDIF}

AddObject('EXP', TObject(@_exp));
AddObject('LN', TObject(@_ln));
{$IFNDEF SpeedCompare}
AddObject('LOG10', TObject(@_log10));
AddObject('LOG2', TObject(@_log2));

AddObject('SQR', TObject(@_square));
{$ENDIF}
AddObject('SQRT', TObject(@_sqrt));

AddObject('ABS', TObject(@_abs));
{$IFNDEF SpeedCompare}
AddObject('TRUNC', TObject(@_trunc));
AddObject('INT', TObject(@_trunc)); { NOTE: INT = TRUNC ! }
AddObject('CEIL', TObject(@_ceil));
AddObject('FLOOR', TObject(@_floor));
{$ENDIF}

AddObject('HEAV', TObject(@_heaviside));
AddObject('SIGN', TObject(@_sign));
AddObject('ZERO', TObject(@_zero));
AddObject('PH', TObject(@_phase));
AddObject('RND', TObject(@_rnd));
{$IFNDEF SpeedCompare}
AddObject('RANDOM', TObject(@_random));
{$ENDIF}
end;

with FunctionTwo do
begin

AddObject('MAX', TObject(@_max));
AddObject('MIN', TObject(@_min));

{$IFNDEF SpeedCompare}
AddObject('POWER', TObject(@_Power));
AddObject('INTPOWER', TObject(@_IntPower));

AddObject('LOGN', TObject(@_logN)); *)
{$ENDIF}
end;
end;


class function TParser.RemoveBlanks(const s: string): string;
{deletes all blanks in s}
var
i : integer;
begin
Result := s;

i := pos(' ', Result);
while i > 0 do
begin
delete(Result, i, 1);
i := pos(' ', Result);
end;
end;

end.
 
大概记得以前看多一个类似的问题

不服不行,大富翁还是高手多哦,我等要好好学习
 
还有一个办法啊:
在界面中加个F1BOOK控件,这是delphi中自带的,然后:

procedure TForm1.Button1Click(Sender: TObject);
begin
F1Book61.FormulaRC[1,1] := Edit1.Text;
Edit2.Text := F1Book61.TextRC[1,1];
end;

OK!还可以进行指数、幂数运算,正弦、余弦,取整,绝对值……,太多了,只要在EXCEL中有效的公式,都可以算出来,功能是不是这个最强大?[:)]
 
不是说今天公布答案吗?
还不公布啊?
 
参与一下
 
答案已经公布了,请向上看。
 
30分钟好象比较难
 
答案在上面已经公布,大家用查找“答案公布如下,包括DFW中的答案,共有十种实现的方法”就可以找到了。
 
佩服得,五体投地
procedure TForm1.Button1Click(Sender: TObject);
begin
F1Book61.FormulaRC[1,1] := Edit1.Text;
Edit2.Text := F1Book61.TextRC[1,1];
end;
这我绝对想不出来的!可能也因为从来没有用过!
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
889
DelphiTeacher的专栏
D
顶部