📄 datamaker.pas
字号:
{
注意：StrToFunCom,StrToFunComN的用法:
与Delphi的用法基本相同,
但是只能有一(多个)个变量,由VarC确定,如'X','T' ; }
// 另外，可以'(','[','{'相同混用,')',']','}' 相同混用
{ 错误的表达式如: 正确的表达式如:
sint sin(t)
sin(x)+3x sin(x)+3*x
x^sin(x) power[x,sin(x)] //x的Sin(x)次幂
log(1.2,x) logN(1.2,x)
//自定义的函数:
StrToFunN(S,FunCom,...);
获得函数数值:
GetFunValueN(FunCom,...);
GetFunValueN需要一千到一万机器周期
//将复杂函数库转变成简单函数库
CStrToSStr(ComplexStrings,SimpleStrings)
//将复杂函数表达式转变成简单函数表达式
CStrToSStr(ComplexS,SimpleStrings)
}
unit DataMaker;
interface
uses
Windows, Messages, SysUtils, Classes, //必须的
Controls, Dialogs, ComCtrls, Matrix; //扩展的
{$H+}
type
PFunCommand=^TFunCommand;
PDivFunction=^TDivFunction;
TDivFunction=Record
SubFun:PFunCommand;
Value2:Extended;
FunIndex:Byte;
NextIndex:Byte;
end;
TFunCommand=Record
Len:Integer; // DivFunction的实际使用长度
DivFunction:Array of TDivFunction;
end;
PExtended=^Extended;
PExtArray=^TExtArray;
TExtArray=Array [0..8096]of Extended;
PFunComArray=^TFunComArray;
TFunComArray=Array[0..8096]of TFunCommand;
const
FunCSize=Sizeof(TFunCommand);
MaxVarNum=6+50;
VariantNum=6;
_Sin=1; _Cos=2; _Tan=3; _Exp=4; _Ln=5;
_Log10=6; _Log2=7; _SinH=8; _CosH=9; _TanH=10;
_ArcSin=11; _ArcCos=12; _ArcTan=13; _ArcSinH=14; _ArcCosH=15;
_ArcTanH=16; _Sqr=17; _Sqrt=18; _Ladder=19; _Ctan=20;
_Scs=21; _Csc=22; _Fact=23; _Frac=24; _Random=25;
_Date=26; _Time=27;
_LasSeg=_Time;
_Negate=_LasSeg+1; _Abs=_LasSeg+2; _Ceil=_LasSeg+3;
_Round=_LasSeg+4; _Floor=_LasSeg+5; _Trunc=_LasSeg+6;
_OrgX=127; _OrgY=126; _OrgZ=125; _OrgU=124; _OrgV=123; _OrgW=122;
_OrgAN=121; _OrgA=121-50+1; //最多五十个变量,可以增加到80多个
//单操作数函数
_Add=128+1; _Sub=128+2; _Mul=128+3; _Div=128+4; _Power=128+5;
_LogN=128+6; _IntPower=128+7; _Recip=128+8; _Const=128+9; _Max=128+10;
_Min=128+11; _Triangle=128+12; _Hypot=128+13;
//双操作数函数
_ScaX=128+64+1; _ScaS=128+64+2; _ScaC=128+64+3; _ScaT=128+64+4;
//离散变量函数
ReserveNums=64; //保留符号
ReserveStrs:Array [0..ReserveNums] of String =(('SIN'),('COS'),('TAN'),('EXP'),('LN'),
('LOG10'),('LOG2'),('SINH'),('COSH'),('TANH'),
('ARCSIN'),('ARCCOS'),('ARCTAN'),('ARCSINH'),('ARCCOSH'),
('ARCTANH'),('SQR'),('SQRT'),('LADDER'), ('CTAN'),
('SCS'),('CSC'),('ABS'),('CEIL'),('ROUND'),
('FLOOR'),('ORGX'),('ORGY'),('ORGZ'),('+'),('-'),('*'),('/'),('('),(')'),
('['),(']'),('{'),('}'),(''''),('ADD'),('SUB'),('MUL'),('DIV'),('POWER'),
'LOGN','INTPOWER','RECIP','CONST','MAX','MIN','FACT','TRUNC','TRINGLE',
'FRAC','HYPOT','NEGATE','SCAX','SCAS','SCAC','SCAT','RANDOM','DATA','TIME','UNKNOW');
var //错误信息
ErrorMsg:String;
//计算FunCommand规定的函数值,0个变量或1,2,3,4个变量,可以再增加到70~80个变量
function GetFunValue(var FunCom:TFunCommand; Value:Extended):Extended; register; //ValueT7:Extended=0
function GetFunValueN(var FunCom:TFunCommand; ValueX1:Extended; ValueY2:Extended=0;ValueZ3:Extended=0;ValueU4:Extended=0;ValueV5:Extended=0;ValueW6:Extended=0; ValueAN:PExtended=nil):Extended;
//将字符串划成Command形式,一个变量或1,2,3,4个变量,可以再增加到70~80个变量
function StrToFunCom(S:String; Var FunCommand:TFunCommand; VarC:Char):Boolean; //VarC6:String='UNKNOW';
function StrToFunComN(S:String; Var FunCommand:TFunCommand; VarC:String; VarC2:String='UNKNOW'; VarC3:String='UNKNOW'; VarC4:String='UNKNOW'; VarC5:String='UNKNOW'; VarC6:String='UNKNOW'; VarCN:TStrings=nil):Boolean;
//将FunCommand的内存释放,每次用重复StrToFunCom,StrToFunComN之前,应该使用
procedure FreeFunCommand(var FunCommand:TFunCommand);
//V是需要表示的浮点数， Precision是精度, Sperator:分隔符号， SeparatorNum:分隔符的间隔
function ExtendedToStr(V:Extended; Precision:Integer; Separator:Char=#0; SeparatorNum:Integer=3):String;
//将某总分隔符间隔的浮点字符号串转化成浮点数 间隔符号
function StrToExtended(S:String; var V:Extended; Separator:Char):Boolean;
//将某个字符串中的Separator去除
function KillChar(S:String; Separator:Char):String;
Type TDataXY=Array of Extended;
procedure MakeFunComData(CommandX,CommandY:String; Tb,Te:Extended; SectNum:Integer; DataX,DataY:TDataXY);
//////------------------宏定义函数,实际上是小型解释器-----------///--------------//////
// 检查一个简单定义式子的合理性,现在支持6个以内的变量,不过可以增加到70~80个变量
function IsValidFunStr(S:String):Boolean;
//将复杂的（有自定义函数）式子改成简单函数字符串
function CfsToSfs(Cfs,Dfs:String; DataS:TStrings=nil):String;
//将复杂定义式子划成简单定义式
function CfdsToSfds(Cfds,Dfs:String; DataS:TStrings=nil):String;
{----一般用以下函数---------}
//将一个原始字符表转换成复杂表格
function OrgStrsToCStrs(OrgStrs,CStrs:TStrings; LastLine:Integer=-1):Boolean;
//将一个复杂表格的定义标志符号找出来
Procedure GetDFS(CStrs:TStrings; Result:TStrings; CanVarC:Boolean=False);
//将一个复杂表格变成简单式子的函数
Const InvalidString='-+*/(){}[];,.''\| '; //定义标志符号中不能有的字符
//函数返回值为''表示没有问题，否则表示发生错误的标志符
//注意,最好使用TStringList的实例,
//如果使用TMemo.Lines变量，那么可能出现一行被强行变成两行的意外,导致函数失败
function CStrsToSStrs(CStrs,SStrs:TStrings):String;
//简单将OrgStrsToCStrs和CStrsToSStrs合并为只有一个库文件时使用更方便
function OrgStrsToSStrs(OrgStrs,SStrs:TStrings; LastLine:Integer=-1):String;
//复杂函数转化成简单函数
function CStrToSStr(CStr:String; DefSs:TStrings):String;
//检查没有变量的表达式合法,获取没有变量的表达式数值
function CStrToFloat(CStr:String; var Value:Extended; DefSs:TStrings=nil):Boolean;
//在一个TStrings中寻找word字符串,Head,Tail给出开始，结束字符的位置; 返回值:True成功,False失败 CaseTen=True区分大小写 BlankValid=True空格算字符 CanComment=True表示'//'注释的内容可忽略; XB,YB给出开始查找的位置；BracketAll表示括号不分{[(,)]}
function FindWordInStrs(Strs:TStrings; Word:String; var Pos:Integer; var Head,Tail:TPoint; CaseTen:Boolean=False; BlankValid:Boolean=True; CanComment:Boolean=False; CanAddition:Boolean=True; XB:Integer=0;YB:Integer=0; BracketAll:Boolean=True):Boolean;
//从定义文件中获得字符,主要是将注释部分去除
function GetStrFromStrs(Strs:TStrings; Head,Tail:TPoint; CanComment:Boolean=False):String;
//浮点数以十六进制数输出
function FloatToHex(Data:Extended):String;
//十六进制数字符转换成浮点数
function HexToFloat(HexStr:String; var Float:Extended):Boolean;
//计算复数简单函数 '+','-','*','/'; S1,S2实数,X1,X2虚数 RS实数,RX虚数
function CaculateComplex(Command:Char; S1,X1,S2,X2:Extended; var RS,RX:Extended):Boolean;
//计算复数组合函数:如: ((2,3)+(-1,4))/3/<,4>/7.1; Command:命令字,RS实数,RX虚数,DefSs函数库
function CacuCompStrValue(Command:String; Var RS,RX:Extended;DefSs:TStrings=nil):Boolean;
//计算积分
function Integral(FunCommand:TFunCommand; a,b:Extended; Cent:Integer):Extended;
//角度度转换成浮点数
function DFMToFloat(DFM:String; Var Float:Extended):Boolean;
//浮点数转换成角度
function FloatToDFM(Float:Extended):String;
//拟牛顿法解非线性方程组 FunCom,初始值,中间值 精度 个数,最大叠代范围 //是否达到精度
function NNewtonME(PFCA,PV,POldV:Pointer; T,h,EPS:Extended; A,B,Z:TMatrix; Count,MaxTime:Integer):Boolean;
//变长欧拉方法 FunCom,初始值, 变量初始值,步长,精度 个数//结果返回 PEA^ 求微分方程
procedure Euler2(PFCA,PEA:Pointer; T, H, EPS:Extended; Count:Integer);
//最小二乘多项式拟合: XV,YV输入数值, AV输出数值; SV,TV,BV零时数据 N数据个数,N结果个数, DT1,DT2,DT3:分析值
function ZXECDN(XV,YV,AV,SV,TV,BV:Pointer; N,M:Integer; var DT1,DT2,DT3:Extended):Boolean;
//function Atrde(BV,DV:Pointer; N:Integer):Boolean;
//多元线形回归分析 X:M(变量)*N输入样本, Y N个观测值; A输出回归系数,V偏相关系数 偏差平方和,平均标准偏差,复相关系数,回归平方和
function IsQTM(X,Y:TMatrix; N,M:Integer; var A,V:TMatrix; var Q,S,R,U:Extended):Boolean;
implementation
uses Math;
function CodeToStr(Code:Byte; V1,V2,V3,V4,V5,V6:String; VN:TStrings):String;
begin
Case Code of
_Sin: Result:='Sin()';
_Cos: Result:='Cos()';
_Tan: Result:='Tan()';
_Exp: Result:='Exp()';
_Ln: Result:='Ln()';
_Log10: Result:='Log10()';
_Log2: Result:='Log2()';
_SinH: Result:='SinH()';
_CosH: Result:='CosH()';
_TanH: Result:='TanH()';
_ArcSin: Result:='ArcSin()';
_ArcCos: Result:='ArcCos()';
_ArcTan: Result:='ArcTan()';
_ArcSinH: Result:='ArcSinH()';
_ArcCosH: Result:='ArcCosH()';
_ArcTanH: Result:='ArcTanH()';
_Sqr: Result:='Sqr()';
_Sqrt: Result:='Sqrt()';
_Ctan: Result:='CTan()';
_Scs: Result:='Scs()';
_Csc: Result:='Csc()';
_Fact: Result:='Factorial()';
_Frac: Result:='Frac(Value)';
_Ladder: Result:='Ladder';
_Negate: Result:='-';
_Abs: Result:='Abs()';
_Ceil: Result:='Ceil()';
_Round: Result:='Round()';
_Floor: Result:='Floor()';
_Trunc: Result:='Trunc()';
_Random: Result:='Random()';
_Date: Result:='Data()';
_Time: Result:='Time()';
_OrgX: Result:=V1;
_OrgY: Result:=V2;
_OrgZ: Result:=V3;
_OrgU: Result:=V4;
_OrgV: Result:=V5;
_OrgW: Result:=V6;
_OrgA.._OrgAN: Result:=VN[Code-_OrgA];
_Add: Result:='+';
_Sub: Result:='-';
_Mul: Result:='*';
_Div: Result:='/';
_Power: Result:='Power(,)';
_LogN: Result:='LogN(,)';
_IntPower: Result:='IntPower(,)';
_Recip: Result:='Recip()';
_Const: Result:='Const';
_Max: Result:='Max(,)';
_Min: Result:='Min(,)';
_Triangle: Result:='Triangle(,)';
_Hypot: Result:='HyPot(,)';
_ScaX: Result:='ScaX(,)';
_ScaC: Result:='ScaC(,)';
_ScaS: Result:='ScaS(,)';
_ScaT: Result:='ScaT(,)';
else Result:='无';
end;
end;
///////////////////以下是分析，执行程序的代码//////////////////
{ _Sin=1; _Cos=2; _Tan=3; _Exp=4; _Ln=5;
_Log10=6; _Log2=7; _SinH=8; _CosH=9; _TanH=10;
_ArcSin=11; _ArcCos=12; _ArcTan=13; _ArcSinH=14; _ArcCosH=15;
_ArcTanH=16; _Sqr=17; _Sqrt=18; _Ladder=19; _Ctan=20;
_Scs=21; _Csc=22; _Fact=23;
_Negate=127; _Abs=126; _Ceil=125; _Round=124; _Floor=123;
_Trunc=122;
_OrgX=102; _OrgY=101; OrgZ=100;
}
function Factorial(Value:Extended):Extended; //register;
var
i:Integer;
X:Extended;
begin
Result:=1;
X:=1;
if Value<=1 then exit;
for i:=2 to Round(Value) do
X:=X*i;
Result:=X;
end;
function GetDate(Value:Extended):Extended;
var
Index:Integer;
NowTime:SYSTEMTIME;
begin
Index:=Round(Value);
GetLocalTime(NowTime);
Case Index of
-1: Result:=Date;
0: Result:=DateTimeToTimeStamp(Date).Date;
1: Result:=NowTime.wYear;
2: Result:=NowTime.wMonth;
3: Result:=NowTime.wDay;
4: Result:=NowTime.wDayOfWeek;
else raise Exception.Create('Invalid Date Command INDEX');
end;
end;
function GetTime(Value:Extended):Extended;
var
Index:Integer;
NowTime:SYSTEMTIME;
begin
Index:=Round(Value);
GetLocalTime(NowTime);
Case Index of
-1:Result:=Time;
0: Result:=DateTimeToTimeStamp(Date).Time;
1: Result:=NowTime.wHour;
2: Result:=NowTime.wMinute;
3: Result:=NowTime.wSecond;
4: Result:=NowTime.wMilliseconds;
else raise Exception.Create('Invalid Time Command INDEX');
end;
end;
function Triangle(Value,Value2:Extended):Extended;
begin
Result:=Frac(Value/Value2)*Value2;
end;
//用Case有一个好处,就是速度很快。因为它计算一个指针，然后根据指针跳转，
//于是不用经过许多次的比较一下就可以知道跳到那里
procedure Get1Value(var Value:Extended; Index:Byte); register;
begin
//解释单操作函数
Case Index of
_Sin: Value:=Sin(Value);
_Cos: Value:=Cos(Value);
_Tan: Value:=Tan(Value);
_Exp: Value:=Exp(Value);
_Ln: Value:=Ln(Value);
_Log10: Value:=Log10(Value);
_Log2: Value:=Log2(Value);
_SinH: Value:=SinH(Value);
_CosH: Value:=CosH(Value);
_TanH: Value:=TanH(Value);
_ArcSin: Value:=ArcSin(Value);
_ArcCos: Value:=ArcCos(Value);
_ArcTan: Value:=ArcTan(Value);
_ArcSinH: Value:=ArcSinH(Value);
_ArcCosH: Value:=ArcCosH(Value);
_ArcTanH: Value:=ArcTanH(Value);
_Sqr: Value:=Sqr(Value);
_Sqrt: Value:=Sqrt(Value);
_Ctan: Value:=1/Tan(Value);
_Scs: Value:=1/Sin(Value);
_Csc: Value:=1/Cos(Value);
_Fact: Value:=Factorial(Value);
_Frac: Value:=Frac(Value);
_Ladder: if Value<0 then Value:=-1 else Value:=1;
_Negate: Value:=-Value;
_Abs: Value:=Abs(Value);
_Ceil: Value:=Ceil(Value);
_Round: Value:=Round(Value);
_Floor: Value:=Floor(Value);
_Trunc: Value:=Int(Value);
_Random: Value:=Value*Random;
_Date: Value:=GetDate(Value);
_Time: Value:=GetTime(Value);
_OrgX,_OrgY,_OrgZ,_OrgU,_OrgV,_OrgW,_OrgA.._OrgAN: Value:=Value;
else raise Exception.Create(IntToStr(index)+'Invalid 1 param function INDEX!');
end;
end;
{ _Add=128+1; _Sub=128+2; _Mul=128+3; _Div=128+4; _Power=128+5;
_LogN=128+6; _IntPower=128+7; _Recip=128+8;_Const=128+9;_Max=128+10;
_Min=128+11; }
procedure Get2Value(var Value1,Value2:Extended; Index:Byte); register;
begin
//解释双操作函数
Case Index of
_Add: Value1:=Value1+Value2;
_Sub: Value1:=Value1-Value2;
_Mul: Value1:=Value1*Value2;
_Div: Value1:=Value1/Value2;
_Power: Value1:=Power(Value1,Value2);
_LogN: Value1:=LogN(Value1,Value2);
_IntPower: Value1:=IntPower(Value1,Round(Value2));
_Recip: Value1:=Value2/Value1;
_Const: Value1:=Value2;
_Max: Value1:=Max(Value1,Value2);
_Min: Value1:=Min(Value1,Value2);
_Triangle: Value1:=Triangle(Value1,Value2);
_Hypot: Value1:=HyPot(Value1,Value2);
else raise Exception.Create('Invalid 2 params function INDEX!');
end;
end;
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -