IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

La Commande Numérique sur la Production Bois

Date de publication : 06/03/2010. Date de mise à jour : 03/07/2011.


   

 


Types_11.PAS - U_Pick.PAS
Types_11.PAS (pour l'éditeur commandes de pages et curseurs, etc)
U_Pick.PAS (gestion Pick sur menu files, comme sur Turbo Pascal)


Types_11.PAS - U_Pick.PAS


Types_11.PAS (pour l'éditeur commandes de pages et curseurs, etc)


{==============  FICHIER DE EDNUM  ======================}
{ Unite Graphe Trace.pas  Usinage machines a c.n. NUM750 }
{ programmation Turbo Pascal - Borland                   }
{ Copyright (S) 1997-2011                                }
{ programmeur du programme A.Ara                         }
{ 64150 Mourenx - France.                                }
{ Licence d'utilisation accord dans un but demonstratif  }
{ Unite types_11_pas : editeur EDnum c.n du bois num750  }
{========================================================}

{$O+,F+}

Unit Types_11;

Interface      

{==================================================================}
{ Types publiques de Types_11 destines a l'editeur EDnum           }
{ 132 largueur del editeur Maximun 154 colones  (Max_curseurX*2)-2 } 
{==================================================================}

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;

{===Pages===}

Procedure Positione_Curseur(X1:byte);
Procedure Fin__Ligne_X;                   {* deplace X colones a gauche   *}
Procedure Debut__Ligne_X;                 {* deplace X colones a droite   *}
Procedure Avance_Page_X_de_1;             {* deplace  une colone a droite *}
Procedure Recule_Page_X_de_1;             {* deplace une colone a gauche  *}
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);

{===========B_Langa2.Blc====================}
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;

{$i B_Langa2.Blc}   {*lecture languages exmples*}
{$I P_Attrib.Blc}   {*attribut de fichiers*}
{$I B_Langa3.Blc}
{$I P_Verify.Blc}
{$I BlocSave.BLC}
{$I BlocLoad.BLC}
{$i CupeBloc.BLC}   {*cupe le bloc marque dans le editeur*}
{$I B_Ctrl_K.BLC}
{$I Marqueur.blc}
{$i Director.blc}
{$i Load_FIL.blc}   {*dernier version avec directori*}

{$i Save_Fic.BLC}
{$I Mots_D_G.BLC}
{$I Del_G_D.BLC}
{$I Tab_Ins.Blc}
{$I Inser_Li.Blc}
{$I Inser_Ch.Blc}
{$I Del_Line.BLC}
{$I Shif_Blo.pas}

{** SI Lire_Blo.Blc **}  {*lecture du bloc dans le buffer blocs*}

{=============================================}
{ Verifie l'existence du fichier selectionn?  }
{=============================================}
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;{*FileExists*}



{==============================}
{  Erreur de limite de buffer  }
{==============================}
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; {*Error_Color;*}
   
   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;{*Erreur_limite_Buf*}




{=============================================}
{ positione le curseur X a la position donne  }
{=============================================}
Procedure Positione_Curseur(X1:byte);
Var deplace,i:Word;

begin
   if X1 in[1..Max_Colones-1] Then
{0} begin
       i:=X_curseur-E_curseurX;          {*calcule le deplacement de l'ecran*}

{.}    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
{1}     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;
{1}     end
       else
       if X1 in[1..(Max_CurseurX-1)] Then
{2}     begin
           Debut__Ligne_X;
           E_curseurX:=X1;
           X_curseur:=X1;
{2}     end;
{0} end;

end;{*ends positione_Curseur*}




{========================================================}
{ Change la fin le debut ou contenu de un block Marque   }
{========================================================}
Procedure Change_Block(Signe:Char;Poss:Word;Deplace:integer);
begin
         {**Debut de Modifications des valeurs du block**}
         {**dans une traduction de un Block            **}

    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
	                   {**Debut de Modifications des valeurs du un block existant**}
    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 de Modifications des valeurs du un block existant**}

end;{*Change_Block*}






{==========================================}
{ Insere la ligne du curseur sur le buffer }
{==========================================}
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);

       {**Debut de Modifications des valeurs du block**}

       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;       {**fin de Modification des valeurs du block**}
    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);

       {**Debut de Modifications des valeurs du block **}

       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;        {**fin de Modification des valeurs du block**}
    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;{**Save_Ligne**}




{=============================================================}
{ Copy la ligne du curseur du buffer dans la ligne de travail }
{=============================================================}
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;{*Load_Ligne_Curseur*}





{=================================}
{ copy une partie de l'ecran dans }
{=================================}
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;  {* met le bit7 ? 0 *}
        Inser_Mode:=False;
    end
   else
    begin
        Mem[0:$417]:=Mem[0:$417]+128;    {* met le bit7 ? 1 *}
        Inser_Mode:=True;
    end;

end;{*Change_Inser_Mode*}





Procedure Initialiser;
var i     : word;
    Color : byte;

begin
                {*sauvegarde les donnes du fichier que ont ferme pour pick*}
    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;       {**marque de fin de fichier fichier vide**}

    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;{*ends initialise*}





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);
    
	{**Line_Etat**}
    
	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;{**Donne_Position_XY**}





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);

       {**Marquage dans ScreenPage**}
       
	   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;

       {**marque sur l'ecran**}

       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;{*end defini bloc*}





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   {**erreur de taille fichier**}
    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    {**erreur de ligne longes**}
       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;{*Erreur_file_Toolarge*}





{======================================================}
{ Utilite: chargement du disque le fichier spcifie     }
{======================================================}
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);
   {$i-}
     Reset(F1);
   {$i+}
   Erreur:=Ioresult;

   if Erreur=0 Then
    begin
        {$i-}
           Close(F1);
        {$i+}
    end;

   if (Erreur=150) then goto __Fin;

   if (Erreur=5)  Then
    begin
        Disque_2:=Disque_Nom[1]+Disque_Nom[2];
        {$i-}
          GetFattr(F1,Attr);
        {$I+}
        if DosError=0 Then
         begin
            {$I-}
              SetFattr(F1,$20);
            {$I+}
            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);
        {$I-}
          Reset(fff); {,1);}
        {$I+}
        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);
                {$I-}
                  Read(fff,Ch);
                {$i+}
                Buffer^[iiii]:=Ch;
             end;
            {$i-}
              close(fff);
            {$i+}
            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;{*erreur=0*}

        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 {*erreur*}
   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);
        {$I-}
          SetFattr(F1,Attr);
        {$I+}
        Erreur:=DosError;
    end;
