?? hwexprext.pas
字號(hào):
procedure Clear; override;
{ 返回實(shí)際可操作的IValue }
function GetIValue(Obj: IValue; const aName: string;
aParams: TParameterList): IValue;
{ 下面屬性用于取得注冊(cè)的成員信息，主要用于顯示給用戶 }
property Items[Index: Cardinal]: PMemberInfo read GetItem;
property ItemsName;
property Member[const AName: string]: PMemberInfo read GetMember;
property OwnerClassName: string read GetClassName;
property OwnerClass: TClass Read FOwnerClassType;
property Syntax[const AMemberName: string]: string read GetMemberSyntax;
Published
property Count;
end;
{ ---------------------------------------------------------------------
Class : TClassContext
注冊(cè)類Context。在本表中存儲(chǔ)有需要在表達(dá)式中訪問的類及其相關(guān)屬性
-------------------------------------------------------------------- }
TClassContext = class(TExprContext)
Private
function GetItem(Index: Cardinal): TClassMemberContext;
function GetMemberContext(const AClassName: string): TClassMemberContext;
Public
constructor Create(AOwner: TAbstractContextSet);
destructor Destroy; override;
function Add(const AClassType: TClass): TClassMemberContext;
{ DONE -oCharmer -c表達(dá)式解析與運(yùn)算 : 用什么方式使用類型信息比較好 ？ }
function ValidMember(const AClassName, AMemberName: String): Boolean;
procedure Clear; override;
procedure Delete(Index: Cardinal); overload; override;
procedure Delete(const AName: string); overload; override;
function IDF(obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue;
property Items[Index: Cardinal]: TClassMemberContext read GetItem;
property ItemsName;
property MemberContext[const AClassName: string]: TClassMemberContext
read GetMemberContext;
Published
property Count;
end;
{ ---------------------------------------------------------------------
Class : TObjectContext
對(duì)象Context。用于表達(dá)式通過對(duì)象名稱標(biāo)識(shí)符訪問對(duì)象
-------------------------------------------------------------------- }
TObjectContext = class(TExprContext)
Private
function GetItem(Index: Cardinal): TObject;
Public
constructor Create(AOwner: TExprContextSet);
destructor Destroy; override;
procedure Add(const AName: String; Obj: TObject);
procedure Delete(Index: Cardinal); overload; override;
procedure Delete(const AName: string); overload; override;
function GetObject(const AName: string): IValue;
property Items[Index: Cardinal]: TObject read GetItem;
property ItemsName;
Published
property Count;
end;
{ ---------------------------------------------------------------------
Class :
擴(kuò)展公式上下文表
-------------------------------------------------------------------- }
TExtFuncContext = class(TExprContext)
Private
{ 由于IValue的TestParameters方法僅返回True/False，因此在請(qǐng)求函數(shù)
時(shí)先檢查一下參數(shù)，以便于提供更多的出錯(cuò)信息 }
function CheckParams(ADeclare: TExtFunctionDeclare;
APassParams: TParameterList): Boolean;
Protected
//procedure SaveToStream(AStream: TrptStream);
//procedure LoadFromStream(AStream: TrptStream);
procedure Delete(Index: Cardinal); overload; override;
procedure Delete(const AName: string); overload; override;
Public
constructor Create(AOwner: TAbstractContextSet);
destructor Destroy; override;
procedure AddFunc(const AFuncName: string;
const AResultType: TExprType;
ParamList: Array of TExprType;
ExtFunc: TExtFuncImplementation;
const ADescription: string);overload;
procedure AddFunc(const AFuncName: string;
const ParamNames: array of string;
const ParamTypes: array of TExprType;
const AResultType: TExprType;
ExtFunc: TExtFuncImplementation;
const ADescription: String); overload;
procedure Clear; override;
function GetFunc(const AName: string; APassParams: TParameterList): TFunction;
function GetFuncDeclare(const AName: string): TExtFunctionDeclare; overload;
function GetFuncDeclare(Index: integer): TExtFunctionDeclare; overload;
Published
property Count;
end;
{ ---------------------------------------------------------------------
Class : TUserFuncTemplateContext
用戶定義公式模板Context
-------------------------------------------------------------------- }
TUserFuncTemplateContext = class(TExprContext)
Protected
procedure SaveToStream(AStream: TExprStream);
procedure LoadFromStream(AStream: TExprStream);
Public
constructor Create(AOwner: TAbstractContextSet);
destructor Destroy; override;
function Add(const AFuncName: string;
const AResultType: TExprType): TExprTemplate; overload;
procedure Add(ATemplate: TExprTemplate); overload;
procedure Delete(const AName: string); overload; override;
procedure Delete(Index: Cardinal); overload; override;
procedure Clear; override;
function GetTemplate(const AName: string): TExprTemplate; overload;
function GetTemplate(const Index: Cardinal): TExprTemplate; overload;
property ItemsName;
Published
property Count;
end;
{ 注：最好在UserEvalFunction和UserCompileFunction兩者間只選擇一個(gè)用 }
{ 編譯型用戶定義公式Context }
TUserCompileFuncContext = class(TExprContext)
Public
constructor Create(AOwner: TAbstractContextSet);
destructor Destroy; override;
procedure Add(AFuncTemplate: TExprTemplate);
procedure Delete(const AName: string); overload; override;
procedure Delete(Index: Cardinal); Overload; override;
procedure Clear; override;
function GetFunc(const AName: string; APassParams: TParameterList): TFunction;
function GetUCFI(Index: Cardinal): TAbstractExtFunction; overload;
function GetUCFI(AName: string): TAbstractExtFunction; overload;
Published
property Count;
end;
{ 抽象類，用于用戶擴(kuò)展ContextSet。 }
TAbstractContextSet = class
Public
function Has(const Identifier: string): Boolean; virtual; abstract;
function ExtIdent(Obj: IValue; const Identifier: String;
ParameterList: TParameterList): IValue; virtual; abstract;
end;
{ 上下文表集合 }
TExprContextSet = class(TAbstractContextSet)
private
FConstants : TConstantContext;
FExtFunctions : TExtFuncContext;
FExprTemplates : TUserFuncTemplateContext;
FCompileFunctions : TUserCompileFuncContext;
FRegistedClasses : TClassContext;
FObjects : TObjectContext;
FEnumerations : TEnumerationContext;
{ 用戶定義的ContextSet，用戶可以通過指定自定義的上下文表集合擴(kuò)展
應(yīng)用。或者情況反過來，由用戶ContextSet包含GlobalContextSet，并
由用戶決定先查詢哪些表 }
FUserContextSet : TAbstractContextSet;
Public
constructor Create;
destructor Destroy; override;
function Has(const Identifier: string): Boolean; override;
{ IDF }
function ExtIdent(Obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue; override;
procedure SaveToStream(AStream: TExprStream);
procedure LoadFromStream(AStream: TExprStream);
Published
property Constants : TConstantContext read FConstants;
property ExtFunctions : TExtFuncContext read FExtFunctions;
property ExprTemplates : TUserFuncTemplateContext read FExprTemplates;
property CompileFunctions: TUserCompileFuncContext read FCompileFunctions;
property RegistedClasses : TClassContext read FRegistedClasses;
property Objects : TObjectContext read FObjects;
property Enumerations : TEnumerationContext read FEnumerations;
property UserContextSet : TAbstractContextSet read FUserContextSet write FUserContextSet;
end;
{ 這個(gè)函數(shù)沒有IdentifierFunciton參數(shù)，以GlobalContextset.ExtIdent替代 }
function CreateExpression2(const S : string): IValue;
procedure AddExtFunc(const AFuncName: string;
const AResultType: TExprType;
ParamList: Array of TExprType;
ExtFunc: TExtFuncImplementation;
const ADescription: string); overload;
procedure AddExtFunc(const AFuncName: string;
const ParamNames: array of string;
const ParamTypes: array of TExprType;
const AResultType: TExprType;
ExtFunc: TExtFuncImplementation;
const ADescription: String); overload;
{ 擴(kuò)展函數(shù)示例 }
function Extfunc_ShowMessage(ParameterList: TParameterList): IValue;
var
{ 全局常量集合 }
GlobalContextSet: TExprContextSet;
implementation
{ ============================================================================
>>>> Class Implementation Begin <<<<
>>>> Class Name : TAbstractExtFunction
>>>> Description :
>>>> Create Date :
---------------------------------------------------------------------------- }
procedure TAbstractExtFunction.SetFuncName(const AName: string);
begin
FFuncName := AName;
end;
procedure TAbstractExtFunction.SetResultType(const AType: TExprType);
begin
FResultType := AType;
end;
procedure TAbstractExtFunction.SetAdditionType(const ATypeName: string);
begin
FAdditionType := TypeName;
end;
function TAbstractExtFunction.GetTypeName: string;
var pti: PTypeInfo;
begin
pti := System.TypeInfo(TExprType);
if not (FResultType in [ttObject, ttEnumerated]) then
begin
Result := GetEnumName(pti, Integer(FResultType));
end
else
begin
if FAdditionType <> '' then
Result := FAdditionType
else Result := GetEnumName(pti, Integer(FResultType));
end;
end;
function TAbstractExtFunction.GetSyntax: String;
var i : Integer;
S : string;
begin
S := FunctionName + '(';
if Self.ParamsCount > 0 then
begin
for i := 0 to ParamsCount -1 do
begin
S := S + Self.ParamsName[i]
+ ': ' + ExprTypeName[Self.ParamsType[i]] + '; ';
end;
S := Copy(S, 1, Length(S) -2);
end;
S := S + '): ' + ExprTypeName[ResultType];
Result := S;
end;
procedure TAbstractExtFunction.SaveToStream(AStream: TExprStream);
begin
AStream.SaveString(FunctionName);
AStream.SaveInteger(Integer(Self.ResultType));
AStream.SaveString(Description);
end;
procedure TAbstractExtFunction.LoadFromStream(AStream: TExprStream);
begin
SetFuncName(AStream.LoadString);
SetResultType(TExprType(AStream.LoadInteger));
FDescription := AStream.LoadString;
end;
{ Charmer Ext }
{ ============================================================================ }
{ 用戶自定義函數(shù)部分：由表達(dá)式構(gòu)成的函數(shù)。
這部分內(nèi)容包含如下類：
TExprTemplate ----> 自定義函數(shù)模板
TUserEvalFunction ----> 解釋型函數(shù)，即時(shí)編譯
TUserCompileFunction ----> 預(yù)編譯型函數(shù)算子
TUCFImplementation ----> 預(yù)編譯函數(shù)執(zhí)行體
============================================================================ }
type
TParamRec = record
ParamName: string;
ParamType: TExprType;
end;
PParamRec = ^TParamRec;
{ ******************************************************* }
{ User evaluate function }
{ 用戶定義的公式算子。本對(duì)象只有在請(qǐng)求時(shí)才被Context根據(jù)相關(guān)模
板創(chuàng)建，類似于解釋型運(yùn)行方式。參見另一類用戶定義函數(shù)
User compile function }
TUserEvalFunction = class(TExpression)
Private
FPrivateParams: TParameterList; //本公式私有參數(shù)
FTemplate: TExprTemplate; //公式模板
FValue: IValue;
function IDF(Obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue;
Public
constructor Create(const ATemplate: TExprTemplate; ParameterList: TParameterList);
destructor Destroy; override;
function AsBoolean : boolean; override;
function AsFloat : double; override;
function AsInteger : integer; override;
function AsObject : TObject; override;
function AsString : string; override;
function ExprType : TExprType; override;
//function CanReadAs(aType : TExprType): boolean;
function TestParameters: Boolean; override;
end;
{ 預(yù)編譯用戶函數(shù)執(zhí)行體 }
TUCFImplementation = class(TAbstractExtFunction)
Private
FSyntax: string;
FPrivateParams: TList;
FExprValue: IValue;
FIdentifierContextSet: TAbstractContextSet;
function GetParamsCount: Integer; override;
function GetParamsName(Index: integer): String; override;
function GetParamsType(Index: integer): TExprType; override;
function GetSyntax: string; override;
function IDF(Obj: IValue; const Identifier: string;
ParameterList: TParameterList): IValue;
Public
constructor Create(const ATemplate: TExprTemplate);
destructor Destroy; override;
function Param(Index: Integer): TVarLiteral;
function AsBoolean: Boolean;
function AsInteger: Integer;
function AsFloat: double;
function AsString: string;
function AsObject: TObject;
procedure SetParam(Index: integer; Value: IValue);
property ParamsName;
property ParamsType;
Published
property ParamsCount;
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -