[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]

    {
    I've enclosed 2 SCROLL functions....
    Hope it'll help.
    These source are FREEWARE. So then can only be used in a Freeware or Shareware
    . ( It'll be great if you give me a copy of your freeware).
    These sources can be added to SWAGS....

    <==== Cut =====> }

    Uses CRT,DOS ...

    Procedure Cadre (X1,X2,Y1,Y2,FG,BG:Integer);

    { Trace un Cadre entre les Coordonn‚es X1,Y1 et X2,Y2
      avec FG= Couleur du Cadre , BG= Couleur du Fond }

    Var
       corner1,
       corner2,
       corner3,
       corner4,
       horizline,
       vertline : String;
       a,b: integer;

       Begin
                   corner1:='Ú';
                   corner2:='¿';
                   corner3:='À';
                   corner4:='Ù';
                   horizline:='Ä';
                   vertline:='³';

            TextColor (FG);                  { Fixe les couleurs }
            TextBackground (BG);

            GotoXY ( X1,Y1 );                { Positionne le curseur }
          Write (Corner1);

          For a:= (X1+1) to (X2-1) do
           Begin                             { Ecrit le Cadre }
            Write (Horizline);
           end;

          Write (Corner2);

           For a:= (Y1+1) to (Y2-1) do
            Begin
             GotoXY(X1,a);
             Write (VertLine);
             For b:= (X1+1) to (X2-1) do
              Begin
               Write (' ');
              end;
             Write(Vertline);
            end;

          GotoXY(X1,Y2);
          Write (Corner3);

          For a:= (X1+1) to (X2-1) do
           Begin
            Write (Horizline);
           end;

           Write (Corner4);
    end;

    Procedure Explode_Cadre (X1,X2,Y1,Y2,FG,BG,Delai: Integer);

    { R‚daction: Explode_Cadre (X1,X2,Y1,Y2,FG,BG,Delai) }

      Var

             gauche,droite,MilieuX,
                a,b: Integer;

      Begin

       MilieuX:= (X1+X2) div 2;         { Calcul des paramŠtres de position }
       gauche:= (X2-X1) div 2;
       droite:= gauche;
       if ((X2-X1) Mod 2) > 0 then Droite:= Droite +1;

                                        { D‚but du Trac‚ }

       For a:= 1 to Gauche do
        Begin
         Cadre ((MilieuX-a),(MilieuX+a),Y1,Y2,FG,BG);
         delay (Delai);
        end;

       if Gauche <> Droite then Cadre (X1,X2,Y1,Y2,FG,BG);

       End;

    Procedure Scroll (x1,x2,Y:Byte;S:String;fg,bg,vitesse:integer);

    { Avec
          x1 et x2 position x de la fenŠtre de scrolling
          Y        position Y de la fenŠtre de scrolling
          S        Chaine de caractŠres … faire d‚filer
          fg       ForeGround (Couleur du Texte)
          bg       BackGround (Couleur du Fond)
          vitesse  Vitesse du scrolling

     Tout appui sur une touche arrete le scrolling et vide le buffer clavier

    }

     Var
        a,b,LonFenetre,LonStr: Byte;
        ch,dh: String;

     Begin

      Ch:='';
      LonFenetre:=(x2-x1);
      LonStr:=Length(S);

      For b:=1 to (LonFenetre) do ch:=concat (ch,' ');  { Rajoute N epaces avant
    et apres la chaine S}  dh:=ch;
      ch:= concat(ch,S,ch);
      b:= 1;

      Repeat
       Begin
        b:=b+1;
        Ecris(x1,Y,Copy(ch,b,LonFenetre),fg,bg);
        delay(Vitesse);
        end;

      Until (Keypressed) or (b>(LonFenetre+LonStr+1));
      Vide_Buffer_Clavier;
      Ecris(x1,Y,dh,fg,bg);
     end;

    Procedure Scroll_Inverse (x1,x2,Y:Byte;S:String;fg,bg,vitesse:integer);

     Var
        a,b,LonFenetre,LonStr: Byte;
        ch,dh: String;

     Begin

      Ch:='';
      LonFenetre:=(x2-x1);
      LonStr:=Length(S);

      For b:=1 to (LonFenetre) do ch:=concat (ch,' ');  { Rajoute N epaces avant
    et apres la chaine S}  dh:=ch;
      ch:= concat(ch,S,ch);
      b:= 1;

      Repeat
       Begin
        b:=b+1;
        Ecris(x1,Y,Copy(ch,(LonFenetre+LonStr)-b,LonFenetre),fg,bg);
        delay(Vitesse);

       end;
      Until (Keypressed) or (b>(LonFenetre+LonStr+1));
      Vide_Buffer_Clavier;
      Ecris(x1,Y,dh,fg,bg);
     end;

    Procedure Scroll_No_Exit (x1,x2,Y:Byte;S:String;fg,bg,vitesse:integer);

    { Proc‚dure identique … Scroll mais sans possibilit‚ d'Echap.}

     Var
        a,b,LonFenetre,LonStr: Byte;
        ch: String;

     Begin

      Ch:='';
      LonFenetre:=(x2-x1);
      LonStr:=Length(S);

      For b:=1 to (LonFenetre) do ch:=concat (ch,' ');  { Rajoute N epaces avant
    et apres la chaine S}  ch:= concat(ch,S,ch);
      b:= 1;

      Repeat
       Begin
        b:=b+1;
        Ecris(x1,Y,Copy(ch,b,LonFenetre),fg,bg);
        delay(Vitesse);

       end;
      Until (b>(LonFenetre+LonStr+1));
      Vide_Buffer_Clavier;

     end;

    Procedure Scroll_Inverse_No_Exit
    (x1,x2,Y:Byte;S:String;fg,bg,vitesse:integer);
    { Proc‚dure identique … Scroll mais sans possibilit‚ d'Echap.}

     Var
        a,b,LonFenetre,LonStr: Byte;
        ch: String;

     Begin

      Ch:='';
      LonFenetre:=(x2-x1);
      LonStr:=Length(S);

      For b:=1 to (LonFenetre) do ch:=concat (ch,' ');  { Rajoute N epaces avant
    et apres la chaine S}
      ch:= concat(ch,S,ch);
      b:= 1;

      Repeat
       Begin
        b:=b+1;
        Ecris(x1,Y,Copy(ch,(LonFenetre+LonStr)-b,LonFenetre),fg,bg);
        delay(Vitesse);

       end;
      Until (b>(LonFenetre+LonStr+1));
      Vide_Buffer_Clavier;

     end;

[Back to TEXTWNDW SWAG index] [Back to Main SWAG index] [Original]