C.Ю.Соловьев

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

Программа курса  >>  Пример "большой" программы  >>  Модуль EXIT_FMS

(* EXIT_FMS использует: KEYS_FMS  *)
(*                      MENU_FMS  *)
(*                      OKHO_FMS  *)
(*                      OPEN_FMS  *)
(*                      SHOW_FMS  *)
(*                      STAK_FMS  *)
(*                      TYPE_FMS  *)
(*                      UNIF_FMS  *)

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

Uses   CRT, UNIF_FMS, TYPE_FMS, OKHO_FMS, STAK_FMS,
       DOS, KEYS_FMS, SHOW_FMS, OPEN_FMS, MENU_FMS;

function EXIT_MGE : boolean;

                          IMPLEMENTATION

var BAPS : String;

function Xelem(N : integer) : integer;
   var C,S : String;
       X,Z : integer;
begin   S:=BAPS;
        X:=0;
        while Fin_Str(C,S) do begin
           N:=N-1;
           if N = 0 then Z:=X+2;
           X:=X+Length(C)+4
        end;
        Xelem:=Z+(82-X) div 2     end;

function NAKT(N : integer) : integer;
   var S : String;
begin   S:=NumbStr(N,BAPS);
             if S = 'Сохранить'  then NAKT:=1
        else if S = 'Отменить'   then NAKT:=2
        else if S = 'Удалить'    then NAKT:=3
        else if S = 'Продолжить' then NAKT:=4
        else                          NAKT:=5   end;

procedure BornElem_Exi(O : pMenuRec; H,K : integer);
   var I : integer;
begin   for I:=H to K do
        OnScrXYA(Xelem(I),10,O^.CoMa,NumbStr(I,BAPS))  end;

procedure BornCurs_Exi(O : pMenuRec; Base,Curs,Surs : integer);
   var X,I : integer;
         S : String[80];
begin   with O^ do begin
           X:=Xelem(Curs);
           S:=NumbStr(Curs,BAPS);
           I:=Length(S);
           RescFul(Cufi,X-1,10,X+I,10);
           with Cufi do
           for I:=XH to XK do SCR[YH,I].att:=CoCu;
           case NAKT(Curs) of
         1 : S:='Сохранить последние изменения и выйти из редактора';
         2 : S:='Отменить последние изменения и выйти из редактора';
         3 : S:='Удалить незаполненные группы полей';
         4 : S:='Продолжить редактирование'
        else S:='Закончить редактирование';
           end;
           while Length(S) < 60 do S:=' '+S+' ';
           OnScrCYA(12,$3B,LappStr(S,60))
        end                                                       end;

procedure ElseBody_Exi(O : pMenuRec);
begin   with O^ do Rend:=(Teke = ESC) or (Teke = ENTER)  end;

procedure MenuBody_Exi(O : pMenuRec);
begin     MenuBody_Gor(O,ElseBody_Exi)   end;

function EXIT_MGE : boolean;
   var pGATA,eCOCT : boolean;
                 S : String;
                 I : integer;
begin   pGATA:=GATA;
        if not GrandCorr then
        if    pGATA      then begin
           EXIT_MGE:=true;
           Exit
        end;
        eCOCT:=MembEmpGr;
        if GrandCorr then BAPS:='Сохранить+Отменить+'
                     else BAPS:='Закончить+';
        if   eCOCT   then BAPS:=BAPS+'Удалить+';
                          BAPS:=BAPS+'Продолжить+';
        CuSh(false);
        PUSH(Glob_Menu,Size_Menu);
        OpnCoo_SP(6,6,75,12,SVpam,' Выход из редактора }');
        if pGATA
        then      S:='Судя по формальным признакам сообщение заполнено корректно'
        else if eCOCT
             then S:='В составном сообщении имеются незаполненные группы полей'
             else S:='В сообщении имеются незаполненные поля (см.отметки "'+GLK+'")';
        OnScrCYA(8,SVpam,S);
        COEXXY(10,71,9);
        SimpMenu(Glob_Menu);
        with Glob_Menu do begin
           CoMa:=SVpam;
           CoCu:=SVbar
        end;
        MenuInit(aGlob,QuanStr(BAPS));
        with Glob_Menu do begin           { --------- Умолчания --------- }
           if not pGATA then Curs:=Kall;  { ПРОДОЛЖИТЬ - для некорректных }
           for I:=1 to Kall do
           if NAKT(I) = 3 then Curs:=I    { УДАЛИТЬ - по умолчанию        }
        end;
        MenuRun (aGlob,CodeElem_All,
                       BornElem_Exi,
                       KillElem_All,
                       BornCurs_Exi,
                       MenuBody_Exi);
        with Glob_Menu do
        if Teke = ESC then I:=4 { = ПРОДОЛЖИТЬ }
                      else I:=NAKT(Curs);
        ClsCoo_SP;
        POP(Glob_Menu);
        CuSh(true);
        EXIT_MGE:=false;
        case I of
      1 : begin Mode_F02; EXIT_MGE:=not GrandCorr end;{ Сохранить+Выход    }
      2 :       EXIT_MGE:=true;                       { Отменить +Выход    }
      3 : begin EXIT_MGE:=false;
                KillEmpGr;                            { Удалить группы     }
                Init_Gey;
                B_Ha_Gey(ESC)
          end;
      4 :       EXIT_MGE:=false;                      { Продолжть = ESC    }
      5 :       EXIT_MGE:=true;                       { Выход из редактора }
        end                                       end;

end.

Вопросы?