Методические материалы
по курсу
"Алгоритмы и алгоритмические языки"

(* LOAD_FMS использует: D_UNIT    *)
(*                      MENU_FMS  *)
(*                      TYPE_FMS  *)

{$A+,B-,D-,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 16384,0,655360}
Unit Load_FMS;          INTERFACE

Uses TYPE_FMS, MENU_FMS, D_unit;

procedure Con_Menu(H : pHead; N : integer);
procedure Hac_Menu(H : pHead             );

procedure WritField;
procedure LoadField(F : integer);

function TXT_field(N : integer) : boolean;

                        IMPLEMENTATION

procedure Con_Menu(H : pHead; N : integer);
   var HM : pHead;
begin   HM:=NIL;
        with H^.BDS[N].MN_MEM^ do
        IF   (1 <= Ent) and (Ent <= How_ELT(H^.BDS[N].MN_MEM))
        THEN HM:=ELT[Ent].DTL;
        H^.BDS[N].DTL:=HM;
        if HM <> NIL then
        with HM^ do begin
           BK_PTR:=H;
           BK_POS:=N
        end                                               end;

procedure Hac_Menu(H : pHead);
   var I,J : integer;
begin   for I:=1 to H^.HSF do
        with H^.BDS[I] do begin
           if MN_MEM <> NIL then begin
              Con_Menu(H,I);
              for J:=1 to How_ELT(MN_MEM) do
              with MN_MEM^.ELT[J] do
              if DTL <> NIL then Hac_Menu(DTL)
           end;
           if Only_DTL(H,I) then Hac_Menu(DTL)
        end                                end;

function MaxLeng(H : pHead) : integer;
   var I,K : integer;
begin   K:=0;
        for I:=1 to H^.HSF do
        with H^.BDS[I] do
        if DTL <> NIL then K:=K+MaxLeng(DTL)
                      else K:=K+ LFT;
        MaxLeng:=K                       end;

function MaxLef(H : pHead) : integer;
   var I,L,M : integer;
begin   M:=0;
        for I:=1 to H^.HSF do
        with H^.BDS[I] do begin
           if DTL^.KND = 4 then L:=MaxLeng(DTL^.BDS[1].DTL)
                           else L:=MaxLeng(DTL);
           if M < L then M:=L
        end;
        MaxLef:=M                                       end;

procedure WritField;
begin   if FITEK < 0 then D_Write(abs(FITEK));
        FITEK:=abs(FITEK)                 end;

procedure LoadField(F : integer);
   var H : pHead;
       C : integer;
begin   if MEAD^.BDS[F].DTL = NIL then Exit;
        if       abs(FITEK) <> F  then begin
           WritField;
           FITEK:=F;
           D_Read(F);
           H:=MEAD^.BDS[F].DTL;
           H^.BK_PTR:=MEAD;
           H^.BK_POS:=F;
           Hac_Menu(H)
        end;
        with MEAD^.BDS[abs(FITEK)] do begin    { Вычислить CR_TOX - базу X }
           if CR_TOX <> 0 then Exit;
           C:=Glob_Menu.Mafi.XH;
           if (1 <= C) and (C <= 80) then CR_TOX:=C
                                     else CR_TOX:=1; { Glob_Menu не исп-ся }
           Inc(CR_TOX,Length(AlfaName(CTP)));
           if Modes[Defi] then
           if TIT  <> NIL then begin
              C:=CR_TOX+Length(AlfaName(TIT));
              if C+MaxLef(DTL) <= Lapos then CR_TOX:=C
           end
        end                                        end;

{ TXT_field : N - номер поля по скелету сообщения }
{       Res = TRUE - Если поле требует текст.файл }

function TXT_field(N : integer) : boolean;
   var H : pHead;
       I : integer;
begin   TXT_field:=false;
        if Type_Field(N) <> 0 then Exit;
        LoadField(N);
        H:=MEAD;
        for I:=1 to 2 do begin
           H:=H^.BDS[N].DTL;
           if H = NIL     then Exit;
           if H^.HSF <> 1 then Exit;
           N:=1
        end;
        with H^.BDS[1] do if MN_MEM <> NIL then
        with  MN_MEM^  do if    LON <> ''  then
        TXT_field:=(POS('.TXT',LON) <> 0)   end;

end.