Procedure PointIsEditMultiEx(NP:String;PT:Integer);

Var
    CS,CS1:String;
    C: PSPoint;
    L,K,M,I,J:Integer;
    ET,CE: TSElement;

 begin
  For k:=0 to ElementList.count-1 do
   begin
   ET:=TSElement(ElementList.Objects[k]);
    if ET.SubElementList<>nil then begin

    if et.Name ='ChildFormEx' then
    For I:=0 to ET.SubElementList.Count-1 do begin
      Ce:=TSElement(ET.SubElementList.Objects[i]);
     if ce.Name='EditMultiEx' then begin

     M := IndexOfParamItem(NP,CE.ParamList);
       If M<>-1 then begin
        CS:=PSParam (CE.ParamList[M])^.Data;

       While true do begin

         if CS='' then exit;

          Next1(CS,'#');CS1:=Next1(CS,':');
          L:=StrToInt(CS1);CS1:=Copy(cs,1,L);Delete(cs,1,L);
           New(C);
           C^.Name:=CS1;
           C^.VName:='';
           C^.Rem:='';
           C^.Option:='';
           C^.PointDataType:='';
           C^.PointType:=pt;
           Et.PointList.Add(C);
           Next1(CS,'');
         end
       end;
      exit;
     end;

     end
    end
   end;
  end;
