炒股暴赚，扬手就是300分，打算编写支持解释表达式的字段计算器控件来庆祝。 ( 积分: 300 )

炒股暴赚，扬手就是300分，打算编写支持解释表达式的字段计算器控件来庆祝。


这个控件已经写好90%，现在的它可以做到，支持数学运算，支持文本运算，还支持通配
符、转义符等等。

它除了可以简化数据库软件的编写外，还可以让用户自己编写公式，这是高档程序才有的
，而且增加了功能，不用写代码，还可删掉原来已经写的代码，而且不会影响数据库的效
率。

表达式的计算结果，可以自动填入计算字段，也可以在用户输入数据时自动填写非计算字
段。

例如直接等于其它字段的值：“数量”。

例如 “数量 * 单价”，就会自动计算金额值。

例如某商品，买10个以下单价5元， 10~100个单价为4.9元，100个以上单价为4.6元，
if的格式是 if(条件，条件为真时的值，条件为假时的值)，允许多层嵌套，本项的
表达式如下：

“if(数量<10，5，if(数量<100，4.9，4.6))”。

例如针对某个地区的客户进行打折的表达式：

“if(客户 like '广州%'，4.3，4.6)))”，那么广州各区的客户都会被给与打折优
惠。

例如做几十万的大生意，取整到百元：

“a :=金额 div 1000 * 1000;b :=金额 - a;if(b < 50，a, a+100)”

其中使用了变量和多行表达式，a 的结果舍掉百元以下的数，而 b 则等于被舍掉
的数，然后判断被舍掉的数少于50元的，则按 a 计算，否则加上100，达到四舍五
入的效果。

例如根据逻辑字段显示男女生：

“if(逻辑字段=True，'男'，'女')+'生'”


表达式可以是预置固定的，也可以从专门的字段中直接提取，或者从专门的字段中取得索
引，从表达式列表中读取，也可以从事件响应代码中获取。

控件是自用为主，做好则友情贴出，现在已经满足我的要求，还有什么要加的功能，请留
言，保证放分。

顶一下，能不能放出代码学习学习?

最近俺也加入炒股大军,鉴于炒股大赚,写程序没什么前途,所以决定放弃程序,职业炒股了,贴出源码见笑了

这个东西 2001 年 2 月 8 号完成过一个控件,想看拿去参考吧.

支持

标准的加减乘除优先级
还有自定义函数
搂主那个 if 条件无非就是一个函数.
标准的 Delphi 控件

使用方法 控件源码(Ctrl+C)另存一个文件 Component -> Install Component 产生一个控件

例子:
procedure TForm1.Button1Click(Sender: TObject);
begin
mExpression1.Explain('1+2');
ShowMessage(FloatToStr(mExpression1.Result));
end;


控件源码:

unit pExpression;

{$R-}

interface

uses Messages, Windows, SysUtils, Classes, Graphics, Menus, Controls, Forms,
StdCtrls, Mask ,Grids ,Dialogs;

{
作者:穆龙(delphibbs:delp)
声明:本代码为作者学习编写控件之习作,如有雷同,算你倒霉
本代码作者放弃所有权力,若需引用抄袭篡改,不胜荣幸.
}

type

TmExpression = class;
TmFunction = class;

TmFunctionEvent = function(ParamCount : Integer ;Param : array of Real ;var Value : Real ;var Err: String) : Boolean of object;
TmExpressionEvent = function(Name : String ;ParamCount : Integer ;Param : array of Real ;var Value : Real ;var Err: String) : Boolean of object;

TmFunction = class(TCollectionItem)
private
vName : String;
nParamCount : Integer;
bOnGetValue : TmFunctionEvent;
fValue : Real;
//fExpression : TmExpression;
procedure SetParamCount(Count : Integer);
public
function GetDisplayName : String; override;
constructor Create(Collection: TCollection); override;
destructor Destroy; override;
published
property Name : String read vName write vName;
property ParamCount : Integer read nParamCount write SetParamCount;
property OnGetValue : TmFunctionEvent read bOnGetValue write bOnGetValue;
property Value : Real read fValue write fValue;
end;

