Вверх ↑
Этот топик читают: Гость
Ответов: 953
Рейтинг: 12
#31: 2021-07-28 16:34:00 ЛС | профиль | цитата
"Контейнеровоз" в первом приближении...




Пока что код ужасен и работает только с ChildFormEx ...

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);



Вопрос к экспертам и знатокам!
Что означает "#" в описании свойств WorkCount,EventCount,DataCount,VarCount в элементе EditMultiEx
Заранее спасибо!

Редактировалось 3 раз(а), последний 2021-07-28 16:45:06
карма: 0

0
Ответов: 1988
Рейтинг: 633
#32: 2021-07-28 17:29:01 ЛС | профиль | цитата
AlexKir писал(а):
Что означает "#" в описании свойств WorkCount,EventCount,DataCount,VarCount в элементе EditMultiEx

Вот нет чтоб скриншотом вопрос задать или строку с этой решеткой выложить, догадайся теперь про какую решетку вопрос.
Ну тогда и ответ такой же: Открываем справку F1, смотрим HiAsm\Оболочка\Контейнеры в самом низу про решетку написано.
карма: 9

0
Ответов: 953
Рейтинг: 12
#33: 2021-07-29 13:27:30 ЛС | профиль | цитата
>Вот нет чтоб скриншотом вопрос задать или строку с этой решеткой выложить, догадайся теперь про какую решетку вопрос.
Ладно извиняюсь и постараюсь учесть замечание...
sla8a писал(а):
Ну тогда и ответ такой же...


И на том спасибо!( Хелп развесистый как старая груша и поиска что характерно нет.. )

"Так же для быстрого добавления зарезервированных точек(т.е. точек, чьи имена начинаются с ##) можно использовать в диалоге Свойств вкладку Точки. В этом случае HiAsm самостоятельно будет добавлять и удалять строки из соответствующих св-тв элемента-редактора."


Хм??? Упс! Оданко, все в очередной раз сложнее чем я думал...
(Хотя для текущей версии парсера-просмотрщика это неважно но нужно будет учесть на будущее )
  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)



Но я вообще-то спрашивал про "одинарную решетку" в начале описания списка точек .

VarCount=#7:##count|7:##index|4:NVar|3:Var|
_________^_____________________________________
Это просто символ начала списка или что-то еще?
.

Редактировалось 8 раз(а), последний 2021-07-29 13:51:04
карма: 0

0
Ответов: 1988
Рейтинг: 633
#34: 2021-07-29 18:47:20 ЛС | профиль | цитата
AlexKir писал(а):
Но я вообще-то спрашивал про "одинарную решетку" в начале описания списка точек.
По вопросу это сложно было понять. Тем более вот это:
AlexKir писал(а):
в описании свойств
больше подходит под мой ответ.
AlexKir писал(а):
Это просто символ начала списка или что-то еще?
Этот символ (насколько я знаю) означает массив строк в котором: указывается длинна строки,двоеточие,текст строки,символ вертикальная палка после каждой строки. Можете посмотреть к примеру StrList хранит список строк в том же формате:

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

0
Ответов: 953
Рейтинг: 12
#35: 2021-07-29 19:13:27 ЛС | профиль | цитата
Благодарю за поддержку! (Постараюсь задавать вопросы более ясно. Хотя случай с "двойными решётками" мне просто в примерах сходу не попадался, вот я и наивно думал, что может быть только одинарная. )

Редактировалось 1 раз(а), последний 2021-07-29 19:14:00
карма: 0

0
Ответов: 953
Рейтинг: 12
#36: 2021-07-31 12:03:14 ЛС | профиль | цитата
Поправил конверсию в SHA2TXT.
( Если честно так и не понял, что там было "не то" и просто переделал процедуру из уже отлаженной "отрисовки 2д-превью", а вообще нужно будет убрать этот лишний код и сделать 2д версию отрисовки из псевдо формата "TXT" и для превью. Бо старина Окам за углом бритву точит. )
Просто красивый скрин


Специально для "боящихся 3д" схему вращать не стал.
Но жанровая сценка "Поиск утечки на орбитальной станции" получилась по моему неплохо
Зы
Какое это имеет отношение к парсингу SHA-формата? А самое прямое! Процедура SHA2TXT- часть парсера и к тому-же как-то отрисовывать схему всеравно нужно, а как именно в данном случае дело десятое.

Надеюсь, что скоро обновлю код выложенный в шапке темы целиком ( нужно немного "причесать" код и доделать парсинг контейнеров "в общем виде")

Редактировалось 9 раз(а), последний 2021-07-31 12:42:53
карма: 0

0
Ответов: 953
Рейтинг: 12
#37: 2021-09-13 13:43:10 ЛС | профиль | цитата
И так "пока суть до дела" решил все-же выложить текущую "летнюю" версию парсера от 15.08.21 "как есть".

Недоделок,кривизны и "не универсальных решений"(ака "Отверток") куча но поскольку я сейчас занят другими проектами и разработками то пусть пока будет хоть что-то...


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.

Основные процедуры попрежнему .

Procedure CreateOrLoadElementBase(IniDir,baseName :String;Upd:Boolean;var TS:TStringList);
Procedure ParserElementBase(var TS:TStringList);
Procedure SHA_Parser(TextSHA:TStringList);
// Конвертор SHA 2 TXT
procedure SHA2TXT;

Результат тут

MiniSHA:TStringList=nil;

//Прорисовка схемы в 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;


Редактировалось 4 раз(а), последний 2021-09-14 01:39:38
карма: 0

0
Ответов: 4743
Рейтинг: 529
#38: 2021-09-13 16:54:40 ЛС | профиль | цитата
HiAsmSDK.sha


Редактировалось 1 раз(а), последний 2021-09-13 16:55:49
карма: 6
0
Ответов: 953
Рейтинг: 12
#39: 2021-09-14 00:35:16 ЛС | профиль | цитата
Спасибо, скачал! Буду разбираться.
(Хм как я понял использует "движок из среды" ? hiasm.dll elman.dll elmen.dll )



Работает но увы малость не то !

Редактировалось 6 раз(а), последний 2021-09-14 01:43:13
карма: 0

0
39
Сообщение
...
Прикрепленные файлы
(файлы не залиты)