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

    unit ScaleStr ;
    interface

    function ScaleFill( C1 , C2 : Char ; Len : byte ; Part : Real ) : String ;
    function FoxScaleFill( C1 : Char ; Len : byte ; Part : Real ) : String ;
    function FoxScale( C1 : Char ; Len : byte ; Part : Real ) : String ;
    function SRScaleFill( Len : byte ; Part : Real ) : String ;

    const

          OnlyOne   : Boolean = FALSE ;
          A_La_Zip  : Boolean = FALSE ;
          A_La_ZipM : Boolean = FALSE ;

    implementation

    const
        maxC = 23;
        minC = 0 ;
        CurC   : Byte = 0  ;

    type
        CharsT = array[ minC .. maxC ] of char ;

    function SRScaleFill( Len : byte ; Part : Real ) : String ;
    var
       s      : String ;
       l      : word   ;
    begin
       s[ 0 ] := Chr( Len ) ;
       FillChar( S[ 1 ] , Len , #249 ) ;
       if ( Part < 1 ) and ( Part >= 0 ) then
          l := Round( Len * Part * 2 )
       else
          l := Len shl 1 ;
       if l > 0 then
       begin
          if odd( l ) then
             s[ l shr 1 + 1 ] := #221
          else
             s[ l shr 1 ] := #222
       end
       else
          s[ 1 ] := #221 ;
       SRScaleFill := S ;
    end ;

    function FoxScaleFill ;
    var
       s      : String ;
       l      : Word   ;
    begin
       s[ 0 ] := Chr( Len ) ;
       FillChar( S[ 1 ] , Len , C1 ) ;
       if ( Part < 1 ) and ( Part >= 0 ) then
          l := Round( Len * Part * 2 )
       else
          l := Len shl 1 ;
       if l > 0 then
       begin
          FillChar( S[ 1 ] , l shr 1 , #219 ) ;
          if odd( l ) then
             s[ l shr 1 + 1 ] := #221
       end
       else
          s[ 1 ] := #221 ;
       FoxScaleFill := S ;
    end ;

    Function FoxScale ;
    Var
       S      : string ;
       L      : word   ;
    begin
       if ( Part < 1 ) and ( Part >= 0 ) then
          L := Round( Len * Part )
       else
          L := Len  ;
       S[0] := Chr( L ) ;
       FillChar( S[ 1 ] , L , C1 ) ;
       FoxScale := S ;
    end ;

    function ScaleFill( C1 , C2 : Char ; Len : byte ; Part : Real ) : String ;
    var
       s      : String ;
       l      : byte   ;
       CC,
       CX,CL  : CharsT ;
    begin
       CL := '//--\\//--\\//--\\//--\\' ;
       CX := '////////--------\\\\\\\\' ;
       s[ 0 ] := Chr( Len ) ;
       FillChar( S[ 1 ] , Len , C2 ) ;
       if ( Part < 1 ) and ( Part >= 0 ) then
          l := Round( Len * Part )
       else
          l := Len ;

       if ( Not OnlyOne ) then
          FillChar( S[ 1 ] , L , C1 ) ;
       if A_La_Zip then
         CC := CL ;
       if A_La_ZipM then
         CC := CX ;

       if A_La_Zip or A_La_ZipM  then
       begin
          if l > 0 then
          begin
             s[ l ] := CC[ CurC ] ;
             if Part = 1.0 then
               s[ l ] := ' ' ;
          end
          else
             s[ 1 ] := CC[ CurC ] ;
          inc( CurC ) ;
          if CurC > MaxC then
             CurC := MinC ;
       end
       else
          if OnlyOne then
          begin
             if l > 0 then
                s[ l ] := C1
             else
                s[ 1 ] := C1
          end ;
       ScaleFill := S ;
    end ;

    end .

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