TmFunctions = class (TCollection)
private
cExpression : TmExpression;
function GetItem(Index: Integer) : TmFunction;
procedure SetItem(Index: Integer; Value: TmFunction);
protected
procedure Update(Item : TCollectionItem); override;
public
{ Public declarations }
constructor Create(Expression : TmExpression);
function GetOwner : TPersistent; override;
function Add : TmFunction;
property Items [Index: Integer]: TmFunction read GetItem write SetItem; default;
published
end;

TmExpression = class(TComponent)
private
cFunctions : TmFunctions;
vExpression : String;
vErrMsg : String;
nErrRow,nErrCol : Integer;
fResult : Real;
bOnGetValue : TmExpressionEvent;
protected
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
function SetValue(Name : String ;Value : Real) : Boolean;
function GetValue(Name : String ;var Value : Real) : Boolean;
function Explain(Expression : String) : Boolean; overload;
function Explain : Boolean; overload;
published
{ Published declarations }
property Functions : TmFunctions read cFunctions write cFunctions;
property Expression : String read vExpression write vExpression;
property ErrMsg : String read vErrMsg write vErrMsg;
property ErrRow : Integer read nErrRow write nErrRow;
property ErrCol : Integer read nErrCol write nErrCol;
property Result : Real read fResult write fResult;
property OnGetValue : TmExpressionEvent read bOnGetValue write bOnGetValue;
end;

procedure Register;

implementation
// Expression

constructor TmExpression.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
cFunctions := TmFunctions.Create(Self);
vErrMsg := '';
end;

destructor TmExpression.Destroy;
begin
inherited Destroy;
cFunctions.Free;
end;

function TmExpression.Explain(Expression : String) : Boolean;
begin
vExpression := Expression;
Result := Explain;
end;