....
В конце SHA_Parser нужно добавить .
...
PointIsEditMultiEx('WorkCount' , ptDo);
PointIsEditMultiEx('EventCount', ptOn);
PointIsEditMultiEx('DataCount' , ptData);
PointIsEditMultiEx('VarCount'  , ptVar);

  Add(ChildPanelEx,15090097,154,133)
    {
    }
    BEGIN_SDK
      Add(EditMultiEx,7890468,21,21)
      {
       WorkCount=#5:##add8:##select|6:doEdat|8:##delete|
       VarCount=#7:##count|7:##index|4:NVar|3:Var|
       Point(##add)
       Point(##select)
       Point(##delete)
       Point(##count)
       Point(##index)

Add(StrList,5692559,560,217)
{
 Strings=#6:пример|6:списка|5:строк|
}

unit parsing_sha;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils,FileUtil,LazFileUtils,IniFiles,Math, Graphics;
Const
ptDo=1; {1-Left(do) 2-Top(on) 3-Right(Var) 4-Bottom(Data)  }
ptOn=2;
ptVar=3;
ptData=4;

type

TSPoint=Record
  Name:String;
  VName:String;
  Rem:String;
  PointType:Integer; {1-Left(do) 2-Top(on) 3-Right(Var) 4-Bottom(Data)  }
  PointDataType:String;
  X,Y:Integer;
  Option:String;
end;

TSPsram=Record
  Name:String;
  Data:String;
end;


TSLink=Record
  PointName:String;
  Id :String;
  PointTO:String;
  LinkCP:String;
end;

PSPoint=^TSPoint;
PSParam=^TSPsram;
PSLink =^TSLink;

TSElement=class;

TSElementDrawProc = procedure (EL:TSElement);
TSLinkDrawProc    = procedure (EL:TSElement);

TSElement=class(TObject)
          PointList:Tlist;
          ParamList:TList;
          LinkList:Tlist;
          ExtPointList:Tlist;
         // SHACode:STring;
          Name:STring;
          ID:STring;
          eX,eY,CW,CH:Integer;
          SubElementList:TStringList;
          Cdo,Con,Cdat,Cvar:Integer;
          TypeSUB:STring;
          WW:Integer;
          HH:Integer;

Constructor Create;//override;
//Constructor CreateFromSHA(FCode:STring);
destructor Destroy; override;
Procedure DrawElement;



const
    StepX :Integer=7; //Шаг X
    StepY :Integer=7; //Шаг X
 Procedure CalkMetrix;

end;

var

  SElementDraw:TSElementDrawProc;


const
   TextSHA:TStringList=nil;
   ElementList:TStringList=nil;
   BaseElementDrawList:TStringList=nil;
   MiniSHA:TStringList=nil;

Procedure CreateOrLoadElementBase(IniDir,baseName :String;Upd:Boolean;var TS:TStringList);
Procedure ParserElementBase(var TS:TStringList);
Procedure SHA_Parser(TextSHA:TStringList);

function IndexOfParamItem(N:String;L:Tlist;T:Boolean=False ):integer;
function IndexOfPointItem(N:String;L:Tlist;T:Boolean=False ):integer;
Procedure ClearPointItem(Var It:PSPoint  );
Procedure FreePointItem(Var It:PSPoint  );

// Конвертор  SHA 2 TXT
procedure SHA2TXT;

implementation

const
    StepX :Integer=7; //Шаг X
    StepY :Integer=7; //Шаг X
    MinW :Integer=3; //Минмальная шрина чипа  (в шагах)
    MinH :Integer=4; //Минмальная высота чипа (в шагах)
    otX:Integer=1; // отсуп X   (в шагах)
    otY:Integer=1; // отсуп Y   (в шагах)
    ZDX:Integer=0; // сдвиг X
    ZDY:Integer=0; // сдвиг Y

Procedure TSElement.CalkMetrix;
  Function  CalkIt(var LP:TList;T:Integer):Integer;
     var I,J:Integer;
         C2: PSPoint;
    begin
    If Lp <> nil then begin
    J:=0; for I:=0 to LP.Count-1 do
    begin
    C2:= PSPoint ( LP[i] );
    if   (C2^.PointType=T) and (C2^.Option<>'/Hide')  then
      J:=J+1;
    end;
     Result:=J;
    end
    else Result:=0;
    end;

    Procedure  CalkItXY(var LP:TList;T:Integer);
       var k,x,y,I,J:Integer;
           C2: PSPoint;
      begin
      If Lp <> nil then begin
      X:=Ex;  Y:=Ey;
      J:=0; for I:=0 to LP.Count-1 do
      begin

      C2:= PSPoint ( LP[i] );
      if  (C2^.PointType=T) and (C2^.Option<>'/Hide')  then  begin
        J:=J+1;
        K:=0;
      if (Name<>'GetDataEx') and (Name<>'HubEx') then begin
         Case  T  of
          1:begin C2^.x:=x; C2^.Y:=y+StepY*J; end;
          2:begin C2^.x:=x+StepX*WW; C2^.Y:=y+StepY*J; end;
          3:begin C2^.x:=x+StepX*J; C2^.Y:=Y+StepY*HH; end;
          4:begin C2^.x:=x+StepX*J; C2^.Y:=y; end;
         end;
      end else  begin
      C2^.x:=x+StepX; C2^.y:=y+StepY;
      if (Name='GetDataEx') then C2^.y:=C2^.y-1;
      if (Name='HubEx') then C2^.X:=C2^.X-2;
     end;
    end

          end
        end
      //end
    end;


    begin

    CDo:= CalkIt(PointList,ptDo);
    Con:= CalkIt(PointList,ptOn);
    CVar:= CalkIt(PointList,ptVar);
    Cdat:= CalkIt(PointList,ptData);

    WW:=Max(CDat,CVar);
    WW:= Max(WW,minW);

    HH:=Max(CDo,COn);
    HH:=Max(HH,minH);

     CalkItXY(PointList,ptDo);
     CalkItXY(PointList,ptOn);
     CalkItXY(PointList,ptVar);
     CalkItXY(PointList,ptData);
    end;


Procedure TSElement.DrawElement;
begin
  SElementDraw(Self);
end;

destructor TSElement.Destroy;
Var
 EN:TListEnumerator;

 begin

EN:=PointList.GetEnumerator;

If PointList.Count >0 then
while En.MoveNext do begin
  PSPoint(EN.Current)^.Name:='';
  PSPoint(EN.Current)^.VName:='';
  PSPoint(EN.Current)^.Rem:='';
  PSPoint(EN.Current)^.Option:='';
  PSPoint(EN.Current)^.PointDataType:='';
  Dispose( PSPoint(EN.Current) );
 end; EN.Free;

 PointList.free;


 EN:=ParamList.GetEnumerator;

 If ParamList.Count >0 then
 while En.MoveNext do begin
 PSParam(EN.Current)^.Name:='';
 PSParam(EN.Current)^.Data:='';
 Dispose( PSParam(EN.Current) );
 end; EN.Free;

 ParamList.free;

 EN:=LinkList.GetEnumerator;
 If LinkList.Count >0 then
 while En.MoveNext do begin
  PSLink(EN.Current)^.PointName :='';
  PSLink(EN.Current)^.Id :='';
  PSLink(EN.Current)^.PointTO:='';
  PSLink(EN.Current)^.LinkCP :='';
  Dispose( PSLink(EN.Current) );
 end; EN.Free;

LinkList.free;

 if  SubElementList<> Nil then SubElementList.Free;

 if  ExtPointList<>Nil then begin
 EN:=ExtPointList.GetEnumerator;
 If PointList.Count >0 then
 while En.MoveNext do begin
  PSPoint(EN.Current)^.Name:='';
  PSPoint(EN.Current)^.VName:='';
  PSPoint(EN.Current)^.Rem:='';
  PSPoint(EN.Current)^.Option:='';
  PSPoint(EN.Current)^.PointDataType:='';
  Dispose( PSPoint(EN.Current) );
  end; EN.Free;
  ExtPointList.Free;
 end;

 inherited Destroy;
end;
Constructor TSElement.Create;
begin
inherited Create;
{PointDo:=Nil;PointOn:=Nil;
PointVar:=Nil;PointData:=Nil;}
WW:=-1;
HH:=-1;

 PointList:=Tlist.Create;
 ParamList:=TList.Create;
 LinkList :=Tlist.Create;
 ExtPointList:=Nil;
 SubElementList:=Nil;
 TypeSUB:='';
end;

function IndexOfParamItem(N:String;L:Tlist;T:Boolean=False ):integer;
Var
 I:Integer;
 begin
Result:=-1; If L = Nil then exit;
If   l.Count>0 then
For I:=0 to l.Count-1 do
  if PSParam(l[i])^.Name<> '' then  begin
If t then  Writeln(PSParam(l[i])^.Name);
  if PSParam(l[i])^.Name=N then
begin
  Result:=i; exit;
end;
end;
end;


function IndexOfPointItem(N:String;L:Tlist;T:Boolean=False ):integer;
Var
 I:Integer;
 begin
Result:=-1; If L = Nil then exit;
If   l.Count>0 then
For I:=0 to l.Count-1 do
  if PSPoint(l[i])^.Name<> '' then  begin
If t then  Writeln(PSPoint(l[i])^.Name);
  if PSPoint(l[i])^.Name=N then
begin
  Result:=i; exit;
end;
end;
end;
Procedure ClearPointItem(Var It:PSPoint  );
begin
 If It = Nil  then exit;
  It^.Name:=''; It^.VName:='';  It^.Rem:='';
  It^.PointDataType:='';  It^.Option:='';  It^.PointType:=0;
 end;
Procedure FreePointItem(Var It:PSPoint  );
 begin
 If It = Nil  then exit;
  ClearPointItem(It);
  Dispose( It ); It:=nil;
 end;

function IsPointInRegion(Rect:Trect;AX, AY: Integer): Boolean;
begin
  Result := (AX >= Rect.Left) and (AX <= Rect.Right) and
    (AY >= Rect.Top) and (AY <= Rect.Bottom);
end;

Function I2S(F:Integer; const d1:byte=1):String;
var
 E:Integer;
Begin
 Str(F:D1,Result);
end;

Function S2I(S:String; const d:Integer=0 ):Integer;
var    E:Integer;
Begin
  Val(S,Result,E);
  If E <> 0 then Result:=d;
end;

Function S2F(S:String;const d:Extended=0):Extended ;
var    E:Integer;
Begin
  Val(S,Result,E);
  If E <> 0 then Result:=d;
end;
Function F2S(F:Extended; const d1:byte=1;d2:byte=4):String;
var    E:Integer;
Begin
 Str(F:D1:D2,Result);
end;

// Мини парсер строк
Function Next1(Var SS:String;Ch:Char):String;
var i:Longint;
begin
Result:='';
  I:=Pos(Ch,SS);
  If i>0 then begin
   Result:= Copy (ss,1,i-1);
   delete(SS,1,i);
  end
end;

Function InR(AA,B,C:Longint):Boolean;
begin
InR:=((AA>=B) And (AA<=C));
End;


Procedure CreateOrLoadElementBase(IniDir,baseName :String;Upd:Boolean;var TS:TStringList);
Var
 FS:TFileStream;

 ET:TSElement;
 CPo: PSPoint;
// MM: THeapStatus;

Var
S:String;
K,I,J:Integer;

begin

// Загрузказка *.ini в мини базу  'Delphi.dat'
If Not FileExists (baseName) or UPD then
  begin
Try
   TS:=FindAllFiles( IniDir , '*.ini',false);
  For I:=0 to ts.Count-1 do begin
   ts.Objects[i]:=TStringList.Create;
   TStringList(ts.Objects[i]).LoadFromFile(ts[I]);

    Ts[I]:=
    ExtractFileName( ExtractFileNameWithoutExt(TS[i]));
   end;

   FS:=TFileStream.Create(baseName,fmCreate);
   fs.Seek(0,soFromBeginning);

   For I:=0 to ts.Count-1 do Begin

    fs.WriteAnsiString(TS[i]);

    For J:=0 to TStringList(ts.Objects[i]).Count-1 do
    begin

      S:= TStringList(ts.Objects[i])[J];

      fs.WriteAnsiString(S);

      //Writeln(cp1251toUtf8());
     end;
      fs.WriteAnsiString('Element_END');
      //Writeln;
    end;

   finally

    fs.Free;
  end
   end;

Try
FS:=TFileStream.Create(baseName,fmOpenRead);
//TS:=TStringList.Create;

fs.Seek(0,soFromBeginning);

While FS.Position<fs.Size do Begin
 TS.AddObject( fs.ReadAnsiString,TStringList.Create);

S:= fs.ReadAnsiString;
While S<>'Element_END' do begin
  TStringList(ts.Objects[ts.Count-1]).Add(S);
  S:= fs.ReadAnsiString;
end;

end;

finally

Fs.Free;
end;

end;


Procedure ParserElementBase(var TS:TStringList);
Var
 FS:TFileStream;

 ET:TSElement;
 CPo: PSPoint;

 // MM: THeapStatus;
const
CPL:Tlist=nil;

 procedure ParsOne(NN:String);
  Var
  K,I,J:Integer;
  Mi: TMemIniFile;
  ID,S1,S,TN,VN:String;
  EEP,SS,MS:TStringList;
  C: PSPoint;
//  C_P:TC_Point;
  begin
  // Доступ данным по названию элемента
  Ms:=TStringList(TS.Objects[ts.IndexOf(NN)]);//.Text;
  // Создаю класс  TMemIniFile для  доступа к разделам
  MI:=TMemIniFile.Create('Test');  Mi.SetStrings(MS);

     // Обработка "множественного наследования"
      S1:=mi.ReadString('Type','Inherit','');
      IF S1<>'' then begin //write('[',s1,'] ');
      Repeat
      S:=Next1(s1,',');     //!!! Рекурсия
      If S<>'' then ParsOne(S) else ParsOne(S1);
      Until S='';
      end;

  {}
  // Простой парсинг описания контактных точек
     ss:=TStringList.Create;
     mi.ReadSectionRaw('Methods',SS);

     For I:=0 to ss.Count-1 do begin
      S:=SS[I];

     //Групы игнорирую...
      If Pos('##',S)=1 Then continue;
      If S='' Then continue;

      TN:=Next1(s,'=');
     //Вырезаю (если есть) дополнительное имя
      If TN<>'' Then  begin
      New(CPo);VN:='';
      CPo^.Option:='';
      If Pos('[',Tn)>0 then begin
       VN:=TN;
       TN:=Next1(VN,'[');
       VN:=Next1(VN,']');
      end;
       if vn<>'' then
       CPo^.VName:=VN
       else CPo^.VName:='' ;

      //--------------------
      //Учитываю опции в имени
      J:= Pos('*',Tn);
      If (J>0) then begin
        CPo^.Option:=CPo^.Option+'/Hide';
       Next1(TN,'*');
      end;
        CPo^.Name:=TN;

    { //Задел на будущее для свойств 'Property' ;
       J:= Pos('@',Tn);
       If (J>0) then begin
       Delete(TN,J,1);
        CPo^.Option:=CPo^.Option+'/CPoint';
       end;
       J:= Pos('+',Tn);
       If (J>0) then begin
       Delete(TN,J,1);
        CPo^.Option:=CPo^.Option+'/CUOpen';
       end;
       CPo^.Name:=NewStr(TN);
      end}


    //Пасинг параметров с учетом "хитрого" кодирования
    //особых символов внутири строк
       S:=StringReplace(S,'||','◙◙',[rfReplaceAll]);
       S1:= Next1(S,'|');
       S1:=StringReplace(S1,'◙◙','||',[rfReplaceAll]);
       CPo^.Rem:= S1 ;
       CPo^.PointType:=StrToInt( Next1(S,'|'));
       CPo^.PointDataType:=S;

     //Перезагрузка точек при "наследовании".
      J:=IndexOfPointItem(TN,et.PointList);
      If J<>-1 then begin

       C:=PSpoint(et.PointList[j]);
       FreePointItem( C );
       ET.PointList[J]:=CPO;

      end else  ET.PointList.Add(CPO);

     //-------------------------------
      end else continue;
      end; //For

// Секция 'Property'
  (* пока только  "Дополнительные точки" по галочке в инспекторе  *)
      ss.Text:='';
      mi.ReadSectionRaw('Property',SS);
      For I:=0 to ss.Count-1 do begin
       S:=SS[I];

      //Групы игнорирую...
       If Pos('##',S)=1 Then continue;
       If S='' Then continue;
       TN:=Next1(s,'=');
      //Вырезаю (если есть) дополнительное имя
       If TN<>'' Then  begin
       New(CPo);VN:='';
       CPo^.Option:='';
       If Pos('[',Tn)>0 then begin
        VN:=TN;
        TN:=Next1(VN,'[');
        VN:=Next1(VN,']');
       end;
       //--------------------
       //Учитываю опции в имени
       {J:= Pos('*',Tn);
       If (J>0) then begin
         CPo^.Option:=CPo^.Option+'/Hide';
        Next1(TN,'*');
       end;
        }
      // для свойств 'Property' ;
        J:= Pos('+',Tn);
        If (J>0) then begin
        Delete(TN,J,1);
         // CPo^.Option:=CPo^.Option+'/CUOpen';
        end;

        J:= Pos('@',Tn);
        If (J>0) then begin
        Delete(TN,J,1);
         CPo^.Option:='/Hide';
       // Writeln(tn + ' '+ CPo^.Option);
        CPo^.Name:='do'+TN;
        if vn<>'' then
        CPo^.VName:='do'+VN
        else CPo^.VName:='';

        end else begin
         dispose(CPo);
         continue;
        end;

    //Пасинг параметров с учетом "хитрого" кодирования
    //особых символов внутири строк
       S:=StringReplace(S,'||','◙◙',[rfReplaceAll]);
       S1:= Next1(S,'|');
       S1:=StringReplace(S1,'◙◙','||',[rfReplaceAll]);
       CPo^.Rem:= S1 ;
       CPo^.PointType:=ptDo;
       CPo^.PointDataType:=S;
     //  writen(PointType'')

     //Перезагрузка точек при "наследовании".
     if CPL=Nil then CPL:=Tlist.Create;
      J:=IndexOfPointItem(TN,CPL);
      If J<>-1 then begin

       C:=PSpoint(CPL[j]);
       FreePointItem( C );
       CPL[J]:=CPO;

      end else Cpl.Add(CPO);

     //-------------------------------
       end;
     end; //For

     ss.Free;
    //----------------------------
      //Секция Type
     S1:=mi.ReadString('Type','Sub','');
     IF S1<>'' then et.TypeSub :=S1;
    mi.Free;
  end;
 Var
 S:String;
 K,I,J:Integer;

begin
   If BaseElementDrawList=nil  then
BaseElementDrawList:=TStringList.Create
else BaseElementDrawList.clear;


For K:=0 to  Ts.Count-1 do begin
//Mm:=GetHeapStatus;
//WRiteln ('Free Memory ',mm.TotalFree);
ET:=TSElement.Create;
  ET.Name:=TS[K];

 //Вызваю рекусивный парсер для перовго уровня.
ParsOne(TS[K]);
// Writeln('Et.Name----->',Et.Name);
//Для верного рсположения доплнительных точек в списке


 if (CPL<>Nil) Then
 begin
  ET.ExtPointList:=CPL;
  CPL:=nil;
end;

 //Заношу резуьтат в список
   BaseElementDrawList.AddObject(ts[K],Et);

  end;  //for K


end  ;
Procedure SHA_Parser(TextSHA:TStringList);
  Var
  LP,NL, N,Z,Sx,Sy,Nam,ID,S,s1,Hed1,hed2:String;
  MC,TE,J,I,K,Y,lev,EI,IP:Integer;

  //Рекурсивный парсер контейнеров схемы
  procedure ParserOneLev (EL:TStringList);
  Var
   BE,CE: TSElement;
   CPo,BP: PSPoint;
   CPr: PSParam;
   CLk: PSLink;
   begin

   repeat
 if I > TextSHA.Count-1 then exit;

//else //END_SDK

 While pos('Add(',TextSHA[I])=0 do
 if I < TextSHA.Count-1 then i:=i+1 else exit;

 //i:=i+1;
 S:=TextSHA[I];
 Next1(S,'('); Nam:=Next1(S,',');
 id:=Next1(S,',');

 Sx:=Next1(S,',');
 SY:=Next1(S,')');

 CE:=TSElement.Create;
 Ce.Name:=Nam;
 Ce.ID:=id;
 Ce.eX:=StrToInt(SX);
 Ce.eY:=StrToInt(SY);

 //------------------------------
 // Поиск начала "тела" элемента
 While pos('{',TextSHA[I])=0 do
 if I< TextSHA.Count then  i:=i+1 else begin ce.Free; exit; end;
 i:=i+1;
 // Если нет завершения ...
 While pos('}',TextSHA[I])=0 do begin
  S:=TextSHA[I];
// Поиск связей.
 if pos('link(',TextSHA[I])<>0 then begin

 Next1(S,'('); N:=Next1(S,',');
 ID:=Next1(S,':');NL:=Next1(S,',');
 Next1(S,'['); LP:=Next1(S,']');

 New(CLk);
CLK^.PointName:=N;
CLK^.Id:=Id;
CLK^.PointTO:=NL;
CLK^.LinkCP:=LP;
ce.LinkList.Add(Clk);
 end else
 // Параметры
 if  pos('=',TextSHA[I])<>0 then  begin
 While S[1]=' ' do delete(S,1,1);

 N:=Next1(S,'='); Z:=S;

 New(CPR);
  CPR^.Name:=N;
  CPR^.Data:=Z;
  CE.ParamList.Add(CPR);

end else
//Дополнительные точки
if pos('Point(',TextSHA[I])<>0 then
begin

 Next1(S,'(');N:=Next1(S,')');

 New(CPo);
 Cpo^.Name:=N;
 Cpo^.VName:='';
 Cpo^.PointType:=-1; // Неопределино

 // Переопредиляю ---------------------
If BaseElementDrawList<>nil then begin
EI:=BaseElementDrawList.IndexOf( Ce.Name );
If Ei<>-1 Then begin
BE:=TSElement(BaseElementDrawList.Objects[EI]);
IP:=IndexOfPointItem(N,BE.PointList);
If IP<>-1 Then begin
 BP:=BE.PointList[ip];
 Cpo^.PointType:=BP^.PointType;
end
end
End;
//-----------------------------
 Cpo^.Rem:='';
 Cpo^.Option:='';
 CE.PointList.Add(CPo);
 { }

end;
 i:=i+1;
if I > TextSHA.Count-1 then break;
end;
  i:=i+1;

EL.AddObject(ce.ID,CE);

if I > TextSHA.Count-1 then exit;
// Если есть контейнер ....
if (pos('BEGIN_SDK',TextSHA[I])<>0)  then
   begin
     Lev:=Lev+1;
      I:=I+1;
      //WRIteln('\\ BEGIN_SDK--------------');
      CE.SubElementList:=TStringList.Create;

      ParserOneLev(CE.SubElementList);  //!! Рекурсия
       if I > TextSHA.Count-1 then exit;
    end else
// Конец контейнера
 if (pos('END_SDK',TextSHA[I])<>0) and  (Lev>0) then
     begin
      Lev:=Lev-1;
      MC:=MC+EL.Count;
      //WRIteln('\\ END_SDK--------------');
      I:=I+1;
      exit; // Возварат на уровень выше
     end;


//Application.ProcessMessages;
 until I >= TextSHA.Count-1;


  end;


Procedure PointIsEditMultiEx(NP:String;PT:Integer);

Var
    CS,CS1:String;
    C: PSPoint;
    L,K,M,I,J:Integer;
    ET,CE: TSElement;

 begin
  For k:=0 to ElementList.count-1 do
   begin
   ET:=TSElement(ElementList.Objects[k]);
    if ET.SubElementList<>nil then begin

    if et.Name ='ChildFormEx' then
    For I:=0 to ET.SubElementList.Count-1 do begin
      Ce:=TSElement(ET.SubElementList.Objects[i]);
     if ce.Name='EditMultiEx' then begin

     M := IndexOfParamItem(NP,CE.ParamList);
       If M<>-1 then begin
        CS:=PSParam (CE.ParamList[M])^.Data;

       While true do begin
        //Writeln('[',CS,']');
         if CS='' then exit;

          Next1(CS,'#');CS1:=Next1(CS,':');
          L:=StrToInt(CS1);CS1:=Copy(cs,1,L);Delete(cs,1,L);
           New(C);
           C^.Name:=CS1;
           C^.VName:='';
           C^.Rem:='';
           C^.Option:='';
           C^.PointDataType:='';
           C^.PointType:=pt;
           Et.PointList.Add(C);
           Next1(CS,'|');
         end
       end;
      exit;
     end;


     end
    end
   end;
  end;
Var
  ETB,ET,BE,CE: TSElement;
  C,C2,CPo,BP: PSPoint;
  L:PSLink;

begin

lev:=0; MC:=0;
Hed1:=TextSHA[0];
Hed2:=TextSHA[1];

I:=0; if ElementList=nil then ElementList:=TStringList.Create;
ElementList.Clear;

 ParserOneLev( ElementList );
       MC:=MC+ ElementList .Count;

 {Добавляю  точки из базы (! пока для одного койтейнера)}

 For I:=0 to ElementList.Count-1 do begin
   ET:=TSElement(ElementList.Objects[i]);
   N:=ET.Name;

   K:=BaseElementDrawList.IndexOf(N);
   if k=-1 then continue;
   ETB:=TSElement(BaseElementDrawList.Objects[K]);

   ET.TypeSUB:=ETB.TypeSUB;// Учитываю TypeSUB

   For J:=0 to etb.PointList.Count-1 do begin
    C:= PSPoint(etb.PointList[j]);
    K:= IndexOfPointItem(C^.name, et.PointList);
   If (c^.Option<>'/Hide') or (K<>-1 )then  Begin
   New(C2);C2^:=C^;

    C2^.Name:=C^.Name;
    C2^.VName:=C^.VName;
    C2^.Rem:=C^.REM;

//  K:=IndexOfPointItem(C^.name^, et.PointList);
  if K=-1 then Begin
   C2^.Option:='';
   Et.PointList.Add(C2);//.Insert(0,C2);

end else begin
    C2^.Option:='';
    C:= PSPoint(et.PointList[K]);
    ClearPointItem(C);C^:=C2^;
    Dispose (C2);
  end;
 End;

end; //for etb.PointList

 //Добавляю спиок доплнительных точек
 // Лишняя сущьность? Да. Но без нее пока ни как необотйтись .
 If ETB.ExtPointList <> Nil then
 For J:=0 to ET.PointList.Count-1 do
 Begin
  C:=PSPoint(ET.PointList[J]);
  K:=IndexOfPointItem(C^.Name,ETB.ExtPointList);
  if k=-1 then continue;

  C2:=PSPoint(ETB.ExtPointList[K]);
  ET.PointList.delete(J);

    C^:=C2^;
    C^.Name:=C2^.Name;
    C^.VName:=C2^.VName;
    C^.Rem:=C2^.REM;
    C^.PointDataType:=C2^.PointDataType;

    C^.Option:='';

  ET.PointList.Add(C);
 end;

 end; // For ElementList


 //Обработка секции SUB
  For I:=0 to ElementList.Count-1 do
  begin
   ET:=TSElement(ElementList.Objects[i]);
   ID:=ElementList[i]; N:=ET.Name;

   if (ET.TypeSUB<>'') Or (ET.Name='HubEx') Then
   begin
   // Временно спец обработка для 'Hub'
   if (ET.Name='Hub') Or (ET.Name='HubEx') Then begin

   //Исходящие точки
   if  ET.LinkList.Count>0 then
   For J:=0 to ET.LinkList.count-1 do
   begin

    New(C);
    if (ET.Name='Hub') then
    C^.Name:='onEvent'+IntToStr(J+1) else C^.Name:='onEvent';
    C^.VName:='';
    C^.Rem:='';
    C^.Option:='';
    C^.PointType:=ptOn;
    Et.PointList.Add(C);
   end;

   K:=IndexOfParamItem('InCount',ET.ParamList);
   If K<>-1 then begin
    K:= StrToInt(PSParam(ET.ParamList[K])^.Data);

   //Входящие точки J = 1..k
   For J:=1 to k do begin
    New(C);
    C^.Name:='doEvent'+IntToStr(J);
    C^.VName:='';
    C^.Rem:='';
    C^.Option:='';
    C^.PointType:=ptDo;
    Et.PointList.Add(C);
   end;

   end else
// Если нет 'InCount'
//(для HubEx всегда для Hub когда есть только один входящий линк )
   For k:=0 to ElementList.count-1 do
   begin
   CE:=TSElement(ElementList.Objects[k]);

   if  CE.LinkList.Count>0 then
   For J:=0 to CE.LinkList.count-1 do begin
     L:=PSLink( CE.LinkList[J]);

   If L^.Id = ID  then
   begin
    New(C);
    C^.Name:=L^.PointTO;
    // 'doWork'+IntToStr(Et.PointList.Count+1);
    C^.VName:='';
    C^.Rem:='';
    C^.Option:='';
    C^.PointType:=ptDo;
    Et.PointList.Add(C);
   end;

   end

   end

   end

  end; // 'Hub'
end;

///GetData
For I:=0 to ElementList.Count-1 do
begin
 ET:=TSElement(ElementList.Objects[i]);
 ID:=ElementList[i]; N:=ET.Name;

if (ET.Name='GetDataEx') then begin

//Входящие точки
begin
 New(C);
 C^.Name:='Data';
 C^.VName:='';
 C^.Rem:='';
 C^.Option:='';
 C^.PointType:=ptData;
 Et.PointList.Add(C);
end;

//Исходящие точки
if  ET.LinkList.Count>0 then
For J:=1 to 3 do begin
  New(C);
  C^.Name:='Var'+IntToStr(j);
  C^.VName:='';
  C^.Rem:='';
  C^.Option:='';
  C^.PointType:=ptVar;
  et.PointList.Add(C);
end;

end;



  if (ET.TypeSUB<>'')  Then
   begin
   // Временно спец обработка для 'GetData'
   if (ET.Name='GetData') Then begin

   K:=IndexOfParamItem('Count',ET.ParamList);
   If K<>-1 then begin
    K:= StrToInt(PSParam(ET.ParamList[K])^.Data);

   //Исходящие точки 1..k
   For J:=1 to k do begin
    New(C);
    C^.Name:='Data'+IntToStr(J);
    C^.VName:='';
    C^.Rem:='';
    C^.Option:='';
    C^.PointType:=ptVar;
    Et.PointList.Add(C);
   end

   end;
  end
 end
end;

PointIsEditMultiEx('WorkCount' , ptDo);
PointIsEditMultiEx('EventCount', ptOn);
PointIsEditMultiEx('DataCount' , ptData);
PointIsEditMultiEx('VarCount'  , ptVar);



{
  // Контейнер
  // Куча непоняток
  //
   For k:=0 to ElementList.count-1 do
    begin
    ET:=TSElement(ElementList.Objects[k]);
     if ET.SubElementList<>nil then begin
     if et.Name = then

     end
    end;
 }

end;


// Конвертор  SHA 2 TXT
// Схема берется из гобальной переменной TextSHA:TStringList=nil;
procedure SHA2TXT;
Var
s1,S,N:String;
COl,SX,SY,X1,Y1,X2,Y2,Cdo,Con,Cdat,Cvar,W,h,X,Y,K,I,J:Integer;
ET,ET2,ETB:TSElement;
C,C2: PSPoint;
L:PSLink;


Procedure ContactChip2d; // Контакты чипа
Var
J,YF,XF:Integer;
begin

   if (Et.Name<>'GetDataEx') and  (Et.Name<>'HubEx') then begin


  For J:=0 to Cdo-1 do begin
  Xf:=X;Yf:=y+Sy*J+6;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
    //CK.EllipseC(x,y+Sy*J+6,3,3);

  end;
  For J:=0 to Con-1 do begin
    Xf:=x+W*SX;Yf:=y+Sy*J+6;
    MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));

   // CK.EllipseC(x+W*SX,y+Sy*J+6,3,3);
  end;

  For J:=0 to Cdat-1 do begin
     Xf:=X+Sx*J+7;Yf:=y;
     MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));

 //   CK.EllipseC(X+Sx*J+7,y,3,3);
  end;
  For J:=0 to Cvar-1 do begin
     Xf:=X+Sx*J+7;Yf:=y+H*SY+SY;
     MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));

    //CK.EllipseC(X+Sx*J+7,y+H*SY,3,3);
  end;