end;{*Load_Fichier_Disque*}





{**2**}

Procedure Fin__Ligne_X; {* deplace X colones a gauche *}
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;   {**deplace X colones a droite**}
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;   {**deplace  une colone a droite**}
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;  {* deplace une colone a gauche *}
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
{1} if (X_curseur=E_curseurX) Then  {* ecran sans deplacement *}
     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;
{1}  end
    else

{2} begin      {**Ecran deplace a droite**}
       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;
{2} end;

end;{*Curseur__FinLigne*}




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;



{===========pages==========}

{===================================================}
{ Lecture de la premiere page chargement du fichier }
{===================================================}
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
           {*intialisation tableau de Fin de Lignes*}
        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; {* while *}

        if Pose>Fin_Buffer Then Pose:=Fin_Buffer;
   
        {*si fin de ligne = Max_curseurY fin de page debut ligne ne 22*}
   
        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 {*buffer(1)<>Z*}
   else
    begin
        Init_Page;
        Fin_Ligne[1].ecran:=1;
        Fin_Ligne[1].Buf:=1;
    end;
end;{*end premiere_page*}





{============================================}
{ Lecture de une page vers le bas du fichier }
{============================================}
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;
    
	    {*intialisation tableau de Fin de Lignes*}
    
	    for i:=1 To Max_CurseurY Do
         begin
             Fin_Ligne[i].Buf:=0;
             Fin_Ligne[i].ecran:=1;
         end;

       {*affiche la Page vers le Bas*}

       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; {*while*}

       if Pose>=Fin_Buffer Then Pose:=Fin_Buffer;
      
	   {*si fin de ligne = max_curseurY fin de page*}
       {*debut ligne ne Max_curseurY+1*}

       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;{*end Change_Page_Bas*}




{==================================================}
{ Remonte une page entiere vers le haut du fichier }
{==================================================}
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;

       {*Initialisation Tableau de fin  de lignes*}
      
	   For i:=1 To Max_CurseurY Do
        begin
            Fin_Ligne[i].Buf:=0;
            Fin_Ligne[i].Ecran:=1;
        end;

       {*remonte Max_CurseurY lignes ver le haut*}

       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;
	   
       {*affiche les lignes remontes vers le haut*}

       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; {*while*}

       if Pose>Fin_Buffer Then Pose:=Fin_Buffer;
       Fin_page:=Pose;

       {*si fin de ligne = max_curseurY fin de page*}
       {*debut ligne ne Max_curseurY+1*}

       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;{*Change_Page_Haut*}