function TmExpression.Explain : Boolean;
{
E = A [ /+|- /A]
A = F [ /*|/ /F ]
F = H [ /^ /H | ! ]
H = ( E ) | G
G = [+|-] /N|N.1
N.1 = ???( E , E , E , ...) | ...
N = D [ D ][/./N]
D = 0..9
}
var
nLen : Integer;
nNow : Integer;
function bE(var fv : Real) : Boolean; forward;

function bN(var fValue : Real) : Boolean;
var
r,r2,r3,f : Real;
begin
Result := True;
r2 := 0;
while nNow <= nLen do
begin
if (Ord(vExpression[nNow]) >= Ord('0')) and (Ord(vExpression[nNow]) <= Ord('9')) then
begin
r := Ord(vExpression[nNow]) - Ord('0');
r2 := r2 * 10 + r;
nNow := nNow + 1;
nErrCol := nErrCol + 1;
end
else
Break;
end;

if vExpression[nNow] <> '.' then
begin
fValue := r2;
Exit;
end;
nNow := nNow + 1;
nErrCol := nErrCol + 1;

f := 10;
r3 := 0;
while nNow <= nLen do
begin
if (Ord(vExpression[nNow]) >= Ord('0')) and (Ord(vExpression[nNow]) <= Ord('9')) then
begin
r := Ord(vExpression[nNow]) - Ord('0');
r3 := r3 + r / f;
f := f * 10;
nNow := nNow + 1;
nErrCol := nErrCol + 1;
end
else
Break;
end;
fValue := r2+r3;
end;

function bN1(var fValue : Real) : Boolean;
var
I : Integer;
A : String;
nErr : Integer;
nCnt : Integer;
r : Real;
fParam : array [0 .. 256] of real;
begin
Result := True;
A := Copy(vExpression,nNow,nLen - nNow + 1);
for I := 0 to cFunctions.Count - 1 do
begin
if Pos(cFunctions.Items.vName,A) = 1 then
begin
nNow := nNow + Length(cFunctions.Items.vName);
nErrCol := nErrCol + Length(cFunctions.Items.vName);
nErr := nErrCol;

nCnt := 0;
fParam[0] := 0;
if vExpression[nNow] = '(' then
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;

while nCnt < 256 do
begin
if vExpression[nNow] = ')' then
Break;

if not bE(r) then
begin
Result := False;
Exit;
end;

fParam[nCnt] := r;
nCnt := nCnt + 1;
if vExpression[nNow] <> ',' then
Break;
nNow := nNow + 1;
nErrCol := nErrCol + 1;
end;

if vExpression[nNow] <> ')' then
begin
Result := False;
vErrMsg := '出错在第'+IntToStr(nErr+1)
+'个字符,函数"'+cFunctions.Items.vName+'"缺少&quot"。';
Exit;
end;

nNow := nNow + 1;
nErrCol := nErrCol + 1;
end;

if (cFunctions.Items.ParamCount > 0) and (nCnt <> cFunctions.Items.ParamCount) then
begin
Result := False;
vErrMsg := '出错在第'+IntToStr(nErr+1)
+'个字符,函数"'+cFunctions.Items.vName+'"的参数应该是'
+IntToStr(cFunctions.Items.ParamCount)
+'个。';
Exit;
end;

if (cFunctions.Items.ParamCount = 0) and (nCnt > 0) then
begin
Result := False;
vErrMsg := '出错在第'+IntToStr(nErr+1)
+'个字符,函数"'+cFunctions.Items.vName+'"参数过多。';
Exit;
end;

if Assigned(cFunctions.Items.bOnGetValue) then
Result := cFunctions.Items.bOnGetValue(nCnt,fParam,fValue,vErrMsg)
else
fValue := cFunctions.Items.Value;

if Assigned(bOnGetValue) then
Result := bOnGetValue(cFunctions.Items.vName,nCnt,fParam,fValue,vErrMsg);

Exit;
end;
end;
Result := bN(fValue);
end;

function bG(var fValue : Real) : Boolean;
begin
case vExpression[nNow] of
'+' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
Result := bN1(fValue);
Exit;
end;
'-' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
Result := bN1(fValue);
fValue := -fValue;
Exit;
end;
else
Result := bN1(fValue);
end; // case
end;

function bH(var fValue : Real) : Boolean;
begin
if vExpression[nNow] = '(' then
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
Result := bE(fValue);
if vExpression[nNow] <> ')' then
begin
Result := False;
vErrMsg := '表达式缺少&quot"。';
end;
nNow := nNow + 1;
nErrCol := nErrCol + 1;
end
else
Result := bG(fValue);
end;

function bA(var fValue : Real) : Boolean;
var
r,r2 : Real;
begin
Result := False;
fValue := 0;
if bH(r) then
begin
while nNow <= nLen do
begin
case vExpression[nNow] of
'*' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
if bH(r2) then
r := r * r2
else
Exit;
end;
'/' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
if bH(r2) then
r := r / r2
else
Exit;
end;
else begin
Result := True;
fValue := r;
Exit;
end;
end; // case
end; // while
Result := True;
fValue := r;
end; // if bH ..
end;

function bE(var fv : Real) : Boolean;
var
r,r2 : Real;
begin
Result := False;
if bA(r) then
begin
while nNow <= nLen do
begin
case vExpression[nNow] of
'+' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
if bA(r2) then
r := r + r2
else
Exit;
end;
'-' :
begin
nNow := nNow + 1;
nErrCol := nErrCol + 1;
if bA(r2) then
r := r - r2
else
Exit;
end;
else begin
Result := True;
fv := r;
Exit;
end;
end; // case
end; // while
Result := True;
fv := r;
end; // if bA ..
end;
begin
vErrMsg := '';
nErrRow := 0;
nErrCol := 0;
fResult := 0;
nNow := 1;
nLen := Length(vExpression);
Result := bE(fResult);
if Result and(nNow <= nLen) then
begin
Result := False;
vErrMsg := '出错在第'+IntToStr(nErrCol+1)
+'个字符,不可识别的保留字"'+vExpression[nNow]+'"。';
end;
end;

function TmExpression.SetValue(Name : String ;Value : Real) : Boolean;
var
I : Integer;
begin
Result := False;
for I := 0 to cFunctions.Count - 1 do
begin
if cFunctions.Items.vName = Name then
begin
if not Assigned(cFunctions.Items.bOnGetValue) then
begin
cFunctions.Items.fValue := Value;
Result := True;
end;
Exit;
end;
end;
end;

function TmExpression.GetValue(Name : String ;var Value : Real) : Boolean;
var
I : Integer;
begin
Result := False;
for I := 0 to cFunctions.Count - 1 do
begin
if cFunctions.Items.vName = Name then
begin
if not Assigned(cFunctions.Items.bOnGetValue) then
begin
Value := cFunctions.Items.fValue;
Result := True;
end;
Exit;
end;
end;
end;
// Function List

function TmFunctions.GetItem(Index: Integer) : TmFunction;
begin
Result := TmFunction(inherited GetItem(Index));
end;

procedure TmFunctions.SetItem(Index: Integer; Value: TmFunction);
begin
inherited SetItem(Index, Value);
end;

function TmFunctions.Add : TmFunction;
begin
Result := TmFunction(inherited Add);
end;

constructor TmFunctions.Create(Expression: TmExpression);
begin
inherited Create(TmFunction);
cExpression := Expression;
end;

procedure TmFunctions.Update(Item: TCollectionItem);
begin
//
end;

function TmFunctions.GetOwner : TPersistent;
begin
Result := cExpression;
end;

// Function

constructor TmFunction.Create(Collection: TCollection);
begin
inherited Create(Collection);
// fExpression := TmFunctions(Collection).fExpression;
end;

destructor TmFunction.Destroy;
begin
inherited Destroy;
end;

function TmFunction.GetDisplayName : String;
var
I : Integer;
vDisplay : String;
begin
if ParamCount < 0 then
begin
Result := vName+'(..)';
Exit;
end;

if ParamCount = 0 then
begin
Result := vName;
Exit;
end;

vDisplay := vName+'(';
for I := 0 to ParamCount - 1 do
begin
if I = 0 then
vDisplay := vDisplay + 'x'
else
vDisplay := vDisplay + ',x';
end;
Result := vDisplay + ')';
end;

procedure TmFunction.SetParamCount(Count : Integer);
begin
if Count > 256 then
nParamCount := 256
else
nParamCount := Count;
end;

procedure Register;
begin
RegisterComponents('Mu Long', [TmExpression]);
end;

end.

若要源代码，请用人工智能，视觉识别，文字识别，语音设别和语言理解等delphi版原创
的源代码来交换，其它免问。

300分来吧 我没有炒股 楼主见好就收吧
赌博不输 天下头等功夫
炒股不败 上帝都爱

to delp
你的源代码太长，没看真，应该是个好东西。全职炒股好！我本来就是了，不过有空出来
搞搞新意。论坛这么多高手，将答案抄来炒去，而像老兄这样，真正原创，真正有创意的
人少得可怜，现在都说要全职炒股去了。

to kninneng

你也是职业炒股? 有空介绍一下经验啊 QQ:7040559.

TO 冰力不足
听腻了，我看交易量炒股的，现在的交易量放大了10倍，而股票数量只是增加了几个，
将放大10倍的钱放进去，股价能不涨吗，QFII将有近2000亿的外资进入股市，就怕你
不够胆去买股。

请跟贴的，不要谈股市了，也不用提醒我，心领了。

一个不错的控件。谢谢奉献。

也想炒股了，但不懂规则技巧……
想了解一下炒股方面的技巧心得，那位大侠能给点建议吗？
谢谢，哈哈~

一个比一个厉害

頂，希望早日完工

今天GS又涨了，300分等着各位提要求，光顶没用的。

都想炒股啊 现在形势很好 我顶

交易量超过3000亿天亮，大量涨停板，谁唱空股市，掌嘴，看来要加快程序编写，
是不可能的，没空啊，忙着去股市灌水。

纠正一下，是 4000 亿 相当于 2 个日本股市，已经是世界上第二大市值市场了。

4000亿，好啊，顶。我的帖子是想看看有什么想要的功能要加上去，其实我对它已经
很满意了。

to kinneng

哥们你的都没发布啊。

拿出来测试一下拉，OPEN一点嘛，我还写过一个16位的编译器，你要看吗，不过都是很早以前的程序了，没有技术含量，程序与人一起研究进步才会飞快哦。

：）

解释代码从上至下的效率都是很低的，贴出代码吧，认真看你代码的人才是真正欣赏你的人，测试你程序付出的劳动也不小的，现在写一个VM + 一个伪码编译 + 一个脚本语言，也就2周左右，不用担心别人抄你成果。


股市：
昨夜加交易税，到中午现在为止，暴跌 263.65 点，我的股票全部躺在跌停板上，哈，傻开心中。

啊呀，来顶了，凑热闹拉。。。
现在股票一片红火。。。。

我的的暴利还在，问题不大，我的本金早已收回，在市的统统都是利润，今日创历史天量，
有卖就有买，散户没理由抢着进去接盘，也没这么多的钱去接。我不是程序员，做出来的
东西，基本上是一堆垃圾，只能自己欣赏，还没有空去研究。