end   else begin
 x:=x+SX-1;
 y:=y+SY-1;
  Xf:=x-3;Yf:=y;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
  Xf:=x;Yf:=y-3;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
  Xf:=x+3;Yf:=y;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
  Xf:=x;Yf:=y+3;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
  Xf:=x;Yf:=y;
  MiniSHA.Add(Format('s(%d,%d)' , [XF,YF]));
 end;
end;

Procedure Link2d;
Var
I,J,K:Integer;
begin

 For I:=0 to ElementList.Count-1 do begin
  ET:=TSElement(ElementList.Objects[i]);
  //Link
  if et.LinkList.Count>0 then
  For J:=0 to et.LinkList.Count-1 do begin
   L:=PSLink( et.LinkList[J]);

   // Writeln (' [',L^.PointName^,']->' );
   // Writeln ('-> [',L^.PointTO^,'] ' );

   K:=IndexOfPointItem(L^.PointName,et.PointList);
  // Writeln (K);
   If K=-1 then continue;
   C:=PSPoint(et.PointList[k]);

   K:= ElementList.IndexOf( L^.Id );
   If K=-1 then continue;
   ET2:=TsElement(ElementList.Objects[K]);
   k:=IndexOfPointItem(L^.PointTO, et2.PointList);
   If K=-1 then continue;
   C2:=PSPoint(et2.PointList[K]);

  if C^.PointType in [3,4] then Col:=ClRed else Col:=clGreen;
   if l^.LinkCP<>'' then
  begin
  //X2:=C^.x-1; Y2:=C^.y-1;

  S:= l^.LinkCP;
     X1:=C^.x-1; Y1:=C^.y-1; S:= l^.LinkCP; X2:= C2^.x-1;Y2:=C2^.y-1;

      MiniSHA.Add(Format('p[%d]((%d,%d)',[col,x1,y1])+S+
                  Format('(%d,%d))',[x2,y2]));

  end else
   MiniSHA.Add(Format('p[%d]((%d,%d)(%d,%d))',[col,C^.x,C^.y-2,C2^.x,C2^.y-2]));

  end;

 end;