{===================================}
{ lectur de une ligne vers le bas   }
{===================================}
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
{a}     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;
{a}     end;

       {*change le attribut de la ligne du bas si la fin de bloc*}
       {*et depase*}

       if (Marque_Bloc) Then
{b}     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;
{b}     end;


       {* efface la derniere ligne del ecran *}

       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;

{c}    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;
{c}    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
{d}     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;
{d}     end;
    end {* buffer(1)<>Z *}
   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;{*end lecture_ligne_bas*}





{=============================================}
{ Lecture de une ligne ver le haut du fichier }
{=============================================}
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
{a}         begin
               BoxColor(2,4,Max_curseurX+1,4,TextAttr);
               ScreenPage^[4]:=ScreenPage^[3];
{a}         end
           else
           if (Debut_Page<=FinBlock) and (Fin_ligne[1].buf>=FinBlock) Then
{b}         begin
               BoxColor(2,4,Max_curseurX+1,4,Marque_Color);
               For i:=1 TO Max_Colones-1 DO
               ScreenPage^[4,i].Attrib:=Marque_Color;
{b}         end;
        end;

       {*efface la Premiere ligne d'ecran*}

       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;

       {*remonte le debut de page de une ligne vers le haut*}

       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;

       {*Affiche la Premiere ligne d'ecran*}

{c}    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];
{c}     end;

       {*Remonte la fin de page de une ligne*}

       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
{d}         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;
{d}         end;
{f.}       if (Debut_Page<=FinBlock) and (Fin_ligne[1].buf>=FinBlock) Then
             Defini_Bloc;
        end; {*marque_Bloc*}
    end;
end; {*Lecture_Ligne_Haut*}





{=====================================}
{ Avance curseur une position         }
{=====================================}
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;




{=====================================}
{ Recule curseur une position         }
{=====================================}
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;



{=====================================}
{ Deplace curseur debut de la ligne   }
{=====================================}
Procedure Debut_ligne_Gauche;
begin
   if E_curseurX<X_curseur Then
    begin
       Debut__Ligne_X;
    end;
   X_curseur:=1;
   E_curseurX:=1;
end;




{=========================================}
{ Deplace curseur vers le Bas de l'ecran  }
{=========================================}
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;{*end curseur Bas*}




{=========================================}
{ Deplace curseur vers le Haut de l'ecran }
{=========================================}
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;{*end curseur_haut*}




{============================================}
{ Avance de  une page vers le Bas de l'ecran }
{============================================}
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;{*Avance_Une_Page*}




{=============================================}
{ Recule de  une page vers le Haut de l'ecran }
{=============================================}
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;{*Recule_Une_Page*}




{===============================}
{ deplace a la fin du fichier   }
{===============================}
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;{*Fin_du_Fichier*}




{===============================}
{ deplace ou debut du fichier   }
{===============================}
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;{*Debut_Du_Fichier*}




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;{*Avance_Page*}





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;{*Recule_Page*}




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;{* while *}
    Suprime_les_Tab:=Change;
end;{*Suprime_les_Tab*}




{========================================================================}
{ Controle la longeur de lignes du buffer longueur maximum Max_colones-1 }
{ si la longeur plus grande insere CR  et suprime les Blans de la fin de }
{ la ligne poss: debut de controle, Pose2: Fin.                          }
{========================================================================}
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; {* while *}

    if Buffer^[Fin_Buffer]=#10 Then dec(Fin_Buffer);
    if Buffer^[Fin_Buffer]=#13 Then dec(Fin_Buffer);
    Buffer^[Fin_Buffer]:=#26;
end;{*Control_Longueur_DE_Lignes*}





{=============================================================}
{ Cherche et positione le curseur ou debut de bloc marque     }
{=============================================================}
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;

    {*si la position et plus grande que DebutBlock Remonte le curseur*}

    if PosePose>DebutPoin Then
     begin
        if (PosePose>1) Then
         begin
               {**Remonter les lignes juque la ligne de PosePose**}

             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      {*fin de PosePose > DebutPoin*}

    else      {*si la position et plus petite que DebutBlock desandre ver le bas*}

    if (PosePose<DebutPoin) Then
     begin
        if (PosePose < Fin_Buffer) Then
         begin
                   {**desandre les lignes juque la ligne de PosePose**}
            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; {*fin de PosePose < DebutPoin*}

    {*Debut etat*}

    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 etat*}

end;{*fin de Cherche_position_de_XY*}


begin
    KBx:=1;
    KBy:=1;
    Max_CurseurX:=78;             {*position max de ecran Horizontale*}
    Max_CurseurY:=CrtGetMaxY-4;   {*position max de verticale*}
end.

U_Pick.PAS (gestion Pick sur menu files, comme sur Turbo Pascal)


{==============  FICHIER DE EDNUM  ======================}
{ Unite Graphe Trace.pas  Usinage machines a c.n. NUM750 }
{ programmation Turbo Pascal - Borland                   }
{ Copyright (S) 1997-2011                                }
{ programmeur du programme A.Ara                         }
{ 64150 Mourenx - France.                                }
{ Licence d'utilisation accord dans un but démonstratif  }
{ Unite u_pick.pas : éditeur EDnum c.n du bois num750    }
{========================================================}

{$O+,F+}

Unit U_Pick;

Interface

Type
     Pose_Marque_Fic = Array[1..4] Of word;

     Reg_Pick = Record
                    NomF      : string[12];
                    NomR      : string[60];
                    posX,posY : byte;
                    pageDebut : word;
                    Ligne     : word;
                    Marque    : Pose_Marque_Fic;
                    RTime     : Longint;
                end;

      Fichier5 = File of Reg_Pick;

Var
    Tab         : Array[1..10] OF Reg_Pick;
    Pose_Marque : Pose_Marque_Fic;
    Marque_Pick : Pose_Marque_Fic;
    Libre10     : Fichier5;


Procedure Init_Pick;
Procedure Selec_Pick(var Reper,NeimeF:string);
Procedure Reinit_Pick(SR,SN:string);

Implementation


Uses Box13,Var_1,Buffs,Get_Key,NUMMOUSE;


Procedure Init_Pick;
var i:byte;

begin
    for i:=1 To 4 DO
     Pose_Marque[i]:=0;

    for i:=1 TO 10 DO
     begin
         Tab[i].NomF :='';
         Tab[i].NomR :='';
         Tab[i].posX :=1;
         Tab[i].posY :=1;
         Tab[i].PageDebut:=1;
         Tab[i].ligne    :=1;
         Tab[i].Marque   :=Pose_Marque;
         Tab[i].Rtime    :=0;
     end;

    Tab[1].NomF:='NONAME.???';
    Tab[1].NomR:='';
    Tab[2].NomF:='[Load file]';
    Tab[2].NomR:='';
    Max_Pick:=2;
end;





Procedure Selec_Pick(Var Reper,NeimeF:string);
var i,y,Long,Key : byte;

begin
   i:=1;
   Long:=13;

   While (i<=10) and (Tab[i].NomF<>'') DO
    begin
       if (Tab[i].NomR<>Repertoire) And (tab[i].NomR<>'') Then
         if (Long < Length(Tab[i].NomF+Tab[i].NomR)) Then
           Long:=Length(Tab[i].NomF+Tab[i].NomR);

       inc(i);
    end;

   ReadBuf(6,5,9+Long,16,BuffDir^);
   BoxFill(6,5,9+Long,6+Max_Pick,' ');
   Rectangle(6,5,9+Long,6+Max_Pick,Simple);
   Putxy(6+((Long-9) div 2),5,' Recent files ');

   {**Affichage**}

   i:=1;
   While (i<=10) And (Tab[i].NomF<>'') DO
    begin
       if Tab[i].NomR=Repertoire Then Putxy(8,5+i,Tab[i].NomF)
       else
        Putxy(8,5+i,Tab[i].nomR+Tab[i].NomF);

       inc(i);
    end;

   {**Selection**}

    Y:=7;
    Highbox(7,Y,Long+8,Y,Bx);
    Mousexy(6,5);
    CsOff;

    Repeat      

        DisplayMouse;
        Key:=KeyMouse;
        MaskMouse;

        if (Key=1) and (not Key_Code) and (Mbox(7,6,8+Long,5+Max_Pick)) Then
         begin
            if MouseY<>Y Then
             begin
                Highbox(7,Y,8+long,Y,Bx);
                Y:=MouseY;
                Highbox(7,Y,8+long,Y,Bx);
             end;
         end
        else
        if (Key=2) And (not Key_Code) And (MouseY = Y) And (Mbox(7,6,8+Long,5+Max_Pick)) Then
         begin
             Key_Code:=False;
             Key:=13;
         end;

        if (Key =80) And (Y<Max_Pick+5) Then
         begin
             Highbox(7,Y,8+long,Y,Bx);
             inc(y);
             Highbox(7,Y,8+long,Y,Bx);
         end
        else
        if (Key =72) And (Y>6) Then
         begin
             Highbox(7,Y,8+long,Y,Bx);
             dec(y);
             Highbox(7,Y,8+long,Y,Bx);
         end;

    Until (Key in[27,13]) or ((Key_Code) and (Key =61));

    Highbox(7,Y,8+long,Y,Bx);

    if (Key_Code) and (Key =61) Then NeimeF:='61..'
    else
    if Key = 13 Then
     begin
        Reper:=Tab[y-5].NomR;
        NeimeF:=Tab[y-5].NomF;
     end
    else
     begin
         Reper:='';
         NeimeF:='';
     end;
    WriteBuf(6,5,9+Long,16,BuffDir^);

end;{*ends Selec_Pick*}



Procedure Reinit_Pick(SR,SN:string);
var i      : byte;
    Trouve : Boolean;

begin
   Trouve:=False;
   i:=1;
   SR:=Uppers(SR);
   SN:=Uppers(SN);

   if (SN=Tab[1].NomF) and (SR=Tab[1].NomR) Then
    begin
       Tab[1].marque:=Marque_Pick;
       Tab[1].PosX  :=X_Pick;
       Tab[1].PosY  :=Y_Pick;
       Tab[1].PageDebut:=Page_Pick;
       Tab[1].Ligne    :=Line_Pick;

       Tab[1].Rtime:=FileDate(Tab[1].NomR+Tab[1].NomF);

       X_Curseur:=X_Pick;
       Y_Curseur:=Y_Pick;
       Debut_page:=Page_Pick;
       Line_Curseur:=Line_Pick;
    end
   else
    begin
       if SN='NONAME.???' Then SR:='';

       While (i<10) And (Tab[i].NomF<>'') DO
        begin
           if (SN=Tab[i].NomF) And (SR=Tab[i].NomR) Then
            begin
               if Tab[i].Rtime=FileDate(Tab[i].NomR+Tab[i].NomF) Then
                begin
                   Debut_page:=Tab[i].PageDebut;
                   X_Curseur:=Tab[i].posX;
                   if X_curseur<Max_curseurX Then E_curseurX:=X_curseur;
                   Y_Curseur:=Tab[i].posY;
                   Line_Curseur:=Tab[i].Ligne;
                   Pose_Marque:=Tab[i].marque;
                end;

               Trouve:=True;

               While (i<Max_Pick) And (Tab[i].NomF<>'') DO
                begin
                   Tab[i]:=tab[i+1];
                   inc(i);
                end;

               Tab[i].NomF:='';
               Tab[i].NomR:='';
               dec(Max_Pick);
            end;
           inc(i);

        end;{*while*}

       i:=Max_Pick+1;
   
       While (i>1) DO
        begin
           Tab[i]:=tab[i-1];
           dec(i);
        end;

       Tab[1].NomF:=SN;
       Tab[1].NomR:=SR;

       if Tab[2].NomF<>'NONAME.???' Then
        begin
           Tab[2].PosX:=X_Pick;
           Tab[2].PosY:=Y_Pick;
           Tab[2].PageDebut:=Page_Pick;
           Tab[2].Ligne:=Line_Pick;
           Tab[2].Marque:=Marque_Pick;
           Tab[2].Rtime:=FileDate(Tab[2].NomR+Tab[2].NomF)
        end
       else
        begin
           Tab[2].PosX:=1;
           Tab[2].PosY:=1;
           Tab[2].PageDebut:=1;
           Tab[2].Ligne:=1;
           For i:=1 TO 4 DO
           Tab[2].Marque[i]:=0;
        end;

       if Max_Pick<10 Then Inc(Max_Pick);

       Tab[Max_Pick].NomF:='[Load file]';
       Tab[Max_Pick].NomR:='';

       For i:=1 TO 4 DO
        Tab[Max_Pick].Marque[i]:=0;
 
        {==================================================================}
        {** sauvegarde des dones du fichier a l'ouvertue                 **}
        {** si le fichier et modifie et non sauvergarde pick reprend les **}
        {** donnes de ouverture                                          **}
        {==================================================================}

       X_Pick:=X_curseur;
       Y_Pick:=Y_curseur;
       Page_Pick:=Debut_Page;
       Line_Pick:=Line_Curseur;
       Marque_Pick:=Pose_Marque;
    end;
end;

end.

   

 

 

Valid XHTML 1.0 TransitionalValid CSS!

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2011 A. Ara. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.