(* HELP_FMS использует: COMP_FMS *)
(* FILE_FMS *)
(* KEYS_FMS *)
(* MENU_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,655360}
Unit HELP_FMS; INTERFACE
uses DOS, UNIF_FMS, MENU_FMS, KEYS_FMS, OKHO_FMS,
CRT, TYPE_FMS, FILE_FMS, STAK_FMS, COMP_FMS;
TYPE HlpRec = record ST : String[3];
LI : LongInt
end;
HlpArr = array [0..1011] of HlpRec;
procedure Help_Ini;
function Help_Spc( P : String) : String;
function Help_Str(L : LongInt; P : String) : String;
function Help_Opn(L : LongInt; P : String) : LongInt;
procedure Help_Win(L : LongInt; P : String);
procedure Help_BDY(M : LongInt );
procedure Help_Uno(HLP : word);
procedure HelpFunc(Ctxt,Ckey,Cbar : integer; Hmn : ExtStr);
procedure Help_Sex(var R : Resc; C,M : integer; BSP : LongInt;
var B : integer; MenuBody : TypeBody);
procedure Help_See(var R : Resc; C,M : integer; BSP : LongInt);
function Help_Pat( B : Longint; P : String) : LongInt;
procedure Help_Rds(var M : Longint; var S : String);
procedure Help_Par(var HAP : HlpArr);
CONST ChCo:char = '$'; { управление перекраской }
Tpan:String[8] = '[F1]'; { название панели }
IMPLEMENTATION
CONST Type_Hlp : LongInt = -1;
procedure Help_Ini;
var I : integer;
L,M : longint;
begin Type_Hlp:=-1;
I:=NUcomp('TYF');
if 0 < I then
if OpenFile(DIRS[OWN]+'MESSAGES.CMP') then
with UcompTab^ do begin
L:=AR[I].MEDpos-4;
if SeekFile(F_file,L ) then
if ReadFile(F_file,M,4) then Type_Hlp:=L-M;
Cls_File(F_file)
end end;
procedure Help_Rds(var M : Longint; var S : String);
var I,K,N,L : integer;
F : LongInt;
begin L:=0;
if SeekFile(F_file,M) then begin
F:=FileSize(F_File)-M;
if 200 < F then K:=200
else K:=F;
if 0 < K then
if ReadFile(F_file,S[1],K) then begin
S[0]:=chr(K);
N:=Pos(chr($0D)+chr($0A),S);
L:=N-1;
if 0 < N then M:=M+2
else L:=K;
M:=M+L
end;
end;
S[0]:=chr(L) end;
function Help_Pat(B : LongInt; P : String) : LongInt;
var M,L : LongInt;
I : integer;
S : String;
begin M:=0;
L:=B;
repeat
Help_Rds(L,S);
if S <> '' then
if Copy(S,1,3) = P then begin
Delete(S,1,3);
LefPress(S); { UNIF_SFM }
Val(S,M,I);
if I <> 0 then M:=0
else M:=B+M
end;
until (M <> 0) or (S = '');
Help_Pat:=M end;
{ Help_Opn : L = 1|2 = Help типов|функций }
{ P - имя Help-а }
{ Res = <= 0 - Help-файл не открыт }
{ : > 0 - Help-файл открыт; for Help_Rds }
function Help_Opn(L : Longint; P : String) : LongInt;
var Fn : String[80];
begin if L = 1
then begin Fn:='MESSAGES.CMP'; L:=Type_Hlp end
else begin Fn:= 'SFM2.HLP'; L:=0 end;
if 0 <= L then
if OpenFile(DIRS[OWN]+Fn) then begin
L:=Help_Pat(L,P);
if L = 0 then Cls_File(F_file)
end else L:=0;
Help_Opn:=L end;
function Help_Spc(P : String) : String;
var S : String;
L : longInt;
begin L:=Type_Hlp;
S:='';
L:=Help_Pat(L,P);
if L <> 0 then Help_Rds(L,S);
Help_Spc:=S end;
procedure Help_Par(var HAP : HlpArr);
var K : integer;
L : LongInt;
S : String;
procedure Whe;
var I,J : integer;
M : LongInt;
begin for I:=1 to HAP[0].LI do
with HAP[I] do
if LI = 0 then
if Pos(ST,S) = 1 then begin
Delete(S,1,3);
LefPress(S); { UNIF_SFM }
Val(S,M,J);
if J <> 0 then Exit;
K:=K-1;
HAP[I].LI:=Type_Hlp+M;
Exit
end
end;
begin L:=Type_Hlp;
K:=HAP[0].LI;
repeat
Help_Rds(L,S);
if S <> '' then Whe;
until (K = 0) or (S = '') end;
function Help_Str(L : Longint; P : String) : String;
begin L:=Help_Opn(L,P);
if 0 < L then begin
Help_Rds(L,P);
Cls_File(F_file)
end else P:='';
Help_Str:=P end;
{ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; }
{ ;;;;;;;;;;;;;;;;;;;;;;;;; Help View ;;;;;;;;;;;;;;;;;;;;;;;;;;;; }
{ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; }
procedure OnScr_Lx(XH,XK,Y,A : integer; S : String);
var V,I,H : integer;
B,C : char;
begin V:=A;
B:=' ';
for I:=1 to Length(S) do
if XH <= XK then begin
C:=S[I];
if B = ChCo then begin
H:=ValHex(C);
if 0 <= H then V:=(A and $F0) or H
end else
if C <> ChCo then begin
ISC(XH,Y,C,V);
XH:=XH+1
end;
B:=C
end;
for I:=XH to XK do ISC(I,Y,' ',V) end;
var View_SP : LongInt;
procedure BornElem_Vie(O : pMenuRec; H,K : integer);
var I : integer;
L,C : LongInt;
S : String;
begin C:=Get_SP;
with O^ do
for I:=H to K do begin
L:=Base+I;
return_SP(View_SP+(Sufi.YK+3)*L);
POP(S);
with Mafi do
OnScr_Lx(XH,XK,YH+I-1,CoMa,S)
end;
Return_SP(C) end;
{ Help_Sex : var R - }
{ M - длина строки в стеке }
{ BSP - начало записей в стеке }
{ var B - запоминает позицию курсора }
procedure Help_Sex(var R : Resc; C,M : integer; BSP : LongInt;
var B : integer; MenuBody : TypeBody);
var CSP : LongInt;
K : integer;
procedure RescWxx(var R : Resc; C : integer);
begin with R do
if (YK <= 23) and (XK <= 76) then RescWit(R,C)
else RescWin(R,C)
end;
begin K:=(Get_SP-BSP) div (M+3);
if K = 0 then begin
Return_SP(BSP);
Exit
end;
View_SP:=BSP;
PUSH(Glob_Menu,SizeOf(Glob_Menu));
PUSH(SCR,SizeOf(SCR));
CSP:=Get_SP;
RescExt(R,+1,0);
if RescOKK(R) then begin RescWxx(R, C); RescExt(R,-1,0) end
else begin RescExt(R,-1,0); RescWxx(R, C) end;
RescPAM(R,C,Wodul);
OnScrXYA(R.XH+3,R.YH,C,Tpan);
RescExt(R, 0,-1);
with aGlob^ do begin
Curs:=1; { Начальная установка курсора }
CoMa:=C; { Окраска главного поля }
Mafi:=R; RescExt(Mafi,-1,0);
Grad:=R; Grad.XH:=Grad.XK;
if K <= Mafi.YK-Mafi.YH+1 then RescFul(Grad,1,1,0,0);
RescFul(Sufi,1,1,0,0);
Sufi.YK:=M
end;
MenuInit(aGlob,K);
aGlob^.Base:=B;
MenuRun (aGlob,CodeElem_All,
BornElem_Vie,
KillElem_Emp,
BornCurs_Emp,
MenuBody );
B:=aGlob^.Base;
Return_SP(CSP);
POP(SCR);
POP(Glob_Menu);
Return_SP(BSP) end;
procedure ElseBody_Emp(O : pMenuRec);
begin end;
procedure MenuBody_Vie(O : pMenuRec);
begin MenuBody_Vir(O,ElseBody_Emp) end;
{ Help_See : R - прямоугольник на экране }
{ С - окраска прямоугольника }
{ M - длина сроки в стеке }
{ BSP - позиция начала текста в стеке }
procedure Help_See(var R : Resc; C,M : integer; BSP : LongInt);
var V : integer;
begin V:=0;
Help_Sex(R,C,M,BSP,V,MenuBody_Vie) end;
procedure Help_BDY(M : LongInt);
var I,N,C : integer;
BSP : LongInt;
S : String;
R : Resc;
function NotF(var Z : integer) : boolean;
var C : String;
begin if Fin_Str(C,S) then Val_Int(C,Z,N)
else N:=1;
NotF:=(N <> 0);
if N <> 0 then Cls_File(F_file)
end;
begin Help_Rds(M,S); { Skip STRING }
Help_Rds(M,S); { XH YH XK YK COLOR }
S:=S+' ';
Psps(S);
if NotF(R.XH) then Exit;
if NotF(R.YH) then Exit;
if NotF(R.XK) then Exit;
if NotF(R.YK) then Exit;
if Pos(' ',S) <> 3 then S[1]:='U';
C:=ValHex(S[1]);
I:=ValHex(S[2]);
if (not RescOKK(R)) or (C < 0) or (7 < C) or (I < 0) then begin
Cls_File(F_file);
Exit
end;
C:=16*C+I;
I:=0;
BSP:=M;
repeat
Help_Rds(M,S);
if S <> '' then
if I < Length(S) then I:=Length(S);
until S = '';
M:=BSP;
BSP:=Get_SP;
repeat
Help_Rds(M,S);
if S <> '' then PUSH(S,I+1)
until S = '';
Cls_File(F_file);
Help_See(R,C,I,BSP) end;
procedure Help_Win(L : Longint; P : String);
begin L:=Help_Opn(L,P);
if 0 < L then Help_BDY(L) end;
procedure Help_Uno(HLP : word);
var FP,L,BSP : LongInt;
M,C : integer;
S : String;
R : Resc;
A : char;
function Read_New_Str : boolean;
var K : integer;
begin Read_New_Str:=false;
if L <= 0 then Exit;
K:=Length(S)+1;
if 255 < K then Exit;
S[0]:=S[K];
K:=Length(S)+1;
BlockRead(F_File,S[1],K,HLP);
if K <> HLP then Exit;
L:=L-HLP;
Read_New_Str:=true
end;
begin L:=NUcomp(MESSAGE^.ABB);
if HLP <= 0 then Exit;
if L < 0 then Exit;
with UcompTab^.AR[L] do begin
if HLPpos <= 0 then Exit;
FP:=MEDpos+HLP-2
end;
if not OpenFile(DIRS[OWN]+'Messages.cmp') then Exit;
Seek(F_file,FP);
BlockRead(F_file,L,2);
Seek(F_File,FP-L);
BlockRead(F_File,S[1],6,HLP);
L:=L-HLP;
S[0]:=chr(5);
with R do begin
XH:=ord(S[1]);
YH:=ord(S[2]);
XK:=ord(S[3]);
YK:=ord(S[4]);
C:=ord(S[5])
end;
BSP:=L;
FP:=FilePos(F_file);
A:=S[6];
M:=0;
while Read_New_Str do
if M < Length(S) then M:=Length(S);
L:=BSP;
BSP:=get_SP;
Seek(F_file,FP);
S[0]:=chr(5);
S[6]:=A;
while Read_New_Str do PUSH(S,M+1);
Cls_File(F_file);
CuSh(false);
Help_See(R,C,M,BSP);
CuSh(true) end;
type HlpArs = array [1..25] of integer;
HlpPan = array [0..25] of String[52]; { 40+9+3 }
function Help_MF1(Mn : ExtStr; var PP : HlpPan; var KK : HlpArs) : integer;
var I,K,N : integer;
C,S : String;
L : LongInt;
begin N:=0;
L:=Help_Opn(2,Mn);
if 0 < L then begin
repeat
Help_Rds(L,S);
N:=N+1;
if N < 3 then S:='*' { N=1|2 - Skip String HELP }
else if N = 3 then PP[0]:=S
else if S <> '' then begin
LefPress(S);
S:=S+' ';
C:=NumbStr(1,S);
Val_Int(C,K,I);
if I = 0 then KK[N-3]:=K
else KK[N-3]:=0;
Delete(S,1,Length(C)+1);
PP[N-3]:=LappStr(S,52)
end;
until (S = '') or (25 <= N);
Cls_File(F_file);
end;
Help_MF1:=N-4 end;
{ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; }
{ ;;;;;;;;;;; HelpFunc - универсальный монитор Help ;;;;;;;;;;;;;;; }
{ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; }
procedure HelpFunc(Ctxt,Ckey,Cbar : integer; Hmn : ExtStr);
var H,K,I,J,N,Ko : integer;
PP : HlpPan;
KK : HlpArs;
R : Resc;
procedure OE(Nu,Colr : integer);
begin N:=abs(Nu);
OnScrXYA(15,H+N,Colr,' '+Copy(PP[N], 1,39));
if Nu < 0 then
OnScrXYA(56,H+N,Ckey, Copy(PP[N],41, 9))
end;
procedure In_HlpArr;
var I : integer;
begin for I:=1 to Ko do
if KK[I] = K then begin
B_Ha_Gey(K);
K:=ENTER;
Exit
end
end;
begin Ko:=Help_MF1(Hmn,PP,KK);
if Ko < 2 then Exit;
H:=(25 - Ko) div 2 - 2;
K:=H+Ko+4;
PUSH(SCR[H-1],(K-H+4)*SizeOf(LinSCR));
RescFul(R,10,H-1,69,K+1); RescWit(R,Ctxt);
RescFul(R,14,H ,65,K ); RescPAM(R,Ctxt,Wodul);
COEXXY(14,65 ,K-2);
COEXYY(55,H ,K-2);
COEXYY(40,K-2,K );
OnScrCYA(H,Ctxt,' System of Financial Messages ');
OnScrXYA(16,K-1,Ckey,'Enter');
OnScrXYA(22,K-1,Ctxt,'Выполнить команду');
OnScrXYA(46,K-1,Ckey,'F1');
OnScrXYA(49,K-1,Ctxt,'Подсказка');
H:=H+1;
OnScrCYA(H,Ckey,PP[0]);
OE(-1,Cbar);
for I:=2 to Ko do OE(-I,Ctxt);
I:=0;
repeat
J:=I;
K:=Gey;
case K of
F1 : Help_Win(2,Copy(PP[I+1],50,3));
ENTER : B_Ha_Gey(KK[I+1]);
UP : I:=(I+Ko-1) mod Ko;
DOWN : I:=(I +1) mod Ko;
HOME : I:=0;
ENDD : I:=Ko-1;
else In_HlpArr;
end;
if J <> I then begin
OE(J+1,Ctxt);
OE(I+1,Cbar);
end;
until (K = ESC) or (K = ENTER);
POP(SCR[H-2]) end;
end.
|