end;

Var
YF,XF,YF1,XF1:Integer;
TS:TStringList;
begin

// "на всякий пожарный"...
if BaseElementDrawList = nil then
begin
TS:=TStringList.Create;
CreateOrLoadElementBase('','Delphi.dat',false,TS);
ParserElementBase(TS);

//Memo2.Text:=cp1251toUtf8(Ts.Text);
ts.Free;

end;
if ElementList <> nil then ElementList.Clear;
parsing_sha.SHA_Parser(TextSHA);

if MiniSHA=nil then MiniSHA:=TStringList.Create;
if MiniSHA.Count >0 then   MiniSHA.Text:='';
   Sx:=7; SY:=7;

// Тест формата

// для всех элементов схемы
For I:=0 to ElementList.Count-1 do begin
   ET:=TSElement(ElementList.Objects[i]);
   N:=ET.Name;
   X:=ET.eX; Y:=ET.eY;

et.CalkMetrix;
Cdo:=ET.Cdo; Con:=ET.Con; CVar:=ET.CVar; CDat:=ET.CDat;
W:=et.WW;  H:=et.HH;

Sx:=et.StepX; Sy:=et.StepY;

 if (Et.Name<>'GetDataEx') and (Et.Name<>'HubEx') then begin
   // "Чип"
   X:=ET.eX; Y:=ET.eY;
   X2:=x+(w*Sx);Y2:= y+(h*Sy)+Sy;
   MiniSHA.Add(Format('c(%d,%d,%d,%d)',[x,y,x2,y2]));
 end;
   // контакты "Чипа"

   ContactChip2d;

