/
YakuninAV
/
Convertors
Обзор
Документация
Войти
/
YakuninAV
/
Convertors
Код
Запросы
0
Задачи
Вики
Пакеты
0
Релизы
0
Аналитика
Безопасность
master
Core/DBDFormulas.pas
351 строка
11 KB
YakuninAV
begin with gitflick
31 июл 2026, 15:21
31 июл 2026, 15:21
1dc0fc6
Код
Авторство
О чём код?
unit dbdFormulas; {$include mormot.defines.inc} interface uses Classes, SysUtils, PUCU, mormot.core.base, mormot.core.unicode, mormot.core.data, mormot.core.buffers, mormot.core.text ,DBDCommons, dbdutf8utils ; var /// ������ ��������� ������� ������������ � �������� dbdEmbeddedFormulas: TRawUtf8DynArray; /// ������ ���������� ������������ � �������� dbdOperations: TRawUtf8DynArray; function DBDFactorsDisassemble(const Txt: RawUtf8): TRawUtf8DynArray; /// // FindAndExtractNextFunction: // - var aP: PUtf8Char -> ��������� �� ������� ������� � ������ (���������� ��� ������) // - const aTargetFunctions: TRawUtf8DynArray -> ������ ��� ������� ��� ������ // out aFuncName: RawUtf8 -> ��� ��������� ������� // out aParams: TRawUtf8DynArray -> ������ � ����� ���������� function DBDFindAndExtractNextFunction(var aP: PUtf8Char; const ATargetFunctions: TRawUtf8DynArray; out aFuncName: RawUtf8; out aParams: TRawUtf8DynArray; ANormalizeParameters: boolean = false): Boolean; function DBDRemoveEmbeddedFunction(const Txt: RawUtf8): RawUtf8; implementation function isLetterUtf8(PP: PUtf8Char; const CharSize: PInteger=nil): Boolean; inline; begin Result:=DBDIsCategory(PP, dbdLetterCategory); if CharSize<>nil then begin if Result then CharSize^:=DBDCharSize(PP) else CharSize^:=-2; end; end; procedure ExtractMathElements(const aExpr: RawUtf8; out aResult: TRawUtf8DynArray; aNormalizeParameters: boolean = false); var P: PUtf8Char; Token, CurrentFunc: RawUtf8; TargetArgs, CurrentArgIdx: Integer; // ��������� ������������ const CONFIG = 'ROUNDP=1, SIN=1,�����=2,FUN=1,FNC2=2'; //const arrConfig: array of RawUtf8 = ['ROUNDP=1', 'SIN=1','�����=2','FUN=1','FNC2=2']; // const OPERATIONS = '+,-,*,/,^,>,<,='; // ���������� ��������� const OPERATIONS = '+,-,*,/,@,:'; // ���������� ��������� // �������� �� �����/�����/������������� // function IsValidIdentStart(var PP: PUtf8Char): Boolean; // begin //// Result := (PP^ in ['a'..'z', 'A'..'Z', '_']) or (IsLetterUtf8(PP) > 0); // Result := (PP^ in ['a'..'z', 'A'..'Z', '_']) or DBDIsCategory(PP, dbdLetterCategory); // end; // function isLetterUtf8(PP: PUtf8Char): Boolean; inline; // begin // Result:=DBDIsCategory(PP, dbdLetterCategory); // end; function GetAllowedArgs(const aFuncName: RawUtf8): Integer; var UpperName: RawUtf8; val: RawUtf8; begin Result := -1; UpperName := PUCUUTF8UpperCase(aFuncName); // val := GetPropNameValue(CONFIG, UpperName); // if val <> '' then Result := GetInt64(val); end; // ��������� ����� � ��������� ��� ���������� function ReadToken(var PP: PUtf8Char): RawUtf8; var Start: PUtf8Char; L: integer; begin Result:=''; while (PP^ <> #0) and (PP^ <= ' ') do Inc(PP); if PP^ = #0 then Exit; Start := PP; if (PP^ >= '0') and (PP^ <= '9') then begin // 1. ����� while (PP^ <> #0) and (PP^ in ['0'..'9', '.']) do Inc(PP); end else if DBDIsValidIdentStart(PP) then begin // 2. �������������� (������� � ���������) while (PP^ <> #0) do begin // L := IsLetterUtf8(PP); if L > 0 then Inc(PP, L) else if (PP^ in ['0'..'9', 'a'..'z', 'A'..'Z', '_']) then Inc(PP) else break; end; end else begin // 3. ��������� � ����������� SetString(Result, Start, 1); // ����� ���� ������ ��� �������� if (Result <> '(') and (Result <> ')') and (Result <> ',') then begin // ���������, ������ �� ������ � ������ OPERATIONS // if IdemPropName(Pointer(Result), OPERATIONS) < 0 then // ���� �� ������, �� ������� � �� �������� � ��� ������������ ������ // � �������� ������ ����� ����� ������� ���������� (Exception) // �� ������ ��������� ���, ����� �� ����������� ; end; Inc(PP); Exit; end; SetString(Result, Start, PP - Start); end; procedure SkipToNextSeparator(var PP: PUtf8Char); var Level: Integer; begin Level := 0; while PP^ <> #0 do begin if PP^ = '(' then Inc(Level) else if PP^ = ')' then begin if Level = 0 then Exit; Dec(Level); end else if (PP^ = ',') and (Level = 0) then Exit; Inc(PP); end; end; begin // DynArrayClear(aResult); P := Pointer(aExpr); CurrentFunc := ''; TargetArgs := 0; CurrentArgIdx := 0; while (P <> nil) and (P^ <> #0) do begin Token := ReadToken(P); if Token = '' then Break; // ���� ����� � ����� ��� ����� (�� ��������/������) { if (Length(Token) > 0) and ((Token[1] in ['0'..'9']) or IsValidIdentStart(Pointer(Token))) then begin if not (Token[1] in ['0'..'9']) then begin TargetArgs := GetAllowedArgs(Token); if TargetArgs >= 0 then begin CurrentFunc := DBDUtf8ToUpper(Token); CurrentArgIdx := 1; // ���� ������ ���������� while (P^ <> #0) and (P^ <> '(') do Inc(P); if P^ = '(' then Inc(P); continue; end; if aNormalizeParameters then Token := DBDUtf8ToUpper(Token); end; TDynArrayUtf8(aResult).Add(Token); end; } // ���������� ����������� ������ ������� if (CurrentFunc <> '') then begin // ReadToken ��� ��������� P, ��������� ������� ������ ����� P-1 ��� ������� �� P // �� ������� ��������� ������, �� ������� ����������� ReadToken if (P-1)^ = ',' then begin Inc(CurrentArgIdx); if CurrentArgIdx > TargetArgs then SkipToNextSeparator(P); end else if (P-1)^ = ')' then begin while CurrentArgIdx < TargetArgs do begin // TDynArrayUtf8(aResult).Add(''); Inc(CurrentArgIdx); end; CurrentFunc := ''; end; end; end; end; function DBDFactorsDisassemble(const Txt: RawUtf8): TRawUtf8DynArray; var p, pStart: PUtf8Char; c: Ucs4CodePoint; Level: Integer; cnt: Integer; begin cnt := 0; Level := 0; p := Pointer(Txt); SetLength(Result,0); if (p = nil) or (p^ = #0) then Exit; // 1. ������� ��������� �������� � ����� '=' while (p^ <> #0) and (p^ in [#1..#32, '=']) do Inc(p); pStart := p; SetLength(Result, 16); // ��������� ����� while p^ <> #0 do begin pStart := p; // ���� �� �����������, �������� ����������� ������ while p^ <> #0 do begin case p^ of '(': Inc(Level); ')': Dec(Level); '*', '@', ';': if Level = 0 then Break; // ����-������ ������ �� ������� ������ end; // ���������� PUCU ��� ����������� ������ ��������� (UTF-8) DBDUTF8ToUCS4(p); end; // ��������� ��������� �������� if p > pStart then begin if cnt >= Length(Result) then SetLength(Result, cnt * 2); FastSetString(Result[cnt], pStart, p - pStart); Inc(cnt); end; if p^ <> #0 then Inc(p); // ���������� ��� ����-������ end; SetLength(Result, cnt); end; function DBDFindAndExtractNextFunction(var aP: PUtf8Char; const ATargetFunctions: TRawUtf8DynArray; out aFuncName: RawUtf8; out aParams: TRawUtf8DynArray; ANormalizeParameters: boolean = false): Boolean; var ArgStart: PUtf8Char; Token: RawUtf8; Level: Integer; CapturedArg: RawUtf8; function IsValidIdentStart(var PP: PUtf8Char): Boolean; inline; begin Result := (PP^ in ['a'..'z', 'A'..'Z', '_']) or (IsLetterUtf8(PP)); end; // ������� ������ ����� ������������� ������� function ReadFuncName(var PP: PUtf8Char): RawUtf8; var Start: PUtf8Char; L: integer; begin while (PP^ <> #0) and (PP^ <= ' ') do Inc(PP); Start := PP; if IsValidIdentStart(PP) then begin while (PP^ <> #0) do begin // L := IsLetterUtf8(PP); // if L > 0 then Inc(PP, L) if IsLetterUtf8(PP,@L) then Inc(PP, L) else if (PP^ in ['0'..'9', 'a'..'z', 'A'..'Z', '_']) then Inc(PP) else break; end; SetString(Result, Start, PP - Start); end else begin if PP^ <> #0 then Inc(PP); Result := ''; end; end; function FindFunction(const Functions: TRawUtf8DynArray; const AName: RawUtf8): Integer; inline; var r,n: RawUtf8; i: Integer; begin Result:=-1; n:=DBDUtf8ToUpper(AName)+'='; for i:=0 to High(Functions) do begin if DBDStartWith(Functions[i], n) then begin Result:=i; Break; end; end; end; begin Result := False; aFuncName := ''; SetLength(aParams,0); if (aP = nil) or (aP^ = #0) then Exit; // ��������� ������ � ������ ������ ������� while (aP^ <> #0) do begin Token := ReadFuncName(aP); if Token = '' then Continue; if FindFunction(ATargetFunctions, Token)>0 then begin aFuncName := Token; // ��������� ������������ ��� ������� // ���� ����������� ������ ����� �� ������ ������� while (aP^ <> #0) and (aP^ <> '(') do Inc(aP); if aP^ = '(' then Inc(aP) else Break; ArgStart := aP; Level := 0; // �������� ���� ����� ���������� while (aP^ <> #0) do begin if aP^ = '(' then Inc(Level) else if aP^ = ')' then begin if Level = 0 then begin // ����� �������: ��������� ��������� �������� FastSetString(CapturedArg, ArgStart, aP - ArgStart); if aNormalizeParameters then CapturedArg := PUCUUTF8UpperCase(CapturedArg); AddRawUtf8(aParams, TrimU(CapturedArg)); Inc(aP); // �������� ��������� �� ����������� ������ Result:=True; Exit; // ������� ����� � ��������� end; Dec(Level); end else if (aP^ = ';') and (Level = 0) then begin // ���������� �� ����������� ���������� �������� ������ FastSetString(CapturedArg, ArgStart, aP - ArgStart); if aNormalizeParameters then CapturedArg := PUCUUTF8UpperCase(CapturedArg); AddRawUtf8(aParams, TrimU(CapturedArg)); Inc(aP); ArgStart := aP; // ������� ����� ��� ���������� ��������� Continue; end; Inc(aP); end; end; end; end; function DBDRemoveEmbeddedFunction(const Txt: RawUtf8): RawUtf8; var p: PUtf8Char; r: RawUtf8; pa: TRawUtf8DynArray; begin if Txt='' then Result:='' else begin p:=@txt[1]; if DBDFindAndExtractNextFunction(p,dbdEmbeddedFormulas, r, pa) and (Length(pa)>0) then Result:=pa[0] else Result:=txt; end; end; procedure InitEmbeddedFormulas; var i: Integer; begin SetLength(dbdEmbeddedFormulas,7); i:=0; dbdEmbeddedFormulas[i]:='ROUNDP=1'; Inc(i); dbdEmbeddedFormulas[i]:='ROUND=1'; Inc(i); dbdEmbeddedFormulas[i]:='ROUNDC=1'; Inc(i); dbdEmbeddedFormulas[1]:='ROUNDS=1'; Inc(i); dbdEmbeddedFormulas[i]:='INT=1'; Inc(i); dbdEmbeddedFormulas[i]:='FRAC=1'; Inc(i); dbdEmbeddedFormulas[i]:='ABS=1'; end; initialization InitEmbeddedFormulas; end.