Unit Types_11;
Interface
Const DelayPose:integer=50;
Procedure Change_Inser_Mode;
Procedure Initialiser;
Procedure Affiche_Menu;
Function Suprime_les_Tab:boolean;
Procedure Load_Fichier_Disque(Reper,Neime:string);
Procedure Save_Fichier_Disque(D_isque,NeimeFic:string);
Procedure Efface_Block;
Procedure Defini_Bloc;
Procedure Init_Page;
Procedure Positione_Curseur(X1:byte);
Procedure Fin__Ligne_X;
Procedure Debut__Ligne_X;
Procedure Avance_Page_X_de_1;
Procedure Recule_Page_X_de_1;
Procedure Curseur__FinLigne;
Procedure Premiere_page_Debut(Pose:Word);
Procedure Change_Une_Page_Bas(Pose:Word;FindLines:Word);
Procedure Change_Une_Page_Haut(Code:Char);
Procedure Lecture_Une_Ligne_Bas(Pose:Word;code:Char);
Procedure Lecture_Une_Ligne_Haut(Pose:Word);
Procedure Curseur_Droite;
Procedure Curseur_Gauche;
Procedure Debut_ligne_Gauche;
Procedure Curseur___bas;
Procedure Curseur_Haut;
Procedure Avance_Une_Page;
Procedure Recule_Une_Page;
Procedure Fin_du_Fichier;
Procedure Debut_Du_Fichier;
Procedure Save_Ligne_Curseur(Poss:Word);
Procedure Load_Ligne_Curseur(Poss:Word);
Procedure Del_Gauche;
Procedure Del_Droite;
Procedure Del_FinLigne;
Procedure Tab_Deplace;
Procedure Inserer_Ligne;
Procedure Inser_Char(Car:Char);
Procedure Del_Line;
Procedure Avance_Page;
Procedure Recule_Page;
Procedure mot_suivan(pos:Word);
Procedure mot_Avan(pos:Word);
Procedure Donne_Position_XY(var x,y:Word;Pose:Word;mode:Char);
Procedure Control_Longueur_DE_Lignes(Poss,Pose2:Word);
Function Erreur_file_Toolarge(Nom:string;Sizee:Longint;Code:Char ):boolean;
Function Erreur_limite_Buf(code:char):boolean;
Function FileExists(F,N : string) : boolean;
Function _Fichiers_Dir(Var Directori:string; Texte_Load:string):string;
Procedure Change_Directori(RR:string);
Procedure Write_Block_Fic;
Procedure CtrL_K;
Function Verify_Reper(Var Reper,S:string):boolean;
Function Verify_Rep_Fic(Var Reper,Neime:string):boolean;
Procedure Block_Load_Fic;
Procedure CopyBlock__B(Debut_Pos,decale:Word);
Procedure CopyCopyBlock(decale:Word);
Procedure Coup_block;
Procedure LireTexte(Reper,Neime:string);
Function Selecte_Attr(Attribut:Word):Word;
Procedure Change_Attribut;
Procedure Marque_Ecran_Copy;
Procedure Cherche_Marque(pos:Word);
Procedure Change_Block(Signe:Char;Poss:Word;Deplace:integer);
Procedure Shift_Bloc(xxw:Word);
Procedure Cherche_position_de_XY(PosePose:Word);
Procedure Dir_Nom_Help;
Procedure Change_Repertoire_Langage(Fond__Box:byte);
Var KBx : byte;
KBy : byte;
Tab_Size : byte;
Implementation
Uses crt,Dos,Box13,Var_1,U_Pick,Type_Buf,Buffs,Buff_Tex,C_Read,CrtKey,Get_Key;
Function FileExists(F,N : string) : boolean;
var
SR : SearchRec;
begin
N:=Uppers(N);
FindFirst(F+N, AnyFile, SR);
FileExists := (DosError = 0) and (SR.Name=N) and (SR.attr and 32 = 32);
end;
Function Erreur_limite_Buf(code:char):boolean;
Var hkey : byte;
Sx : string[5];
begin
FillChar(LinePtr^,SizeOf(LinePtr^),#0);
ReadBuf(2,3,Max_curseurX,3,LinePtr^);
textAttr:=78;
if (Fin_Buffer<(Max_Buffer-512)) Then
begin
Putxy(2,3,' WARNING: ');
Str(((Max_Buffer-512)-Fin_Buffer):5,Sx);
Putxy(12,3,Sx+' byte(s) left ');
if Code = ' ' Then
begin
ClearBufKey;
csoff;
Repeat
Hkey:=Keyboard;
Until Hkey=27;
end
else Delay(2000);
NotOutEspace:=True;
ClearBufKey;
ERREUR_LIMITE_BUF:=False;
end
else
begin
Putxy(2,3,'ERROR: Out of Space. Press <ESC> ');
ClearBufKey;
csoff;
Repeat
Hkey:=Keyboard;
Until Hkey=27;
NotOutEspace:=False;
ClearBufKey;
ERREUR_LIMITE_BUF:=True;
end;
TextAttr:=Edit_Color;
WriteBuf(2,3,Max_curseurX,3,LinePtr^);
end;
Procedure Positione_Curseur(X1:byte);
Var deplace,i:Word;
begin
if X1 in[1..Max_Colones-1] Then
begin
i:=X_curseur-E_curseurX;
if X1 in [1+i..(Max_CurseurX-1+i)] Then
begin
X_curseur:=X1;
E_curseurX:=X1-i;
end
else
if X1>((Max_curseurX-1)+i) Then
begin
deplace:=X1-(Max_CurseurX-1);
ScrollText(Left,2,4,Max_CurseurX,CrtGetMaxY-1, deplace-i, TextAttr );
For i:=4 To CrtGetmaxY-1 Do
MoveToScreen(ScreenPage^[i,Max_CurseurX],ScreenPtr^[i,Max_CurseurX-deplace+1],deplace*2);
Delay(DelayPose);
X_curseur:=X1;
E_curseurX:=Max_curseurX-1;
end
else
if X1 in[1..(Max_CurseurX-1)] Then
begin
Debut__Ligne_X;
E_curseurX:=X1;
X_curseur:=X1;
end;
end;
end;
Procedure Change_Block(Signe:Char;Poss:Word;Deplace:integer);
begin
if Signe='+' Then
begin
inc(FinBlock,Deplace);
inc(Max_Block,Deplace);
if Buffer^[FinBlock]=#13 Then
begin
inc(FinBlock,2);
inc(Max_Block,2);
end
else
if Buffer^[FinBlock]=#10 Then
begin
inc(FinBlock);
inc(Max_Block);
end
end
else
if Signe='-' Then
begin
dec(FinBlock,Deplace);
dec(Max_Block,Deplace);
if Buffer^[FinBlock]=#10 Then
begin
dec(FinBlock,2);
dec(Max_Block,2);
end
else
if Buffer^[FinBlock]=#13 Then
begin
dec(FinBlock);
dec(Max_Block);
end;
end
else
if Signe=' ' Then
begin
if Poss<DebutBlock Then
begin
inc(DebutBlock,deplace);
inc(FinBlock,deplace);
end
else
if (Poss>DebutBlock) and (Poss<FinBlock) Then
begin
inc(FinBlock,deplace);
inc(Max_Block,deplace);
end;
end;
end;
Procedure Save_Ligne_Curseur(Poss:Word);
Var Longg, Deplace : byte;
i : Word;
begin
Deplace:=0;
Longg:=Pos(#26,CopyLigne^)-1;
if Longg>LongLigne Then
begin
Deplace:=Longg-LongLigne;
Move(Buffer^[Poss],Buffer^[Poss+deplace],(Fin_Buffer-Poss+1));
Delay(DelayPose);
inc(Fin_Buffer,Deplace);
inc(Fin_Page,Deplace);
Fin_Ligne[Y_Curseur].ecran:=Longg+1;
For i:=Y_Curseur TO Max_curseurY DO inc(Fin_Ligne[i].buf,Deplace);
if (Max_Block>0) and (FinBlock > DebutBlock) Then
begin
if Poss<DebutBlock Then
begin
inc(DebutBlock,deplace);
inc(FinBlock,deplace);
end
else
if (Poss>DebutBlock) and (Poss<FinBlock) Then
begin
inc(FinBlock,deplace);
inc(Max_Block,deplace);
end;
end;
end
else
if Longg<LongLigne Then
begin
deplace:=LongLigne-Longg;
Move(Buffer^[Poss+Deplace],Buffer^[Poss],(Fin_Buffer-Poss+1));
Delay(DelayPose);
dec(Fin_Buffer,Deplace);
dec(Fin_Page,Deplace);
Fin_Ligne[Y_Curseur].ecran:=Longg+1;
For i:=Y_Curseur TO Max_curseurY DO
dec(Fin_Ligne[i].buf,Deplace);
if (Max_Block>0) and (FinBlock > DebutBlock) Then
begin
if Poss<DebutBlock Then
begin
dec(DebutBlock,deplace);
dec(FinBlock,deplace);
end
else
if (Poss>DebutBlock) and (Poss<FinBlock) Then
begin
dec(FinBlock,deplace);
dec(Max_Block,deplace);
end;
end;
end;
if Longg>0 Then
begin
Move(CopyLigne^[1],Buffer^[Poss],Longg);
Delay(DelayPose);
end;
Modif_Ligne:=False;
Change_de_ligne:=True;
Buffer^[Fin_Buffer]:=#26;
if (Fin_Buffer>=(Max_Buffer-50)) Then
if Fin_Buffer>=(Max_Buffer-50) Then
begin
if Erreur_limite_Buf('F') Then
begin
end;
end
else NotOutEspace:=True;
end;
Procedure Load_Ligne_Curseur(Poss:Word);
var n : Word;
begin
if (Poss>=1) and (Poss<=Fin_Buffer) then
begin
pos_Ligne:=Poss;
FillChar(CopyLigne^,SizeoF(CopyLigne^),#32);
Move(Buffer^[Poss],CopyLigne^[1],Max_Colones);
Delay(DelayPose);
N:=Pos(#13,CopyLigne^);
if N=0 Then
begin
N:=Pos(#26,CopyLigne^);
end;
CopyLigne^[N]:=#26;
LongLigne:=N-1;
end_Ligne:=N;
if Fin_Buffer>(Max_Buffer-50) Then
begin
if Erreur_limite_Buf('F') Then
begin
end;
end;
end
else NotOutEspace:=True;
end;
Procedure Marque_Ecran_Copy;
var CurX, CurY : byte;
X1,Y1,X2,Y2 : byte;
begin
X1:=Lo(WindMin)+1;
Y1:=Hi(WindMin)+1;
X2:=Lo(WindMax)+1;
Y2:=FinY+3;
CurX:=E_curseurX;
CurY:=Y_Curseur;
Marque_Box(X1,Y1,X2,Y2,TextAttr);
if (X1>0) and (Y1>0) and (Y2>=Y1) and (X2>X1) Then
begin
Max_Block:=0;
ReadBufCopy(Max_Block,X1,Y1,X2,Y2);
Beep;
end;
Gotoxy(CurX,CurY);
end;
Procedure Change_Inser_Mode;
begin
if Mem[0:$417] and 128 = 128 Then
begin
Mem[0:$417] := Mem[0:$417]-128;
Inser_Mode:=False;
end
else
begin
Mem[0:$417]:=Mem[0:$417]+128;
Inser_Mode:=True;
end;
end;
Procedure Initialiser;
var i : word;
Color : byte;
begin
if (Not _Save_Fichier) Then
begin
X_Pick:=X_Curseur;
Y_Pick:=Y_Curseur;
Page_Pick:=Debut_Page;
Line_Pick:=Line_Curseur;
Marque_Pick:=Pose_Marque;
end;
for i:=1 To 50 DO
begin
Fin_Ligne[i].Buf:=0;
Fin_Ligne[i].Ecran:=1;
end;
Fin_Ligne[1].Buf:=1;
Fin_Ligne[1].Ecran:=1;
X_curseur :=1;
E_CurseurX:=1;
Y_curseur :=1;
finY :=1;
Line_Curseur:=1;
Debut_Page:=1;
Fin_Page :=1;
Fin_Buffer:=1;
ConteLines:=0;
DebutBlock :=0;
FinBlock :=0;
Max_Block :=0;
Marque_Bloc:=False;
NotOutEspace:=True;
For i:=1 TO Max_Buffer+200 DO Buffer^[i]:=' ';
Buffer^[1]:=^Z;
FillChar(CopyLigne^,SizeoF(CopyLigne^),#32);
CopyLigne^[1]:=^Z;
LongLigne:=0;
Pos_Ligne:=0;
Pos_Ligne:=0;
Modif_Ligne:=False;
Change_de_Ligne:=True;
_Save_Fichier:=False;
if Mem[0:$417] and 128 = 0 Then
begin
Change_Inser_Mode;
end;
Color:=TextAttr;
textAttr:=Etat_Color;
Putxy(10,3,' ');
Putxy(21,3,' ');
Putxy(58,3,' ');
TextAttr:=Color;
TextAttr:=Edit_Color;
Init_Page;
end;
Procedure Affiche_Menu;
begin
TextAttr:=Edit_Color;
Window(1,1,80,CrtGetMaxY);
Clrscr;
textAttr:=Menu_Color;
Writechar(1,1,80,' ');
Putxy(5,1,'File Edit Options Lang Graphe Trace Maths');
WriteCar(5,1,'F');
WriteCar(13,1,'E');
WriteCar(21,1,'O');
WriteCar(32,1,'L');
WriteCar(40,1,'G');
WriteCar(56,1,'M');
TextAttr:=Edit_Color;
Rectangle(1,2,80,CrtGetMaxY,Simple);
Putxy(36,2,' Edit ');
textAttr:=Etat_Color;
Putxy(6,3,'Line');
Putxy(18,3,'Col');
Putxy(28,3,'Insert');
Putxy(35,3,'Indent');
Putxy(49,3,'Unindent');
Putxy(58,3,NomFic);
TextAttr:=Menu_color;
Posxy(1,26);
end;
Procedure Efface_Block;
var i,n:byte;
begin
BoxColor(2,4,Max_curseurX+1,Max_CurseurY+3,TextAttr);
For i:=4 To Max_curseurY+3 DO
For n:=1 to Max_Colones-1 DO
ScreenPage^[i,n].attrib:=TextAttr;
Marque_Bloc:=False;
end;
Procedure Donne_Position_XY(Var x,y:Word;Pose:Word;mode:Char);
var i : Word;
Trouve : boolean;
begin
X:=0;
Y:=0;
if (Pose>=Debut_Page) and (Pose<=Fin_Ligne[FinY].buf) Then
begin
i:=1;Trouve:=False;
While (i<=FinY) and (not Trouve) DO
begin
if Fin_Ligne[i].buf+1>=Pose Then Trouve:=True
else inc(i);
end;
if Trouve Then
begin
Y:=i;
Trouve:=False;
i:=(Fin_Ligne[Y].Buf-Fin_Ligne[Y].ecran)+1;
While (i<=Fin_Ligne[y].Buf+1) and (not Trouve) DO
begin
inc(x);
if i=Pose Then Trouve:=True
else inc(i);
end;
end;
end
else
if (mode='D') and (Pose<Debut_Page) Then
begin
X:=1;Y:=1;
end
else
if (mode='F') and (Pose+1>=Fin_Page) Then
begin
X:=Max_Colones-1;Y:=Max_curseurY;
end
end;
Procedure Defini_Bloc;
var y1,X1 : word;
Y2,X2 : word;
y,x,i : word;
begin
Donne_Position_XY(x1,y1,debutblock,'D');
Donne_Position_XY(x2,y2,Finblock,'F');
if (Y1>0) and (X1>0) and (Y2>0) and (X2>0) Then
begin
I:=X_curseur-E_curseurX;
inc(X2);
if Y2>Y1 Then
begin
For x:=X1 To Max_Colones-1 DO ScreenPage^[Y1+3,x].attrib:=Marque_Color;
For Y:=Y1+4 To Y2+3 DO
begin
For x:=1 To Max_Colones-1 DO ScreenPage^[Y,x].attrib:=Marque_Color;
end;
if Fin_ligne[Y2].Buf>=FinBlock Then
For x:=X2 TO Max_colones-1 DO ScreenPage^[Y2+3,x].attrib:=TextAttr;
end
else
For x:=X1 To X2-1 DO ScreenPage^[Y1+3,x].attrib:=Marque_Color;
Y2:=(Y1+3)+((Y2+3)-(Y1+3));
For Y:=Y1+3 TO Y2 DO
For X:=1 To Max_CurseurX Do
ScreenPtr^[y,x+1].attrib:=ScreenPage^[Y,x+i].attrib;
Marque_Bloc:=True;
end;
end;
Function Erreur_file_Toolarge(Nom:string;Sizee:Longint;Code:Char ):boolean;
var Sn1,Sn2 : string;
Color : byte;
Ch : Char;
begin
Color:=TextAttr;
textAttr:=Error_Color;
FillChar(LinePtr^,SizeOF(LinePtr^),#32);
ReadBuf(1,3,Max_curseurX,3,LinePtr^);
if Code='F' Then
begin
Str(Sizee,Sn1);
Str((Max_Buffer-256),Sn2);
Putxy(2,3,Nom+' Size: '+Sn1+' Too large Truncate > '+Sn2+' (Y / N) ?');
Repeat
Ch:=Readkey;
Until (Upcase(ch) in['Y','N']) OR (Ord(ch)=27);
if Upcase(ch)='Y' Then Erreur_File_TooLarge:=false
else Erreur_File_TooLarge:=True;
end
else
begin
Putxy(2,3,'Line too long CR inserted. Press <ESC> ');
Repeat
Ch:=readkey;
Until (Ord(ch)=27);
Erreur_File_TooLarge:=False;
end;
WriteBuf(1,3,Max_curseurX,3,LinePtr^);
textAttr:=Color;
end;
Procedure Load_Fichier_Disque(Reper,Neime:string);
Label Repeter1, __Fin;
var a,Ch : Char;
Size : LongInt;
F1 : File;
fff : Text;
Erreur : integer;
Entree : boolean;
Attr : word;
Max1,MAx2 : string[6];
iiii : word;
begin
Erreur:=0;
Size:= FileMaxSize(Reper+Neime);
if (Size>(Max_Buffer-512)) OR (Size=-1) Then
begin
Erreur:=0;
if Size=-1 Then Erreur:=255
else
if Erreur_File_Toolarge(Neime,Size,'F') Then Erreur:=255;
if Erreur=255 Then
begin
NomFic:='NONAME.???';
Disque_Nom:=Repertoire;
Disque_2:=Disque_Nom[1]+Disque_Nom[2];
Initialiser;
goto __Fin;
end;
end;
Entree:=False;
Attr:=0;
Entree:=True;
Fin_Buffer:=0;
Repeter1:
Assign(F1,Reper+Neime);
Reset(F1);
Erreur:=Ioresult;
if Erreur=0 Then
begin
Close(F1);
end;
if (Erreur=150) then goto __Fin;
if (Erreur=5) Then
begin
Disque_2:=Disque_Nom[1]+Disque_Nom[2];
GetFattr(F1,Attr);
if DosError=0 Then
begin
SetFattr(F1,$20);
if DosError =0 Then Goto Repeter1
else Entree:=Erreur_Critique(DosError,Disque_2);
end
else
Entree:=Erreur_Critique(DosError,Disque_2);
end;
if Erreur=0 Then
begin
Assign(fff,Reper+Neime);
Reset(fff);
Erreur:=Ioresult;
if Erreur = 0 Then
begin
FillChar(Buffer^, Max_Buffer-1, ' ');
Fin_Buffer:=0;
Disque_2:=Reper[1]+Reper[2];
iiii:=0;
while (Not Eof(fff)) and (iiii<=(Max_Buffer-512)) Do
begin
inc(iiii);
Read(fff,Ch);
Buffer^[iiii]:=Ch;
end;
close(fff);
Fin_Buffer:=iiii;
if Erreur = 0 Then Entree:=True
else Entree:=False;
if Erreur<>0 Then
begin
FillChar(Buffer^, Max_Buffer-1, ' ');
Disque_2:=Disque_Nom[1]+Disque_Nom[2];
Entree:=Erreur_Critique(Erreur,Disque_2);
Initialiser;
NomFic:='NONAME.???';
end;
end;
if Entree Then
begin
if Fin_Buffer>1 Then inc(Fin_Buffer);
Buffer^[Fin_Buffer]:=^Z;
if Buffer^[1]<>#26 Then Control_Longueur_DE_Lignes(1,Fin_Buffer);
end;
end
else
begin
__Fin:
Entree:=Erreur_Critique(Erreur,Neime);
Initialiser;
NomFic:='NONAME.???';
Disque_Nom:=Repertoire;
if Disque_Nom<>'' then
Disque_2:=Disque_Nom[1]+Disque_Nom[2]
else
Disque_2:='';
end;
if Attr>0 Then
begin
Assign(F1,Reper+Neime);
SetFattr(F1,Attr);
Erreur:=DosError;
end;
end;
Procedure Fin__Ligne_X;
var deplace,i : byte;
begin
if Fin_ligne[y_curseur].ecran>X_curseur Then
begin
i:=X_curseur-E_curseurX;
deplace:=Fin_Ligne[y_curseur].ecran-(Max_CurseurX-1);
ScrollText(Left,2,4,Max_CurseurX,CrtGetMaxY-1, deplace-i, TextAttr );
For i:=4 To CrtGetmaxY-1 Do
MoveToScreen(ScreenPage^[i,Max_CurseurX],ScreenPtr^[i,Max_CurseurX-deplace+1],deplace*2);
Delay(DelayPose);
end;
end;
Procedure Debut__Ligne_X;
var deplace,i : byte;
begin
deplace:=X_curseur-E_curseurX;
ScrollText(Right,2,4,Max_CurseurX,CrtGetMaxY-1, deplace, TextAttr );
For i:=4 To CrtGetmaxY-1 Do
MoveFromScreen(ScreenPage^[i,1],ScreenPtr^[i,2],deplace*2);
Delay(DelayPose);
end;
Procedure Avance_Page_X_de_1;
var u,i:byte;
begin
if X_curseur<=Max_Colones Then
begin
ScrollText(Left,2,4,Max_CurseurX,CrtGetMaxY-1, 1, TextAttr );
For i:=4 To CrtGetmaxY-1 Do
MoveToScreen(ScreenPage^[i,X_curseur],ScreenPtr^[i,Max_CurseurX],2);
Delay(DelayPose);
end;
end;
Procedure Recule_Page_X_de_1;
var i : byte;
begin
ScrollText(Right,2,4,Max_CurseurX,CrtGetMaxY-1, 1, TextAttr );
For i:=4 To CrtGetMaxY-1 Do
MoveToScreen(ScreenPage^[i,X_curseur],ScreenPtr^[i,2],2);
Delay(DelayPose);
end;
Procedure Curseur__FinLigne;
var Decalage,X : byte;
begin
if (X_curseur=E_curseurX) Then
begin
if (Fin_Ligne[Y_curseur].Ecran<=Max_CurseurX-1) Then
begin
X_curseur:=Fin_Ligne[Y_curseur].Ecran;
E_curseurX:=X_curseur;
end
else
if (Fin_Ligne[Y_curseur].Ecran>Max_CurseurX-1) Then
begin
Fin__Ligne_X;
E_curseurX:=Max_CurseurX-1;
X_curseur:=Fin_Ligne[Y_curseur].Ecran;
end;
end
else
begin
if X_Curseur>Fin_Ligne[y_Curseur].ecran Then
begin
if (Fin_ligne[Y_curseur].ecran<=Max_CurseurX-1) Then
begin
Debut__Ligne_X;
E_curseurX:=Fin_ligne[Y_curseur].ecran;
end
else E_curseurX:=E_curseurX-(X_curseur-Fin_ligne[Y_curseur].ecran);
end
else
if (E_curseurX+(Fin_ligne[Y_curseur].ecran-X_curseur)) <= Max_CurseurX-1 Then
E_curseurX:=E_curseurX+(Fin_ligne[Y_curseur].ecran-X_curseur)
else
begin
Fin__Ligne_X;
E_curseurX:=Max_CurseurX-1;
end;
X_curseur:=Fin_Ligne[Y_curseur].ecran;
end;
end;
Procedure Init_Page;
var Reg : ScreenChar;
i : byte;
begin
Reg.Data:=#32;
Reg.Attrib:=TextAttr;
For i:=1 TO Max_Colones DO
ScreenPage^[1,i]:=Reg;
For i:=2 TO 50 DO
ScreenPage^[i]:=ScreenPage^[1];
ClearScreen(2,4, Max_curseurX+1, CrtGetMaxY-1,Edit_Color);
end;
Procedure Premiere_page_Debut(Pose:Word);
var xx,i,n,n13,Ligne : word;
S1 : Array[1..Max_Colones] Of Char;
begin
if Buffer^[1]<>^Z Then
begin
For i:=1 To Max_CurseurY Do
begin
Fin_Ligne[i].Buf:=0;
Fin_Ligne[i].ecran:=1;
end;
Init_Page;
XX:=(X_curseur-E_curseurX);
Ligne:=0;
while (Pose<Fin_Buffer) and (Ligne<Max_curseurY) Do
begin
N:=0;
FillChar(S1,Sizeof(S1),' ');
Move(Buffer^[pose],S1,SizeOf(S1));
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if N>0 Then dec(N);
inc(Ligne);
Fin_Ligne[Ligne].ecran:=N+1;
Fin_Ligne[ligne].Buf:=Pose+N;
if N>0 Then
begin
For i:=1 To N DO ScreenPage^[Ligne+3,i].data:=S1[i];
For i:=1 To Max_CurseurX-1 Do
ScreenPtr^[Ligne+3,i+1].Data:=ScreenPage^[Ligne+3,i+XX].data;
end;
inc(Pose,N+2);
end;
if Pose>Fin_Buffer Then Pose:=Fin_Buffer;
Fin_page:=Pose;
FinY:=Ligne;
if (Fin_Page>=Fin_Buffer) Then
begin
if (FinY<Max_curseurY) and (Buffer^[Fin_Ligne[Ligne].buf]=#13) Then
begin
inc(FinY);
Fin_Ligne[FinY].Buf:=Fin_Buffer;
end;
end;
end
else
begin
Init_Page;
Fin_Ligne[1].ecran:=1;
Fin_Ligne[1].Buf:=1;
end;
end;
Procedure Change_Une_Page_Bas(Pose:Word;FindLines:Word);
var ligne : byte;
XX,N,N13,i: byte;
S1 : Array[1..Max_Colones] Of Char;
begin
if Fin_Page<Fin_Buffer Then
begin
XX:=(X_curseur-E_curseurX);
Debut_Page:=Pose;
for i:=1 To Max_CurseurY Do
begin
Fin_Ligne[i].Buf:=0;
Fin_Ligne[i].ecran:=1;
end;
Init_Page;
Ligne:=0;
while (Pose<=Fin_Buffer) and (Ligne<Max_curseurY) Do
begin
N:=0;
FillChar(S1,Sizeof(S1),' ');
Move(Buffer^[pose],S1,SizeOf(S1));
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if N>0 Then dec(N);
inc(Ligne);
Fin_Ligne[Ligne].ecran:=N+1;
Fin_Ligne[ligne].Buf:=Pose+N;
if N>0 Then
begin
For i:=1 To N DO ScreenPage^[Ligne+3,i].data:=S1[i];
For i:=1 To Max_CurseurX-1 Do
ScreenPtr^[Ligne+3,i+1].Data:=ScreenPage^[Ligne+3,i+XX].data;
end;
inc(Pose,N+2);
end;
if Pose>=Fin_Buffer Then Pose:=Fin_Buffer;
Fin_page:=Pose;
FinY:=Ligne;
if FindLines>0 Then inc(Line_curseur,FindLines)
else
if FinY<Y_curseur Then inc(Line_Curseur,(Max_curseurY-1)-(Y_curseur-FinY))
else
if (FinY<Max_CurseurY) and (FinY<Y_curseur) Then
inc(Line_Curseur,(Max_curseurY-1)-FinY-1)
else
inc(Line_Curseur,Max_curseurY-1);
if (Y_curseur>FinY) then Y_curseur:=FinY;
end;
end;
Procedure Change_Une_Page_Haut(Code:Char);
var XX,n,N13,i : byte;
MonteLignes: byte;
Ligne : byte;
Pose : Word;
S1 : Array[1..Max_Colones] Of Char;
begin
if (Buffer^[1]<>^Z) Then
begin
XX:=(X_curseur-E_curseurX);
if Code=' ' Then
begin
if Debut_Page>1 Then Pose:=Debut_Page-2
else Pose:=Debut_Page;
MonteLignes:=1;
end
else
begin
Pose:=Fin_Buffer;
MonteLignes:=2;
end;
For i:=1 To Max_CurseurY Do
begin
Fin_Ligne[i].Buf:=0;
Fin_Ligne[i].Ecran:=1;
end;
while (Pose>=1) and (MonteLignes<Max_curseurY) DO
begin
if (Pose=1) OR (Buffer^[Pose]=#10) Then inc(MonteLignes);
dec(Pose);
end;
inc(Pose);
if Pose<1 Then Pose:=1;
if Buffer^[Pose]=#10 Then inc(Pose);
Debut_Page:=Pose;
Init_Page;
Ligne:=0;
While (Pose<=Fin_Buffer) and (Ligne<Max_curseurY) Do
begin
N:=0;
FillChar(S1,Sizeof(S1),' ');
Move(Buffer^[pose],S1,SizeOf(S1));
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if N>0 Then dec(N);
inc(Ligne);
Fin_Ligne[Ligne].ecran:=N+1;
Fin_Ligne[ligne].Buf:=Pose+N;
if N>0 Then
begin
For i:=1 To N DO
ScreenPage^[Ligne+3,i].data:=S1[i];
For i:=1 To Max_CurseurX-1 Do
ScreenPtr^[Ligne+3,i+1].Data:=ScreenPage^[Ligne+3,i+XX].data;
end;
inc(Pose,N+2);
end;
if Pose>Fin_Buffer Then Pose:=Fin_Buffer;
Fin_page:=Pose;
FinY:=Ligne;
if Code='F' Then
begin
Y_Curseur:=FinY;
end
else
begin
if (Line_Curseur-(MonteLignes-1))>0 Then
dec(Line_Curseur,(MonteLignes-1))
else Line_Curseur:=1;
end;
end;
end;
Procedure Lecture_Une_Ligne_Bas(Pose:Word;code:Char);
var XX,N,N13,i : Word;
FinLigne : boolean;
S1 : Array[1..Max_Colones] Of Char;
begin
XX:=(X_curseur-E_curseurX);
if Pose<Fin_Buffer Then
begin
if Code<>'D' Then
begin
For i:=1 To Max_curseurY-1 DO
begin
Fin_Ligne[i]:=Fin_Ligne[i+1];
ScreenPage^[i+3]:=ScreenPage^[i+3+1];
ScreenPtr^[i+3]:=ScreenPtr^[i+3+1];
end;
FinLigne:=False;
while (Debut_Page<Fin_Buffer) and (Not Finligne) DO
begin
if Buffer^[Debut_Page]=#10 Then Finligne:=True;
inc(Debut_Page);
end;
end;
if (Marque_Bloc) Then
begin
if (Fin_Ligne[Max_curseurY-1].Buf>=FinBlock) and
(Fin_Ligne[Max_curseurY-2].Buf<=FinBlock) Then
begin
BoxColor(2,Max_curseurY+3,Max_curseurX+1,Max_CurseurY+3,TextAttr);
For i:=1 To Max_Colones-1 DO
ScreenPage^[Max_curseurY+3,i].attrib:=TextAttr;
end;
end;
For i:=2 TO Max_curseurX DO
ScreenPtr^[Max_curseurY+3,i].data:=#32;
For i:=1 TO Max_Colones Do
ScreenPage^[Max_curseurY+3,i].data:=#32;
FillChar(S1,Sizeof(S1),' ');
N:=0;
Move(Buffer^[pose],S1,SizeOf(S1));
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if N>0 Then dec(N);
Fin_Ligne[Max_curseurY].ecran:=N+1;
Fin_Ligne[Max_curseurY].Buf:=Pose+N;
if N>0 Then
begin
For i:=1 To N DO
ScreenPage^[Max_curseurY+3,i].data:=S1[i];
For i:=1 To Max_CurseurX-1 Do
ScreenPtr^[Max_curseurY+3,i+1].Data:=ScreenPage^[Max_curseurY+3,i+XX].data;
end;
inc(Pose,N+2);
if Pose>Fin_Buffer Then Pose:=Fin_Buffer;
Fin_page:=Pose;
FinY:=Max_curseurY;
if Code<>'D' Then inc(Line_curseur);
if (Marque_Bloc) Then
begin
if (Fin_Ligne[Max_curseurY-1].Buf<=FinBlock) and
(Fin_Ligne[Max_curseurY].Buf>=FinBlock) Then
begin
Defini_Bloc;
end
else
if (Fin_Ligne[Max_curseurY-2].Buf<=DebutBlock) and
(Fin_Ligne[Max_curseurY].Buf>=DebutBlock) Then Defini_Bloc;
end;
end
else
if (Buffer^[Pose]=#26) and (Buffer^[Pose-1]=#10) Then
begin
Fin_Ligne[Max_curseurY].Ecran:=1;
Fin_Ligne[Max_curseurY].Buf:=Fin_Buffer;
end;
end;
Procedure Lecture_Une_Ligne_Haut(Pose:Word);
Var XX,n,N13,i:byte;
S1:Array[1..Max_Colones] Of Char;
begin
if (Buffer^[1]<>^Z) and (Pose>1) Then
begin
XX:=(X_curseur-E_curseurX);
For i:=Max_curseurY Downto 2 DO
begin
Fin_Ligne[i]:=Fin_Ligne[i-1];
ScreenPage^[i+3]:=ScreenPage^[i+3-1];
ScreenPtr^[i+3]:=ScreenPtr^[i+3-1];
end;
if (Marque_Bloc) Then
begin
if (Debut_Page<=DebutBlock) and (Fin_ligne[1].buf>=DebutBlock) Then
begin
BoxColor(2,4,Max_curseurX+1,4,TextAttr);
ScreenPage^[4]:=ScreenPage^[3];
end
else
if (Debut_Page<=FinBlock) and (Fin_ligne[1].buf>=FinBlock) Then
begin
BoxColor(2,4,Max_curseurX+1,4,Marque_Color);
For i:=1 TO Max_Colones-1 DO
ScreenPage^[4,i].Attrib:=Marque_Color;
end;
end;
For i:=1 TO Max_Colones Do
ScreenPage^[1+3,i].data:=#32;
For i:=2 TO Max_curseurX DO
ScreenPtr^[1+3,i].data:=#32;
if Pose>1 Then dec(Pose,2);
if (Pose>1) Then
begin
While (Pose>1) and (Buffer^[Pose-1]<>#10) DO dec(Pose);
end;
Debut_Page:=Pose;
FillChar(S1,Sizeof(S1),#32);
N:=0;
Move(Buffer^[pose],S1,SizeOf(S1));
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if N>0 Then dec(N);
Fin_Ligne[1].ecran:=N+1;
Fin_Ligne[1].Buf:=Pose+N;
if n>0 Then
begin
For i:=1 To N DO
ScreenPage^[1+3,i].data:=S1[i];
For i:=1 To Max_CurseurX-1 Do
ScreenPtr^[1+3,i+1]:=ScreenPage^[1+3,i+XX];
end;
if FinY=Max_CurseurY Then
begin
Fin_Page:=Fin_Ligne[FinY].buf+2;
end
else inc(FinY);
dec(Line_Curseur);
if (Marque_Bloc) Then
begin
if (Debut_Page<=DebutBlock) and (Fin_ligne[1].buf>=DebutBlock) Then
begin
if Debut_page<DebutBlock Then
begin
Pose:=Debut_Page; N:=0;
while Pose<DebutBlock DO
begin
inc(n);
inc(Pose);
end;
if (X_curseur-E_curseurX)<N Then
BoxColor(2,4,(n-(X_curseur-E_curseurX))+1,4,TextAttr);
For i:=1 To n DO
ScreenPage^[4,i].attrib:=TextAttr;
end;
end;
if (Debut_Page<=FinBlock) and (Fin_ligne[1].buf>=FinBlock) Then
Defini_Bloc;
end;
end;
end;
Procedure Curseur_Droite;
begin
if X_curseur<Max_Colones Then
begin
inc(X_curseur);
if E_curseurX<Max_CurseurX-1 Then inc(E_curseurX)
else
Avance_Page_X_de_1;
end;
end;
Procedure Curseur_Gauche;
begin
if (X_curseur>1) Then
begin
dec(X_curseur);
if E_curseurX>1 Then dec(E_curseurX)
else
Recule_Page_X_de_1;
end;
end;
Procedure Debut_ligne_Gauche;
begin
if E_curseurX<X_curseur Then
begin
Debut__Ligne_X;
end;
X_curseur:=1;
E_curseurX:=1;
end;
Procedure Curseur___bas;
var i:byte;
begin
if (Y_Curseur<FinY) and (Y_curseur<Max_CurseurY-1) Then
begin
inc(Y_Curseur);
inc(Line_Curseur);
Change_de_ligne:=True;
end
else
if Fin_Page<Fin_Buffer Then
begin
Lecture_Une_Ligne_Bas(Fin_page,' ');
Change_de_ligne:=True;
end
else
if (Y_Curseur<FinY) and (FinY=Max_CurseurY) Then
begin
inc(Line_Curseur);
Debut_Page:=Fin_Ligne[1].buf+2;
For i:=1 To Max_curseurY-1 DO
Fin_Ligne[i]:=Fin_Ligne[i+1];
Fin_Ligne[Max_curseurY].Buf:=Fin_Buffer;
Fin_Ligne[Max_curseurY].ecran:=1;
for i:=1 To Max_curseurY-1 DO
begin
ScreenPage^[i+3]:=ScreenPage^[i+3+1];
ScreenPtr^[i+3]:=ScreenPtr^[i+3+1];
end;
for i:=2 TO Max_curseurX DO
ScreenPtr^[Max_curseurY+3,i].data:=#32;
for i:=1 TO Max_Colones Do
ScreenPage^[Max_curseurY+3,i].data:=#32;
if (FinY=Max_curseurY) and (Buffer^[Fin_Ligne[Max_curseurY-1].buf]=#26) Then
begin
dec(FinY);
if (Marque_Bloc) Then
BoxColor(2,CrtGetMaxY-1,Max_curseurX+1,CrtGetMaxY-1,TextAttr);
Beep;
end;
Change_de_ligne:=True;
end;
end;
Procedure Curseur_Haut;
begin
if (Y_Curseur>1) Then
begin
dec(Y_Curseur);
dec(Line_Curseur);
Change_de_ligne:=True;
end
else
if Debut_Page>1 Then
begin
Lecture_Une_Ligne_Haut(Debut_page);
Change_de_ligne:=True;
end;
end;
Procedure Avance_Une_Page;
var y : byte;
begin
if Fin_page<Fin_Buffer Then
begin
Change_Une_Page_Bas(Fin_Ligne[FinY].Buf-(Fin_Ligne[FinY].Ecran-1),0);
Change_de_ligne:=True;
Marque_bloc:=False;
end
else
begin
if FinY=Max_CurseurY Then
begin
inc(Line_Curseur,(FinY-1)-Y_Curseur);
Y_Curseur:=FinY-1;
Curseur___Bas;
end
else
if Y_Curseur<FinY Then
begin
inc(Line_Curseur,FinY-Y_curseur);
Y_curseur:=FinY;
end;
Change_de_ligne:=True;
end;
end;
Procedure Recule_Une_Page;
begin
if Debut_page>1 Then
begin
Change_Une_Page_Haut(' ');
Change_de_ligne:=True;
Marque_bloc:=False;
end
else
begin
Line_Curseur:=1;
Y_curseur:=1;
Change_de_ligne:=True;
end;
end;
Procedure Fin_du_Fichier;
var i : word;
N : byte;
S : string;
begin
if Fin_page<Fin_Buffer Then
begin
Gotoxy(1,Y_curseur);
X_curseur:=1;E_curseurX:=1;
i:=Fin_Ligne[Y_Curseur].Buf;
Change_Une_Page_Haut('F');
Curseur__FinLigne;
Marque_bloc:=False;
While I<Fin_Buffer DO
begin
if Buffer^[I] In[#10] Then inc(Line_Curseur);
inc(i);
end;
Change_de_ligne:=True;
end
else
begin
if FinY=Max_CurseurY Then
begin
inc(Line_Curseur,(FinY-1)-Y_Curseur);
Y_Curseur:=FinY-1;
Curseur___Bas;
end
else
if Y_Curseur<FinY Then
begin
inc(Line_Curseur,FinY-Y_curseur);
Y_curseur:=FinY;
Change_de_ligne:=True;
end;
Curseur__FinLigne;
end;
end;
Procedure Debut_Du_Fichier;
var i:byte;
begin
if Debut_Page>1 Then
begin
FinY:=1;
Debut_page:=1;
Line_curseur:=1;
Y_curseur:=1;X_curseur:=1;
E_curseurX:=1;
Premiere_page_Debut(Debut_Page);
Change_de_ligne:=True;
Marque_bloc:=False;
end
else
begin
Line_Curseur:=1;
Y_curseur:=1;
X_curseur:=1;
E_curseurX:=1;
Change_de_ligne:=True;
end;
end;
Procedure Avance_Page;
var y : byte;
begin
if Fin_page<Fin_Buffer Then
begin
Change_Une_Page_Bas(Fin_Ligne[FinY].Buf-(Fin_Ligne[FinY].Ecran-1),0);
Change_de_ligne:=True;
end
else
begin
if FinY=Max_CurseurY Then
begin
inc(Line_Curseur,(FinY-1)-Y_Curseur);
Y_Curseur:=FinY-1;
Curseur___Bas;
end
else
if Y_Curseur<FinY Then
begin
inc(Line_Curseur,FinY-Y_curseur);
Y_curseur:=FinY;
end;
Change_de_ligne:=True;
end;
end;
Procedure Recule_Page;
begin
if Debut_page>1 Then
begin
Change_Une_Page_Haut(' ');
Change_de_ligne:=True;
end
else
begin
Line_Curseur:=1;
Y_curseur:=1;
Change_de_ligne:=True;
end;
end;
Function Suprime_les_Tab:boolean;
var i : Longint;
FinFin,Change : boolean;
u : byte;
begin
Change:=False;
FinFin:=False;
i:=1;
While (i < Fin_Buffer) and (Not FinFin) Do
begin
if ( (Fin_Buffer+(Tab_Size-1)) < (Max_Buffer-512)) Then
begin
if (Buffer^[i] = #9) and (i+(Tab_Size-1) < Fin_Buffer) Then
begin
if Tab_Size>1 Then
begin
Move(Buffer^[i],Buffer^[i+(Tab_Size-1)],(Fin_Buffer-i)+1);
Buffer^[i]:=' ';
for u:=1 To (Tab_Size-1) Do
Buffer^[i+u]:=' ';
inc(Fin_Buffer,(Tab_Size-1));
Change:=True;
end
else
begin
Buffer^[i]:=' ';
Change:=True;
end;
end;
if (i< (Max_Buffer-512)) Then inc(i)
else FinFin:=True;
end
else FinFin:=True;
end;
Suprime_les_Tab:=Change;
end;
Procedure Control_Longueur_DE_Lignes(Poss,Pose2:Word);
var u,N,N13 : byte;
Control,Fin : boolean;
S1 : Array[1..Max_colones] OF CHAR;
begin
Fin:=False;
Control:=True;
while (Poss<Fin_Buffer) and (Poss<Pose2) and (Not fin) DO
begin
FillChar(S1,SizeOf(S1),#32);
Move(Buffer^[poss],S1[1],longueur_Lignes);
N:=Pos(#26,S1);
N13:=POS(#13,S1);
if (N = 0) OR ((N13 > 0) and (N13 < N)) Then N:=N13;
if Buffer^[Poss+N-1]=#26 Then
begin
Fin_Buffer:=Poss+N-1;
Fin:=True;
end
else
if (N>0) and (Buffer^[Poss+N]<>#10) Then
begin
Move(Buffer^[Poss+N],Buffer^[Poss+N+1],(Fin_Buffer-Poss+N)+1);
Buffer^[Poss+N]:=#10;
inc(Fin_Buffer,1);
end;
if (N>longueur_Lignes) OR (N=0) Then
begin
if Control Then Control:=Erreur_file_Toolarge('',0,'L' );
inc(Poss,(longueur_Lignes-1));
Move(Buffer^[Poss],Buffer^[Poss+2],(Fin_Buffer-Poss)+1);
Buffer^[Poss]:=#13;
Buffer^[Poss+1]:=#10;
inc(Fin_Buffer,2);
if Poss+2>=Pose2 Then Fin:=True;
if Buffer^[Poss-1]=#32 Then
begin
u:=0;
while (Poss>1) and (Buffer^[Poss-1]=#32) Do
begin
inc(u);
dec(Poss);
end;
Move(Buffer^[Poss+u],Buffer^[Poss],(Fin_Buffer-Poss)+1);
dec(Fin_Buffer,u);
end;
inc(Poss,2);
end
else
begin
if Poss+N>=Pose2 Then Fin:=True;
if Buffer^[Poss+N-2]=#32 Then
begin
inc(Poss,N-1);
u:=0;
while (Poss>1) and (Buffer^[Poss-1]=#32) Do
begin
inc(u);
dec(Poss);
end;
Move(Buffer^[Poss+u],Buffer^[Poss],(Fin_Buffer-Poss)+1);
dec(Fin_Buffer,u);
inc(Poss,2);
end
else
inc(Poss,N+1);
end;
if (Fin_Buffer>(Max_Buffer-512)) Then
begin
Fin_Buffer:=(Max_Buffer-512);
if Buffer^[Fin_Buffer]=#10 Then dec(Fin_Buffer);
if Buffer^[Fin_Buffer]=#13 Then dec(Fin_Buffer);
Buffer^[Fin_Buffer]:=#26;
end;
end;
if Buffer^[Fin_Buffer]=#10 Then dec(Fin_Buffer);
if Buffer^[Fin_Buffer]=#13 Then dec(Fin_Buffer);
Buffer^[Fin_Buffer]:=#26;
end;
Procedure Cherche_position_de_XY(PosePose:Word);
var debutPoin : word;
S_etat : string[6];
begin
DebutPoin:=PosePose;
Debut_ligne_Gauche;
Pos_ligne:=(Fin_Ligne[Y_Curseur].buf-Fin_ligne[Y_Curseur].ecran)+1;
PosePose:=Pos_ligne;
if PosePose>DebutPoin Then
begin
if (PosePose>1) Then
begin
While (PosePose > DebutPoin) and (PosePose> Fin_Ligne[1].buf+2) Do
begin
Curseur_Haut;
Pos_ligne:=(Fin_Ligne[Y_Curseur].buf-Fin_ligne[Y_Curseur].ecran)+1;
PosePose:=Pos_ligne;
end;
end;
while (PosePose<DebutPoin) Do
begin
Curseur_Droite;
inc(PosePose);
end;
end
else
if (PosePose<DebutPoin) Then
begin
if (PosePose < Fin_Buffer) Then
begin
while (PosePose < DebutPoin) and (DebutPoin > Fin_Ligne[Y_Curseur].buf+2) Do
begin
Curseur___Bas;
Pos_ligne:=(Fin_Ligne[Y_Curseur].buf-Fin_ligne[Y_Curseur].ecran)+1;
PosePose:=Pos_ligne;
end;
end;
while (PosePose<DebutPoin) Do
begin
Curseur_Droite;
inc(PosePose);
end;
end;
textAttr:=Etat_Color;
if Line_Curseur=0 Then Line_Curseur:=1;
Str(Line_Curseur:5,S_etat);
Putxy(11,3,S_Etat);
Str(X_Curseur:2,S_Etat);
Putxy(23,3,S_Etat+' ');
TextAttr:=Edit_Color;
Gotoxy(E_CurseurX,Y_curseur);
end;
begin
KBx:=1;
KBy:=1;
Max_CurseurX:=78;
Max_CurseurY:=CrtGetMaxY-4;
end.