end;//for ElementList

Link2d;   // Конверсия связей

/// MiniSHA.SaveToFile('MiniSHA.Txt');

end;


end.

//Прорисовка схемы в OpenGl (По мотивам схемы Hiasm3D.sha  )

Procedure Draw_OGL_LoadSHA_Test01(DX_,DY_,DZ_,scale:Single;
FS:TStringList);
 Var
 XX,YY, A,b,c,AB,BC,CA,LI:LongInt;

 S1,S:String;
  CK:real;
  SC:TM_RGB;
  dodec : array[0..19, 0..2] of GLfloat;
  const
    CC:LongInt=0;
    CR:TM_RGB=(R:1;G:0;B:0);

  begin

//Показ модели
    CC:=0;
     XX:=0;YY:=0;
SC:= M_RGB;
for LI:=0 to FS.count-1 do
 begin
 S:= FS[LI];
  if (modeX = GL_SELECT ) and (S[1]<>'c') then continue;
  Case S[1] of
  //c(551,175,583,207)

   'c': begin
          Sscanf(S,'c(%d,%d,%d,%d)' , [@A,@B,@C,@AB]);
          If modeX = GL_SELECT then glLoadName (CC+10000) else
           If SHint=CC+10000 then  begin  M_RGB:=CR;

           //!!! Криво !!!
           //===============================
   if MoveObjX<> 0 then begin C_ObjX :=C_ObjX+ MoveObjX; MoveObjX:=0; end;
   if MoveObjY<> 0 then begin C_ObjY :=C_ObjY+ MoveObjY; MoveObjY:=0; end;
           XX:=C_ObjX;YY:=C_ObjY;
           end else begin XX:=0;YY:=0;end ;
          //====================================

           DrawCube2( (A+XX)/scale, (B+YY)/scale, 0,
                      (c+XX)/scale, (AB+YY)/scale,0.03);
           glColor3f(1,1,0);
         
           DrawCube2( (A+XX)/scale, (B+YY)/scale, 0
                              ,(A+XX)/scale+0.1, (B+YY)/scale+0.1,0.04);
          //--------------------------------------------------

          If modeX = GL_SELECT then glLoadName (0) else  M_RGB:=SC;
           CC:=CC+1;
          end;
   's': begin
         Sscanf(S,'s(%d,%d)' , [@A,@B]);
         glPushMatrix();
               glTranslatef(A/scale, B/scale, 0);
          glColor3f(1,1,0);
          glutSolidSphere( 0.02,5,5);
        //glutWireSphere( 0.02,5,5);
        glPopMatrix();
        end;
   'p': begin
        glColor3f(1,0.4,0.1);
        If next1(S,'[')<>'' then
        begin
         C:=StrToInt(next1(S,']'));
         glColor3ubv(@C);
        end;
        next1(S,'(');
         glLineWidth(3);

         glBegin( GL_LINE_STRIP  );
        Repeat
        // next1(S,'(');
         S1:=next1(S,')');Sscanf(S1,'(%d,%d' , [@A,@B]);
           glVertex3f(A/scale, B/scale,0.01);
         until s[1]=')';
        glEnd;

   end;

   end;

 end;

 end;