?? hwexprext.pas
字號:
property FunctionName;
property ResultType;
property Description;
property Syntax;
end;
{ 預編譯型用戶函數算子 }
TUserCompileFunction = class(TFunction)
Private
FUCFI: TUCFImplementation;
procedure SetParams;
Public
constructor Create(const ucfi: TUCFImplementation; AParameterList: TParameterList);
destructor Destroy; override;
function AsBoolean: Boolean; override;
function AsInteger: integer; override;
function AsFloat: double; override;
function AsString: string; override;
function AsObject: TObject; override;
//function CanReadAs(aType: TExprType): Boolean;
function ExprType: TExprType; override;
function TestParameters: Boolean; override;
end;
{ ============================================================================
>>>> Class Implementation Begin <<<<
>>>> Class Name : TExtExprFunction
>>>> Description :
>>>> Create Date :
---------------------------------------------------------------------------- }
constructor TUserEvalFunction.Create(const ATemplate: TExprTemplate; ParameterList: TParameterList);
begin
if ATemplate = nil then
raise EExpression.Create('沒有指定函數模板,無法創建該函數執行體');
inherited Create;
Self.FTemplate := ATemplate;
FPrivateParams := ParameterList;
FValue := CreateExpression(ATemplate.Expression, Self.IDF);
end;
destructor TUserEvalFunction.Destroy;
begin
FPrivateParams.Free;
inherited Destroy;
end;
function TUserEvalFunction.IDF(Obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue;
var i : Integer;
begin
Result := nil;
{ 通過了測試的表達式函數中的符號都應該存在,符號檢查一般都沒有問題。 }
if Identifier = FTemplate.FunctionName then
raise EExpression.create('不支持遞歸調用!');
{ 首先檢查是否是私有變量 }
i := FTemplate.IsParam(Identifier);
if i <> -1 then
begin
Result := FPrivateParams.Param[i];
Exit;
end
else
Result := FTemplate.IdentContextSet.ExtIdent(Obj, Identifier, ParameterList);
end;
function TUserEvalFunction.AsBoolean: Boolean;
begin
if FTemplate.ResultType = ttBoolean then
Result := FValue.AsBoolean
else
Result := Inherited AsBoolean;
end;
function TUserEvalFunction.AsFloat: Double;
begin
if FTemplate.ResultType = ttFloat then
Result := FValue.AsFloat
else
Result := Inherited AsFloat;
end;
function TUserEvalFunction.AsInteger: integer;
begin
if FTemplate.ResultType = ttInteger then
Result := FValue.AsInteger
else
Result := inherited AsInteger;
end;
function TUserEvalFunction.AsObject: TObject;
begin
if FTemplate.ResultType = ttObject then
Result := FValue.AsObject
else
raise EExpression.CreateFmt(Err_FuncCanntObject, [FTemplate.FunctionName]);
end;
function TUserEvalFunction.AsString: string;
begin
if FTemplate.ResultType = ttString then
Result := FValue.AsString
else
Result := inherited AsString;
end;
function TUserEvalFunction.ExprType: TExprType;
begin
Result := FTemplate.ResultType;
end;
{ 檢測參數是否有效,由Parser調用 }
function TUserEvalFunction.TestParameters: Boolean;
var i : Integer;
begin
Result := False;
if (FPrivateParams = nil) and (FTemplate.ParamsCount <> 0) then Exit;
if (FPrivateParams = nil) and (FTemplate.ParamsCount = 0) then
begin
Result := True;
Exit;
end;
if FPrivateParams.Count <> FTemplate.ParamsCount then Exit;
{ 逐一檢查參數類型是否與定義的一致 }
for i := 0 to FTemplate.ParamsCount -1 do
begin
if not FPrivateParams.Param[i].CanReadAs(FTemplate.ParamsType[i]) then Exit
end;
Result := True;
end;
{ ============================================================================
>>>> Class Implementation Begin <<<<
>>>> Class Name : TExprTemplate
>>>> Description :
>>>> Create Date :
---------------------------------------------------------------------------- }
constructor TExprTemplate.Create(const AFuncName: string;
const AResultType: TExprType;
const DetailType: string = '');
begin
inherited Create;
SetFuncName(AFuncName);
SetResultType(AResultType);
FErrorString := TStringList.Create;
FParamList := TList.Create;
FUnknowSymbols := TStringList.Create;
FNeedCheck := True;
SetAdditionType(DetailType);
end;
destructor TExprTemplate.Destroy;
begin
ClearParams;
FParamList.Free;
FErrorString.Free;
end;
function TExprTemplate.GetParamsCount: integer;
begin
Result := FParamList.Count;
end;
function TExprTemplate.AddParam(const AParamName: string; const AParamType: TExprType): Integer;
var
pparam: PParamRec;
begin
New(PParam);
pparam^.ParamName := AParamName;
pparam^.ParamType := AParamType;
FParamList.Add(PParam);
FNeedCheck := True;
Result := FParamList.Count;
end;
function TExprTemplate.IsParam(const Identifier: string): integer;
var i : Integer;
pParam: PParamRec;
begin
Result := -1;
if Self.FParamList.Count > 0 then
for i := 0 to FParamList.Count -1 do
begin
pparam := PParamRec(FParamList.Items[i]);
if UpperCase(pparam^.ParamName) = UpperCase(Identifier) then
begin
Result := i;
Exit;
end;
end;
end;
function TExprTemplate.GetParamsName(Index: integer): String;
begin
if (Index < 0) or (Index > FParamList.Count -1 ) then
raise EExpression.Create('索引超出范圍');
Result := PParamRec(FParamList.Items[Index])^.ParamName;
end;
function TExprTemplate.GetParamsType(Index: Integer): TExprType;
begin
if (Index < 0) or (Index > FParamList.Count -1 ) then
raise EExpression.Create('索引超出范圍');
Result := PParamRec(FParamList.Items[Index])^.ParamType;
end;
function TExprTemplate.UnknowSymbols: TStrings;
begin
if FNeedCheck then CheckExpression;
Result := FUnknowSymbols;
end;
function TExprTemplate.UnknowSymbolsCount: integer;
begin
if FNeedCheck then CheckExpression;
Result := FUnknowSymbols.Count;
end;
function TExprTemplate.CheckExpression: Boolean;
var testValue: IValue;
begin
Result := False;
FErrorString.Clear;
FUnknowSymbols.Clear;
FNeedCheck := True;
if Trim(FExpression) = '' then
begin
FErrorString.Add('沒有設置表達式');
Result := True;
FNeedCheck := False;
Exit;
end;
try
testValue := CreateExpression(FExpression, VirtualParams);
{ 檢查返回值類型是否與定義的一致 }
if testVAlue.ExprType <> Self.ResultType then
begin
Result := False;
FErrorString.Add('表達式返回結果與函數定義中的返回結果不一致');
FNeedCheck := True;
end
else
Result := True;
{ 檢查結束 }
if (FUnknowSymbols.Count = 0) then
FNeedCheck := False
else
FErrorString.Add('表達式中含有未知符號');
except
on e : EExpression do
begin
FErrorString.Add('語法錯誤:' + e.Message);
end;
on e : Exception do
begin
FErrorString.Add('錯誤:' + e.Message);
end;
end;
end;
function TExprTemplate.ErrorMessage: String;
begin
Result := FErrorString.Text;
end;
procedure TExprTemplate.DeleteParam(Index: integer);
begin
if (Index >=0) and (Index < (FParamList.Count -1)) then
begin
dispose(FParamList.Items[Index]);
FParamList.Delete(Index);
end
else
raise EExpression.Create('索引值超出范圍');
end;
procedure TExprTemplate.DeleteParam(const AParamName: String);
var i : Integer;
uName: string;
begin
if FParamList.Count = 0 then Exit;
uName := Uppercase(AParamName);
for i := 0 to FParamList.Count -1 do
begin
if UpperCase(PParamRec(FParamList.Items[i])^.ParamName) = uName then
begin
DeleteParam(i);
Exit;
end;
end;
end;
procedure TExprTemplate.ClearParams;
var i : Integer;
begin
if FParamList.Count = 0 then Exit;
for i := FParamList.Count -1 Downto 0 do
begin
Dispose(FParamList.Items[i]);
FParamList.Delete(i);
end; // while
end;
{ 進行表達式檢查的時候,需要向表達式解釋解析器不識別的符號,因此本函數可以獲取
未知的符號 }
function TExprTemplate.VirtualParams(Obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue;
var //i : Integer;
IdentType: TExprType;
FoundSym: Boolean;
function FindParam(const Identifier: string; Var AExprType: TExprType): Boolean;
var i : Integer;
begin
Result := False;
if FParamList.Count =0 then Exit;
for i := 0 to FParamList.Count -1 do
begin
if UpperCase(PParamRec(FParamList.Items[i])^.ParamName) = UpperCase(Identifier) then
begin
Result := True;
AExprType := PParamRec(FParamList.Items[i])^.ParamType;
Exit;
end;
end;
end;
begin
Result := nil;
FoundSym := False;
{ 首先檢查是否出現了遞歸調用 }
if Identifier = FFuncName then
raise EExpression.Create('不支持遞歸調用');
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -