Транслятор формул из формата макета в формат вычислителя

Реализован в виде динамически подсоединяемой библиотеки (отдельный модуль, содержащий функции, которые могут одновременно использовать разные программы) - Ftrаns32.dll. Данная библиотека предоставляет функции, которые реализуют трансляцию формул из формата, сходного с синтаксисом языков высокого уровня, типа Pascal, C/C++, в формат UniCalc.

Структуры и глобальные переменные библиотеки Ftrans32.Dll

const

Count_of_Variables=100; // Максимальное количество индексов

type

mas=record

A : String;

First : integer;

Second : integer;

Step : integer;

end;

Ar=array[1..Count_of_Variables] of mas;

TmasTmp=array[1..Count_of_Variables] of mas;

var

St : String; // строка с переданной формулой

ArVar : Ar; // Массив существующих индексов

masTmp : TmasTmp; // массив индексов, обнаруженных в формуле

count : integer; // Количество существующих индексов

countF : integer; // Количество обнаруженных в формуле индексов

tek : array[1..Count_of_variables] of integer; // массив текущих значений индексов

SSS : TStringList; // Массив строк - выходной результат

ECode : integer; // Код ошибки

Экспортируемые функции:

procedure initTrans(Variables : PChar);

Variables - указатель на строку, представляющую собой список индексов и их параметров. Формат следующий:

<Имя индекса> <первая граница> <вторая граница> <шаг>;<Имя индекса> <первая граница> <вторая граница> <шаг>; и т.д.

Составляющие отделяются друг от друга одним пробелом, но после точки с запятой пробела нет. Функцию следует вызывать всегда перед трансляцией формул.

procedure initTrans(Variables : PChar);

var

i, n1 : integer;

tmp : String;

a,

mn, // показывает, что считывается минимальное значение индекса

mx, // показывает, что считывается максимальное значение индекса

stp : BOOLEAN; // True - считывается шаг изменения индекса

begin

count:=1;

tmp:='';

SSS:=TStringList.Create;

a:=True;

mn:=False;

mx:=False;

stp:=False;

for i:=0 to StrLen(Variables) do begin

if (String(Variables[i])<>' ') and (String(Variables[i])<>';')

then tmp:=tmp+String(Variables[i]);

if String(Variables[i])=' ' then begin

if mx then begin mx:=False; stp:=True; val(tmp,ArVar[count].Max,n1); tmp:=''; end;

if mn then begin mn:=False; mx:=True; val(tmp,ArVar[count].Min,n1); tmp:=''; end;

if a then begin a:=False; mn:=True; ArVar[count].Alias:=tmp; tmp:=''; end;

end;

if String(Variables[i])=';' then begin

stp:=False;

a:=True;

val(tmp,ArVar[count].Step,n1);

tmp:='';

inc(count);

end;

end;

dec(count);

end;

function TransFormula(SS : PChar) : integer;

Данная функция собственно и реализует преобразование формул. Параметр SS представляет собой указатель на строку, содержащую формулу. Возвращаемое значение - код ошибки. Возможные значения:

0 : ошибки не было;

1 : синтаксическая ошибка;

2 : противоречивые параметры;

3 : выход за рамки диапазона индекса

function TransFormula(SS : PChar) : integer;

var

i, j, k, n1, n2, iL : integer;

tmp,SStr : String;

a, mn, mx, stp, STOP : BOOLEAN;

STmp : String;

SSSS,SS1 : String;

begin

St:=StrPas(SS); SSS.Clear; STmp:=''; ECode:=0;

// Уничтожение комментариев

n1:=Pos('(*',St); n2:=Pos('*)',St);

if (n1<>0) and (n2<>0)

then begin

for i:=1 to n1-1 do STmp:=STmp+St[i];

for i:=n2+2 to length(St) do STmp:=STmp+St[i];

if length(STmp)=0 then begin Result:=0; exit; end;

St:=STmp;

end;

SS1:=St;

repeat

n1:=Pos(' ',SS1);

if n1<>0 then begin

St:='';

for i:=1 to length(SS1) do

if i<>n1 then St:=St+SS1[i];

end;

SS1:=St;

until n1=0;

SStr:=St;

if (Pos(';',St)=0) and (length(St)<>0) then SStr:=SStr+';';

if not SintTest then begin Result:=1; exit; end; // Контроль скобок

// Анализируем количество индексов в формуле

n1:=Pos('{',St); n2:=Pos('}',St); a:=False; countF:=0; mx:=False;

STmp:='';

while((n1<>0)and(n2<>0)) do begin

for i:=n1+1 to n2-1 do

if (St[i]=',') or (i=n2-1) or (St[i]='+')

or (St[i]='-') or (St[i]='<') or (St[i]='>') or (St[i]='=')

then

if i=n2-1 then STmp:=STmp+St[i];

if (St[i]='+') or (St[i]='-') then mx:=True;

if (St[i]='<') or (St[i]='>') or (St[i]='=') then mx:=True;

if (St[i]=',') or (i=n2-1) then mx:=False

for j:=1 to count do

if ArVar[j].Alias=STmp then begin

STOP:=False;

for k:=1 to countF do

if (STmp=masTmp[k].A) or (countF=0) then begin

STOP:=True;

a:=True;

break;

end;

if STOP then begin STmp:=''; break; end;

if not STOP then begin

inc(countF);

masTmp[countF].A:=STmp;

masTmp[countF].First:=trunc(arVar[j].Min);//1;

masTmp[countF].Second:=trunc(arVar[j].Max);

masTmp[countF].Step:=trunc(arVar[j].Step);

Stmp:='';

a:=True;

break;

end;

end;

if not a then begin

MessageDlg('Индекса '+STmp+' не существует', mtError,[mbOk], 0);

exit;

end;

end

else if not mx then STmp:=STmp+St[i];

tmp:='';

for j:=n2+1 to length(St) do tmp:=tmp+SS1[j];

St:=tmp; STmp:=''; SS1:=St;

n1:=Pos('{',St); n2:=Pos('}',St);

a:=False;

end;

St:=SStr; STOP:=False;

// Вычисляем текущие параметры индексов и разбираем формулу

if countF=0

then SSS.Add(St)

else begin

for i:=1 to count do tek[i]:=masTmp[i].First;//1; !!!!

tek[1]:=masTmp[1].First-masTmp[1].Step;//0; !!!!!

repeat

iL:=1;

repeat

if tek[iL]=masTmp[iL].Second

then

if iL<countF

then begin tek[iL]:=masTmp[iL].First;{1}; inc(iL); a:=FALSE; end // !!!!

else begin STOP:=TRUE; a:=TRUE; end

else begin {inc(tek[iL])}; tek[iL]:=tek[iL]+masTmp[iL].Step; a:=TRUE; end; // !!!!

until a;

SSSS:=S(St,0,mn);

if (not STOP) and (not mn) then SSS.Add(SSSS);

until STOP;

end;

if SSS.Count=0 then Result:=ECode

else Result:=0;

end;

Сам разбор формулы реализован методом наискорейшего спуска, алгоритм которого показан в виде блок схем в разделе «Алгоритм работы транслятора формул из формата макета в формат вычислительного ядра», где каждый блок представлен в виде отдельной подпрограммы. Исходные тексты этих функций приведены в приложении.

function getFormula(var FF : PChar) : BOOLEAN;

Функция позволяет получить преобразованную формулу, которая записывается по указателю FF. Возвращаемые значения:

True : если в библиотечке еще остались невостребованные формулы - результат;

False : если результат был полностью считан;

function getFormula(var FF : PChar) : BOOLEAN;

begin

if SSS.Count<>0

then begin

StrPCopy(FF,SSS.Strings[0]);

SSS.Delete(0);

end;

if SSS.Count<>0 then Result:=True

else Result:=False;

end;

procedure destroyTrans;

Уничтожает транслятор. Следует вызывать после всех вычислений или при смене индексов.

procedure destroyTrans;

begin

SSS.Free;

count:=0;

countF:=0;

St:='';

end;