(* LAYS_FMS использует: DEBI_FMS *)
(* FILE_FMS *)
(* HELP_FMS *)
(* KEYS_FMS *)
(* OKHO_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 LAYS_FMS; INTERFACE
Uses DOS, STAK_FMS, TYPE_FMS, FILE_FMS, HELP_FMS,
CRT, DEBI_FMS, OKHO_FMS, KEYS_FMS, UNIF_FMS;
procedure LinkField;
function SiConfig_RP(var S : String) : boolean;
procedure PinPar(var H,T : String; B : String);
function FinPar(var H,T : String; B : String) : boolean;
function Str_Menu( var C : String) : boolean;
function ParaMenu(H : pHead; N : integer; var S : String) : boolean;
function Open_DBF_Menu(H : pHead; N : integer; var S : String) : integer;
function Ctrl_EXT_Menu(H : pHead; N : integer; var S : String) : boolean;
VAR WorkString : String;
Ctrl_S_Menu : boolean; { Признак предв.сортировки меню }
IMPLEMENTATION
{ SiConfig_RP : Поиск в Config_RP значения (Right Part) }
{ параметра S }
function SiConfig_RP(var S : String) : boolean;
var G,C : String;
T : LongInt;
begin T:=get_SP;
return_SP(SP_config);
G:=S+chr(0);
repeat
POP(C);
until (C = '') or (Pos(G,C) = 1);
return_SP(T);
SiConfig_RP:=true;
if C = '' then SiConfig_RP:=false
else S:=NumbStr(2,C) end;
{ FinPar , }
{ PinPar : T -> H + B + LefPress(T) }
{ FinPar = true, если разделитель B не существует }
procedure PinPar(var H,T : String; B : String);
var K : integer;
begin K:=Pos(B,T)-1;
if K < 0 then Exit;
H:=Copy(T,1,K);
Delete(T,1,K+Length(B));
LefPress(T) end;
function FinPar(var H,T : String; B : String) : boolean;
begin FinPar:=false;
if Pos(B,T) <> 0 then PinPar(H,T,B)
else FinPar:=true end;
{ Str_Menu : Обработка строки С = описание мен0 }
{ Res = TRUE, если имеем CTRL+S }
{ C:=ППгиперстрока }
function Str_Menu(var C : String) : boolean;
var S,G : String;
begin C:=C+' ';
Psps(C);
if Pos('[] ',C) = 1 then Delete(C,1,3); { [Удалить] '[]' }
S:=NumbStr(1,C);
UpCaseStr(S);
Str_Menu:=true; { [Удалить] 'CTRL+S' }
if S = 'CTRL+S' then Delete(C,1,7)
else Str_Menu:=false;
S:='';
while Fin_Str(G,C) do
if G <> 'z' then SummStr(S,G);
C:=S end;
{ H,N - элемент-меню; }
{ }
{ Результат: ParaMenu = True - параметр найден в Config.sfm }
{ + S - остаток строки без [] }
{ + Ctrl_S_Nenu - признак предв.сортировки }
{ False - параметр не найден }
function ParaMenu(H : pHead; N : integer; var S : String) : boolean;
begin ParaMenu:=false;
Ctrl_S_Menu:=false;
with H^.BDS[N] do if MN_MEM <> NIL then
with MN_MEM^ do if LON <> '' then begin
S:=LON;
if SiConfig_RP(S) then begin
Ctrl_S_Menu:=Str_Menu(S);
ParaMenu:=(S <> '');
end
end end;
{ H,N - элемент-меню; }
{ }
{ Результат: Open_DBF_Menu = 0 - загрузка не состоялась }
{ Open_DBF_Menu <> 0 - загрузка состоялась и при этом: }
{ - Open_DBF_Menu - номер поля с элементами меню }
{ - S - остаток строки конфигурационного файла }
function Open_DBF_Menu(H : pHead; N : integer; var S : String) : integer;
var G : String;
begin Open_DBF_Menu:=0;
if ParaMenu(H,N,S) then
if Fin_Str(G,S) then
if S <> '' then begin
OpnDeb(G,true);
if DeBi.Errors = 0 then
if Fin_Str(G,S) then begin
N:=NmbFld(G);
if 0 < N then begin
Open_DBF_Menu:=N;
Exit
end
end;
ClsDeB
end end;
{ ExportFromDBF : выполняет все операции по экспорту }
{ значений полей из DBF-файла }
{ используется в Ctrl_DBF_Menu }
procedure ExportFromDBF(H : pHead; N : integer);
var V,S : String;
I,J,D : integer;
begin with H^.BDS[N] do
if VRF = NIL then V:=''
else V:=VRF^;
UpCaseStr(V);
I:=POS('EXP(',V);
while 0 < I do begin
Delete(V,1,I+3);
if Pos(')FRC(',V) = 2 then begin
D:=ValHex(V[1]);
Delete(V,1,6);
I:=Pos(')',V);
if (0 < I) and (0 <= D) then begin
S:=Copy(V,1,I-1);
Delete(V,1,I);
if SiConfig_RP(S) then begin
J:=NmbFld(S); { S - имя DBF-поля }
if 0 < J then begin
RdsFld(J,S);
LefPress(S);
LimitStr(S,8);
with MESSAGE^.DSK[D] do begin
CTP:=S;
BKP[10]:='N'
end
end
end
end
end;
I:=POS('EXP(',V)
end end;
{ H,N - элемент-меню; S - название элемента }
{ }
{ Результат: Ctrl_DBF_Menu = true элемент найден }
{ Ctrl_DBF_Menu = false элемент не найден }
function Ctrl_DBF_Menu(H : pHead; N : integer; var S : String) : boolean;
var NMF : integer; { Номер поля с элементами меню }
C : String;
begin Ctrl_DBF_Menu:=false;
NMF:=Open_DBF_Menu(H,N,C);
if NMF = 0 then begin { DBF-файла не нашлось }
Terr_Gey(H,N,'Нет доступа к БД. Настроить Config.sfm и повт.ввод.');
Exit
end;
if 0 < FndRec(1,S,NMF) then begin
ExportFromDBF(H,N);
Ctrl_DBF_Menu:=true
end;
ClsDeB end;
function Ctrl_TXT_Menu(P : String; var S : String) : boolean;
begin if SiConfig_RP(P) then begin
if Str_Menu(P) then; { Kill: [], CTRL+S }
Ctrl_TXT_Menu:=FindFile(NumbStr(1,P)+S)
end else Ctrl_TXT_Menu:=false end;
{ ПРОВЕРКА ВНЕШНЕГО МЕНЮ }
{ H,N - элемент-меню; S - название элемента }
{ Результат: Ctrl_EXT_Menu = true элемент найден }
{ Ctrl_EXT_Menu = false элемент не найден }
function Ctrl_EXT_Menu(H : pHead; N : integer; var S : String) : boolean;
begin Ctrl_EXT_Menu:=false;
with H^.BDS[N] do if MN_MEM <> NIL then
with MN_MEM^ do if LON <> '' then begin
if Pos('.TXT',LON) <> 0
then Ctrl_EXT_Menu:=Ctrl_TXT_Menu(LON,S)
else Ctrl_EXT_Menu:=Ctrl_DBF_Menu(H,N,S)
end end;
{ LinkField - настоить заданное поле при его первом чтении }
procedure LinkOneStr_DBF(H : pHead);
var I : integer;
procedure LoopMN(MN : pMenu);
var J : integer;
begin for J:=1 to MN^.HSF do
with MN^.ELT[J] do
if DTL <> NIL then LinkOneStr_DBF(DTL)
end;
begin for I:=1 to H^.HSF do
with H^.BDS[I] do begin
if MN_MEM <> NIL then begin
WorkString:=MN_MEM^.LON;
if WorkString = ''
then LoopMN(MN_MEM)
else if SiConfig_RP(WorkString)
then Sset(BOS,MN_GES,(POS('[]',WorkString) = 0))
else Sset(BOS,MN_GES,false)
end;
if Only_DTL(H,I) then LinkOneStr_DBF(DTL)
end end;
procedure LinkOneStr(H : pHead);
begin { -1- DBF-меню } LinkOneStr_DBF(H); { = -2- TXT-меню }
end;
procedure LinkField; { Настройка поля при первом чтении }
var I,J : integer;
H : pHead;
begin H:=MEAD^.BDS[abs(FITEK)].DTL;
if H = NIL then Exit;
for I:=1 to H^.HSF do
with H^.BDS[I] do
if DTL^.KND = 8
then LinkOneStr(DTL)
else for J:=1 to DTL^.HSF do
LinkOneStr(DTL^.BDS[J].DTL) end;
end.
|