(* EDIS_FMS использует: DESK_FMS *)
(* HELP_FMS *)
(* KEYS_FMS *)
(* LOAD_FMS *)
(* MENU_FMS *)
(* OKHO_FMS *)
(* OVER_FMS *)
(* SELE_FMS *)
(* STAK_FMS *)
(* TABS_FMS *)
(* TYPE_FMS *)
(* UNIF_FMS *)
{$A+,B-,D-,E+,F-,G-,I+,L+,N-,O-,R+,S+,V+,X-}
{$M 36384,0,655360}
unit Edis_FMS; { Редактор форматированной строки }
INTERFACE
uses CRT, KEYS_FMS, OKHO_FMS, TYPE_FMS, LOAD_FMS, HELP_FMS,
SELE_FMS, MENU_FMS, OVER_FMS, STAK_FMS, UNIF_FMS,
DESK_FMS, TABS_FMS;
procedure Edi_String(YT : integer);
procedure Edi_Genera(YT : integer);
IMPLEMENTATION
VAR Htab : pHead; { Позиция для выполнения операции Tab }
Ntab : integer;
Hbomb : pHead; { Uno для ввода символа }
Nbomb : integer;
Complex : integer; { Сложность строки }
{ Вычисляется в CalcTekCTP }
{ Используется в FORMAT_24 и FORMAT_25 }
{ После подключения структуры из меню }
{ сложность строки может измениться. }
Cmain : boolean; { Корректность первоначальной строки }
(***************************************************
procedure PrnP(var A : Posy);
var L : LongInt;
begin with A do begin
Move(H,L,4);
writeln('H=',L,' Y=',Y,' X=',X,' <<<<<');
end end;
***************************************************)
procedure COXPAH;
begin coxCB:=CB; CB[0]:=chr(0);
coxCX:=CX;
coxOT:=OT end;
procedure BOCCTA;
begin CB:=coxCB;
CX:=coxCX;
OT:=coxOT end;
procedure CEKATOP(var S : alfa);
var I,L : integer;
begin L:=Length(S);
S[0]:=chr(0);
for I:=1 to L do
if S[I] <> ' ' then S[0]:=chr(I) end;
function H1ST(S : pAlfa) : integer;
var I : integer;
begin for I:=1 to Length(S^) do
if FOCH(S^[I]) then begin
H1ST:=I;
Exit
end;
H1ST:=0 end;
function ExistREP : integer;
var I : integer;
begin for I:=1 to Length(CB) do
if CB[I] = 'R' then
if OT[I].MIG > 127 then begin
ExistREP:=I;
Exit
end;
ExistREP:=0 end;
procedure BBOC(A : Char; M,N,I : integer; P : pHead);
var L : integer;
begin L:=Length(CB)+1;
if 80 <= L then Exit;
CB[0]:=chr(L);
CB[L]:=A;
OT[L].Y:=N;
OT[L].X:=I;
OT[L].H:=P;
OT[L].MIG:=M end;
procedure METKA_OBS(P : boolean);
begin if P then ICH(80,'О',CDobs)
else ICH(80,'Н',CDnoo) end;
{ TEPKA : P - указатель строки }
{ coxCB:=Значение строки с подрезанными пробелами }
{ и двоеточиями в начале и конце строки }
procedure TEPKA(P : pAlfa);
var L : integer;
begin if P = NIL then coxCB:=''
else coxCB:=P^;
TwoPress(coxCB);
L:=Length(coxCB);
if 0 < L then
if coxCB[L] = ':' then begin
coxCB[L]:=' ';
Compress(coxCB)
end;
if Pos(':',coxCB) = 1 then begin
coxCB[1]:=' ';
LefPress(coxCB)
end end;
procedure Own_BodyName(H : pHead; N : integer; var C : integer);
begin with H^.BDS[N] do begin
if Sask(BOS,OBS) then C:=CDobs
else C:=CDnoo;
TEPKA(TIT);
end end;
procedure BodyName(H : pHead; N : integer; var C : integer);
begin Own_BodyName(H,N,C);
if coxCB <> '' then Exit;
Str(N,coxCB);
C:=CDkey; end;
procedure ISTF(var L,N : integer); { L - к-во полей }
var I,K : integer; { N - номер N-го лог.поля }
begin L:=0;
for I:=1 to MEAD^.HSF do
if MEAD^.BDS[I].DTL <> NIL then begin
L:=L+1;
if I = N then N:=L
end end;
procedure StrBar(Y,C79,C80 : integer);
begin SCR[Y,79].att:=C79;
SCR[Y,80].att:=C80 end;
procedure FORMAT_NR(YT : integer);
var I,K,N,Y,L : integer;
H,Hb : pHead;
begin StrBar(YT,CDkey,CDkey);
with Glob_Menu.Mafi do begin
Y:=YK+1;
LinWRK:=SCR[Y];
for I:=XH+6 to 70 do LinWRK[I].txt:=Wodul[1,2]
end;
K:=5;
H:=Hmain;
repeat
H:=H^.BK_PTR;
K:=K+18;
until H = NIL;
H:=Hmain;
N:=Nmain;
repeat
Hb:=H^.BK_PTR;
if (H^.HSF <> 1) or (Hb = NIL) then begin
if Hb = NIL then ISTF(L,N) { Истиное к-во полей }
else L:=H^.HSF;
Str(L ,coxCB);
Str(N , CB);
CB:=CB+'/'+coxCB;
N:=K-Length(CB);
for I:=1 to Length(CB) do LinWRK[N+I].txt:=CB[I]
end;
N:=H^.BK_POS;
H:=Hb;
K:=K-18;
until H = NIL;
LineOn(Y) end;
procedure FORMAT_23;
var X,C : integer;
W : boolean;
procedure OO(var S : Alfa; C : integer);
begin if 75 <= X then Exit;
if 75 < X+Length(S) then S[0]:=chr(75-X);
In_LinWRK(X,S,C)
end;
procedure FF(H : pHead; N : integer; S : Alfa);
begin Own_BodyName(H,N,C);
if coxCB = '' then Exit; { P = 79 }
OO(S,CDsys);
OO(coxCB,C);
if Lask(H,N,OBS) then ICH(79,'О',CDobs)
else ICH(79,'Н',CDnoo)
end;
begin Em_LinWRK(1,80,CDsys);
if (not Modes[Pinf]) and (10 <= MEAD^.BDS[abs(FITEK)].CR_TOX)
then begin
LineOn(23);
Exit
end;
X:=0;
with MEAD^.BDS[abs(FITEK)] do begin
if Sask(BOS,OBS) then begin C:=CDobs; coxCB[1]:='О' end
else begin C:=CDnoo; coxCB[1]:='Н' end;
if Modes[Pinf] then ICH(78,coxCB[1],C);
In_LinWRK(X,'Поле: ',CDsys);
W:=Modes[Drus];
Modes[Drus]:=true;
coxCB:=AlfaName(TIT);
if coxCB = '' then coxCB:=AlfaName(CTP);
Modes[Drus]:=W;
TEPKA(addr(coxCB));
OO(coxCB ,C)
end;
if Modes[Pinf] then
if 1 < MEAD^.BDS[abs(FITEK)].DTL^.HSF then
with Hmain^ do
if KND = 4 then FF(BK_PTR,BK_POS,' П/поле: ')
else FF(Hmain ,Nmain ,' П/поле: ');
LineOn(23) end;
procedure FORMAT_25;
var H : pHead;
N,L,C : integer;
procedure BB;
var M : integer;
begin if L < 1 then Exit;
M:=L-Length(coxCB)-1;
if M < 6 then begin
L:=L-3;
On_LinWRK(L,'...',CDsys);
if L < 6 then L:=6;
L:=-L;
Exit
end;
L:=M;
On_LinWRK(L,'\'+coxCB,C);
if (0 <= L) and (L <= 79) then LinWRK[L+1].att:=CDsys
end;
begin if (Complex = 3) and Modes[Pinf] then begin
Em_LinWRK(1,80,CDsys);
L:=77;
while H^.KND = 8 do begin
BodyName(H,N,C);
BB;
N:=H^.BK_POS;
H:=H^.BK_PTR;
end;
if L <> 77 then begin
L:=abs(L)+1;
Move(LinWRK[L],LinWRK[7],2*(78-L));
for N:=1 to L-7 do LinWRK[78-N]:=LinWRK[1];
LineOn(25);
Exit
end
end;
Line_25(LaLa) end;
procedure FORMAT_24;
var L,I,J,O,H,K : integer;
P : pHead;
procedure Lucru(var M : integer; R,S : integer);
var C : integer;
begin M:=M+R;
BodyName(P,M,C);
if J+Length(coxCB)+2 < S then J:=J+Length(coxCB)+2
else M:=M-R
end;
begin P:=OT[CX].H;
O:=OT[CX].Y;
Em_LinWRK(1,80,CDsys);
if Modes[Pinf] then
if Complex <> 1 then
if P^.KND <> 8 then On_LinWRK(0,'Выбор ',CDsys) else begin
BodyName(P,O,J);
J:=Length(coxCB)+2;
with P^ do begin
H:=O;
K:=O;
L:=HSF-O;
if L < O-1 then L:=O-1;
for I:=1 to L do begin
if 1 < H then Lucru(H,-1,67);
if K < HSF then Lucru(K,+1,67)
end;
L:=0;
In_LinWRK(L,'Выбор ',CDsys);
if 1 < H then In_LinWRK(L,#17+#17 ,CDsys); { << }
for I:=H to K do begin
BodyName(P,I,J);
if I = O then J:=(J and $0F) or CDbar;
In_LinWRK(L,' '+coxCB+' ',J)
end;
if K < HSF then In_LinWRK(L,#16+#16,CDsys) { >> }
end
end;
LineOn(24) end;
const CCkey = $1B; { Альтернативная раскраска символов формата }
{ B_FORMAT : OT := строка символов формата подполя (H,N) }
procedure B_FORMAT(H : pHead; N : integer);
var I,J,L,M,C : integer;
begin TEHT(H,N,L,M);
J:=1;
C:=CDkey;
BBOC(' ',CDkey,0,0,NIL); { Первый пробел }
with H^.BDS[N] do
for I:=1 to LFT do begin { Чередование через 10 }
if I <= L then
else if I = L+1 then begin if 1 < I then C:=CDkey+CCkey-C end
else if I = L+M+1 then begin if 1 < I then C:=CDkey+CCkey-C end
else if I <= L+M then begin
J:=J+1;
if 10 < J then begin
J:=1;
C:=CDkey+CCkey-C
end
end;
BBOC(RFT^[I],C,N,I,H)
end end;
(* Old Version
procedure B_FORMAT(H : pHead; N : integer);
var I : integer;
begin with H^.BDS[N] do begin
BBOC(' ',CDkey,0,0,NIL);
for I:=1 to LFT do
BBOC(RFT^[I],C,N,I,H)
end end;
*)
procedure H_FORMAT(H : pHead);
var N,M : integer;
W : boolean;
begin for N:=1 to H^.HSF do
with H^.BDS[N] do begin
if DTL = NIL then B_FORMAT(H,N)
else if Sask(BOS,OBS) then H_FORMAT(DTL)
else if ClearBody(H,N) then BBOC(PLC,CMplc,N,1,H)
else H_FORMAT(DTL)
end end;
procedure O_FORMAT(var O : Posy);
var I : integer;
begin for I:=1 to Length(CB) do
if OT[I].H = O.H then
if OT[I].Y = O.Y then
if OT[I].X = O.X then begin
OT[I].MIG:=OT[I].MIG or $80;
CX:=I;
Exit
end end;
procedure G_FORMAT;
var PH : pHead;
I,PY : integer;
begin PH:=coxOT[coxCX].H;
PY:=coxOT[coxCX].Y;
B_FORMAT(PH,PY);
if Length(CCB) = 1 then Exit;
for I:=coxCX+1 to Length(coxCB) do
if (PH = COT[2].H) and
(PY = COT[2].Y) then Exit
else
if (PH <> coxOT[I].H) or
(PY <> coxOT[I].Y) then begin
PH:=coxOT[I].H;
PY:=coxOT[I].Y;
B_FORMAT(PH,PY)
end end;
procedure PosiTab;
begin Htab:=NIL;
Ntab:=0;
if 0 < CX then begin
Htab:=OT[CX].H;
Ntab:=OT[CX].Y;
while (Htab^.KND = 8) and
(Htab^.BDS[Ntab].MN_MEM = NIL) do begin
Ntab:=Htab^.BK_POS;
Htab:=Htab^.BK_PTR
end;
if Htab^.KND <> 8 then begin
Htab:=NIL;
Ntab:=0;
end
end end;
procedure FORMAT_22;
var I,L,M,N : integer;
H : pHead;
begin Em_LinWRK(1,80,CDsys);
M:=Length(CB)+1;
COXPAH;
H:=coxOT[coxCX].H;
N:=coxOT[coxCX].Y;
if coxCB[coxCX] <> PLC then G_FORMAT
else if H^.BDS[N].DTL = NIL then B_FORMAT(H,N)
else H_FORMAT(H^.BDS[N].DTL);
CX:=0;
for I:=Length(CCB) downto 1 do O_FORMAT(COT[I]); { CX - левое мигание }
PosiTab;
if 0 < CX then L:=WhereX-CX { CX совпадает с WhereX }
else L:=6;
for I:=1 to Length(CB) do ICH(L+I,CB[I],OT[I].MIG);
if Htab <> NIL then begin
if L+Length(CB) <= 66
then On_LinWRK(66,' или меню ',CDsys);
On_LinWRK(77,'TAB' ,CDkey)
end;
if 0 < CX then with OT[CX] do begin
if not FirstCorr then On_LinWRK(0,'^F1 ',CDkey)
else if CB[CX] = PLC then On_LinWRK(0,'ПСТ ',CDdia)
else if Lask(H,Y,EMP) then On_LinWRK(0,'ПСТ ',CDdia)
else if Lask(H,Y,COF) then On_LinWRK(0,'КОР ',CDdia)
else On_LinWRK(0,'НЕК ',CDhek)
end;
BOCCTA;
if not Modes[Pinf] then Em_LinWRK(1,80,CDsys) end;
procedure KillCTP(H : pHead; N : integer);
var I : integer;
begin UnKnField(H,N); { -FITEK }
with H^.BDS[N] do
for I:=1 to LFT do
if FOCH(RFT^[I]) then begin
CTP^[I]:=UNC;
INP^[I]:=' '
end end;
procedure EFF( N : integer); { Exit From Field }
var H : pHead;
begin H:=OT[N].H;
N:=OT[N].Y;
with H^.BDS[N] do begin
if RP_PAT = NIL then Exit; { Not repeat }
if Sask(BOS,RP_BGN) then Exit; { Повторный ввод уже объявлен }
if ClearBody(H,N) then Exit; { Поле вообще не заполнялось }
if CTP^ = RP_PAT^ then Exit; { O'K; RP_BGN = false auto }
Sset(BOS,RP_BGN,true); { Объявить повторный ввод }
RP_PAT^:=CTP^;
KillCTP(H,N);
COT[0].H:=H;
COT[0].Y:=N;
COT[0].X:=H1ST(RFT);
OnceMore { KEYS_FMS }
end;
CBEPTKA(Hmain,Nmain) end;
procedure CalcTekCTP;
var I : integer;
begin CBEPTKA(Hmain,Nmain);
if (OT[0].H <> OT[CX].H) or
(OT[0].Y <> OT[CX].Y) then EFF(0);
with Hroot^ do begin
Complex:=1;
for I:=1 to HSF do
if BDS[I].DTL <> NIL then Complex:=3;
if (Complex = 1) and (1 < HSF) then Complex:=2
end end;
function CHF(var O : Posy) : char;
begin CHF:=O.H^.BDS[O.Y].RFT^[O.X] end;
procedure InputPoints;
var I,J,K : integer;
begin if CB[CX] = PLC then begin
if Yes_PLC(OT[CX].H,OT[CX].Y) then;
Exit
end;
CCB :=CHF(OT[CX]);
COT[1]:= OT[CX];
{ Old if FOCH(CCB[1]) then begin }
I:=OT[CX].Y;
J:=OT[CX].X;
with OT[CX].H^ do
if BDS[I].CR_FRX = J then begin
COT[2].H:=OT[CX].H; J:=BDS[I].CR_TOX;
COT[2].X:=J; I:=BDS[I].CR_TOY;
COT[2].Y:=I;
CCB :=CCB+CHF(COT[2])
end;
{ Old Exit }
{ Old end; }
{ New } IF FOCH(CCB[1]) or (Length(CCB) = 2) then EXIT;
for I:=CX+1 to Length(CB) do
if FOCH(CHF(OT[I])) then begin
CCB :=CCB+CHF(OT[I]);
COT[2]:=OT[I];
Exit
end end;
procedure NextSym;
begin COT[0].X:=-COT[0].X end;
{ if Ges+Inner+Menu then COHT(H,N,L,C) and (C <> 0) }
function GIM_COHT(H : pHead; N : integer; var L,C : integer) : boolean;
begin GIM_COHT:=false;
with H^.BDS[N] do begin
if MN_MEM = NIL then Exit; { Menu }
if MN_MEM^.LON <> '' then Exit; { Inner }
if not Sask(BOS,MN_GES) then Exit; { GES }
end;
COHT(H,N,L,C);
GIM_COHT:=(C <> 0) end;
procedure MenuControl(H : pHead; N,L,C : integer);
var M,R : integer;
begin Max_Menu(H,N,M,R); { SELE_FMS }
if L+C = R then Exit;
BadCode;
COT[0].H:=H;
COT[0].Y:=N;
COT[0].X:=R+1 end;
procedure AutoInput(H : pHead; N,L,C : integer);
var M,I : integer;
S : String;
G : ^String;
begin if Have_Gey then Exit;
S:=Copy(H^.BDS[N].CTP^,L+1,C);
with H^.BDS[N].MN_MEM^ do begin
M:=0;
for I:=1 to HSF do
with ELT[I] do begin
if DTL <> NIL then Exit;
if CTP = NIL then Exit;
if CTP^ <> '' then begin
G:=addr(CTP^[1]);
if Pos(S,G^) = 1 then begin
if M <> 0 then Exit;
M:=I
end
end
end;
if M = 0 then Exit;
with ELT[M] do begin
G:=addr(CTP^[1]);
for I:=Length(G^) downto C+1 do B_Ha_Gey(ord(G^[I]));
end
end end;
procedure InpSym(S : integer);
var I,J,L,M,XX,YY : integer;
HH : pHead;
B : char;
procedure MECTO(I : integer);
begin with COT[I] do begin
XX:=X;
YY:=Y;
HH:=H
end
end;
begin if 0 <= S then B:=chr(S)
else B:=UNC;
if Pos('d',CCB) = 1 then { Особый случай обработки }
if Pos(B,'-_') <> 0 then begin { формата d : Z -> '000' }
MECTO(1);
TEHT(HH,YY,L,M);
if 2 <= L+M-XX then begin
for I:=1 to 3 do B_Ha_Gey(ord('0'));
Exit
end
end;
for I:=1 to Length(CCB) do
if COOprk(CCB[I],B) then begin
MECTO(I);
OT[0]:=COT[I];
COT[0]:=COT[I];
with HH^.BDS[YY] do
if not Sask(BOS,UNE) then begin { Edit разрешен }
if not Sask(BOS,GES) then
if FOCH(RFT^[XX]) then begin { Replace }
TEHT(COT[I].H,YY,L,M);
for J:=L+M downto XX+1 do begin
CTP^[J]:=CTP^[J-1];
INP^[J]:=INP^[J-1]
end
end;
Sset(BOS,RP_BGN,false);
CTP^[XX]:= B ; { Input }
INP^[XX]:='I';
UnKnField(COT[I].H,YY); { -FITEK }
NextSym;
if not FOCH(RFT^[XX]) then MarkContext(HH,YY,'I')
else if GIM_COHT(HH,YY,L,M) then begin
MenuControl(HH,YY,L,M);
if L+M = XX then AutoInput(HH,YY,L,M)
end;
Exit
end
end;
BadCode end;
procedure DelSym(PS : integer; ParOp : boolean);
var XX,YY : integer;
PP : pHead;
procedure Replace;
var I,L,M : integer;
begin TEHT(PP,YY,L,M);
with PP^.BDS[YY] do begin
for I:=XX+1 to L+M do begin
CTP^[I-1]:=CTP^[I];
INP^[I-1]:=INP^[I]
end;
XX:=L+M;
end
end;
begin if CB[PS] = PLC then begin BadCode; Exit end;
if (CB[PS] = 'R') and
(OT[PS].MIG > 127) then begin BadCode; Exit end;
PP:=OT[PS].H;
XX:=OT[PS].X;
YY:=OT[PS].Y;
with PP^.BDS[YY] do
if Sask(BOS,UNE) then BadCode else begin
if FOCH(RFT^[XX]) THEN begin
if Sask(BOS,GES) then begin
if ParOp and (XX < LFT) then NextSym
end else Replace;
CTP^[XX]:=UNC;
INP^[XX]:=' '
end ELSE MarkContext(PP,YY,' ');
UnKnField(PP,YY) { -FITEK | SELE_FMS}
end end;
function DelEmpStr : boolean;
begin if Length(CB) = 1 then DelEmpStr:=(CB[1] = PLC) and
(Hmain^.KND = 4) and
(Nmain > 1)
else DelEmpStr:=false end;
procedure MoveCurs(N : integer);
begin COT[0]:=OT[N];
if 1 < N then { Case TOO + PLC }
if OT[N-1].H = OT[N].H then
if OT[N-1].Y = OT[N].Y then
if OT[N-1].X = OT[N].X then NextSym end;
procedure CtrlMove(H : pHead; P : boolean);
var I,M,L,C : integer;
begin L:=Length(CB);
if L = 0 then Exit;
C:=1;
for I:=1 to CX do { Найти начало тек.поля }
if OT[I].X = 1 then C:=I;
for I:=1 to L-1 do begin { Найти след. позицию }
if P then M:=I
else M:=L-I;
M:=(M+C-1) mod L + 1;
if OT[M].X = 1 then begin
MoveCurs(M);
Exit
end
end end;
function MakeEnter : boolean;
var K : integer;
begin MakeEnter:=false;
EFF(CX);
K:=ExistREP;
if 0 < K then begin MoveCurs(K); BadCode; Exit end;
if not MayEnter then begin BadCode; Exit end;
B_Ha_Gey(Enter);
MakeEnter:=true end;
function SpaceTab : boolean;
var I,L,M : integer;
begin SpaceTab:=false;
if Htab = NIL then Exit;
with OT[CX] do begin
TEHT(H,Y,L,M);
for I:=L+1 to L+M do
if H^.BDS[Y].INP^[I] <> ' ' then Exit;
SpaceTab:=true
end end;
procedure CEKPET;
var K : integer;
begin if ADM <> '9' then Exit;
repeat
K:=Gey;
until K <> Alt_F4;
if K <> INS then B_Ha_Gey(K)
else if Hbomb <> NIL then begin
Lset(Hbomb,Nbomb,UNE,
not Lask(Hbomb,Nbomb,UNE));
FITEK:=-abs(FITEK);
GrandCorr:=true
end end;
{ SaveKeys : Запомнить значения ключевых п/полей }
{ NNN и KEF - вспомогательные }
{ Res = CKEY = Pref+Post+Value+...Post+Value+ }
{ где Pref+Post - селектор п/поля }
{ Value - старое значение п/поля }
function KEF(V : pAlfa) : boolean;
var S : String;
begin if V = NIL then KEF:=false else begin
S:=V^;
UpCaseStr(S);
KEF:=(Pos('/KEY/','/'+S) <> 0)
end end;
procedure SaveKeys(PTH : String; H : pHead);
var I : integer;
S : String;
procedure REM(MN : pMenu);
var J : integer;
begin if MN <> NIL then
with MN^ do
if LON = '' then
for J:=1 to HSF do
if ELT[J].DTL <> NIL
then SaveKeys(S+'<'+NNN(J)+'>',ELT[J].DTL)
end;
begin if H <> NIL then
for I:=1 to H^.HSF do
with H^.BDS[I] do begin
S:=PTH+'.'+NNN(I);
REM(MN_MEM); { Меню }
SaveKeys(S,DTL); { Потомок }
if (DTL = NIL) or (MN_MEM <> NIL) then
if KEF(VRF) then begin
SummStr(CKEY,S);
UnoStr(S,H,I,false);
SummStr(CKEY,S)
end
end end;
{ RendKeys : Обработка общих ключей процедур CBAPKA и Edi_Generat }
function RendKeys(S : integer; Md : boolean; var pCase : boolean) : boolean;
var W : boolean;
procedure Memb(F : char);
begin W:=(Pos(F,LaLa) <> 0)
end;
begin RendKeys:=false;
pCase:=false;
case S of
F1,901 : begin Cha_Help(S); Exit end; { OVER_FMS }
PgUp, UP : W:=mayUP;
PgDn,DOWN : W:=mayDOWN;
F2 : W:=GrandCorr or (not FirstCorr);
F3,F4,F9,F10,ESC : W:=true;
F5 : Memb('5');
F6,F8 : Memb('6');
F7 : Memb('7');
else begin pCase:=true; Exit end;
end;
if Md then EFF(CX); { запуск из проц. CBAPKA }
if W then B_Ha_Gey(S)
else BadCode;
RendKeys:=W end;
function CBAPKA(S : integer) : boolean;
var Cs : boolean;
function QUnb(May : boolean) : boolean; { Without BadCode }
begin QUnb:=May;
EFF(CX);
if May then B_Ha_Gey(S)
end;
begin OT[0]:=OT[CX]; { Запоминается предыдущая позиция курсора }
MoveCurs(CX); { Для вычисления следующей позиции курсора }
CBAPKA:=RendKeys(S,true,Cs);
if Cs then case S of
LEFT : if CX <= 1 then BadCode else MoveCurs(CX-1);
RIGHT : if Length(CB) <= CX then BadCode else MoveCurs(CX+1);
Ctrl_LEFT : CtrlMove(Hroot,false);
Ctrl_RIGHT : CtrlMove(Hroot,true );
TAB : if Htab = NIL then BadCode
else if Lask(Hbomb,Nbomb,UNE) then BadCode
else Mode_TAB(Htab,Ntab);
DEL : if DelEmpStr then CBAPKA:=QUnb(true)
else DelSym(CX,true);
BACK : if CX <= 1 then BadCode else begin
MoveCurs(CX-1 );
DelSym(CX-1,false)
end;
HOME : MoveCurs(1);
ENDD : MoveCurs(Length(CB));
Alt_F1 : if Hbomb <> NIL
then Help_Uno(Hbomb^.BDS[Nbomb].HLP); { HELP_FMS }
Alt_F4 : CEKPET;
ENTER : CBAPKA:=MakeEnter;
Ctrl_F1 : CBAPKA:=QUnb(not FirstCorr);
Ctrl_U : if Cmain then
if not FirstCorr then begin
FirstCorr:=true;
FITEK:=abs(FITEK)+1;
LoadField(FITEK-1);
ReLine79;
CX:=1
end;
ord(' ') : if SpaceTab then B_Ha_Gey(TAB)
else InpSym(S)
else InpSym(S)
end end;
procedure Edi_String(YT : integer);
var I,XX : integer;
begin FirstCorr:=true;
Hroot:=Hmain^.BDS[Nmain].DTL;
XX:=MEAD^.BDS[abs(FITEK)].CR_TOX;
CX:=0;
CB:=''; { Вычислить начальную позицию курсора }
B_CBEPTKA(Hmain,Nmain);
CX:=WhereX;
CX:=CX-XX;
if CX < 1 then CX:=1;
if Length(CB) < CX then CX:=Length(CB);
MoveCurs(CX);
OT[0]:=COT[0];
if Have_Gey then begin
I:=Gey;
B_Ha_Gey(I);
if (I = UP ) and MayUP then Exit;
if (I = DOWN ) and MayDOWN then Exit;
if (I = PgUp ) and MayUP then Exit;
if (I = PgDn ) and MayDOWN then Exit;
if (I = Enter) and MayEnter then Exit
end;
if FIS[2] = 0
then SummStr(CKEY,NNN(abs(FITEK))+'.'+NNN(FIS[1]) )
else SummStr(CKEY,NNN(abs(FITEK))+'.'+NNN(FIS[1])+'.'+NNN(FIS[2]));
SaveKeys('',Hroot); { Запомнить значения ключевых п/полей }
WritField; { Подготовка для ESC }
Cmain:=Lask(Hmain,Nmain,COF);
FORMAT_23;
FORMAT_NR(YT);
repeat
LinWRK:=SCR[YT];
CalcTekCTP;
Goto_Scurs(XX+CX,YT);
InputPoints; LineOn(YT);
FORMAT_25;
FORMAT_24;
FORMAT_22; LineOn(22);
if CCB = '' then Hbomb:=NIL else with COT[1] do begin
Hbomb:=H;
Nbomb:=Y;
if Lask(H,Y,UNE) then OnScrXYA(2,21,CMpam, 'a' )
else OnScrXYA(2,21,CMpam,Wodul[1,2])
end;
until CBAPKA(Gey);
StrBar(YT,CPsys,CPppc);
LinWRK:=SCR[YT];
CX:=0;
CBEPTKA(Hmain,Nmain);
LineOn(YT) end;
procedure Edi_Genera(YT : integer);
var Cs,W : boolean;
S,L : integer;
H : pHead;
begin FirstCorr:=true;
with MEAD^.BDS[abs(FITEK)] do begin
Goto_Scurs(CR_TOX+1,YT);
L:=Grupa_VRF(VRF).KP-Grupa_VRF(VRF).KG;
H:=DTL
end;
while H^.BDS[1].DTL <> NIL do H:=H^.BDS[1].DTL;
Em_LinWRK(1,80,CDsys);
OnScrXYA(2,21,CMpam,Wodul[1,2]); { Блокировать a }
LineOn(22);
LineOn(24);
if Modes[Pinf] and (0 < L) then begin
S:=15;
In_LinWRK(S,'Для построения новой группы полей нажмите ',CDsys);
In_LinWRK(S,'Enter',CDkey)
end;
LineOn(23);
Line_25(LaLa);
FORMAT_NR(YT);
repeat
S:=Gey;
W:=RendKeys(S,false,Cs);
if Cs then case S of
Alt_F1 : Help_Uno(H^.BDS[1].HLP); { HELP_FMS }
ENTER : if 0 < L then begin
W:=true;
B_Ha_Gey(999)
end else BadCode;
end;
until W;
StrBar(YT,CPsys,CPppc) end;
end.
|