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

    { EFLIB | Extended Function Library (C) Johan Larsson, 1992 - 1997
              All rights reserved. E-mail to jola@ts.umu.se.

              FREE STRING ROUTINE UNIT - SWAG RELEASE, June 1997.

      --------
      SYNOPSIS
      --------
      This is some of the string routines in an early release of EFLIB,
      the application framework for Borland Pascal with full OOP design.
      These routines are donated to the public domain and may freely be
      used, modified and distributed - in any way.

      THERE IS NO WARRANTY TO GO WITH THIS FREE STRING UNIT, NOR IS
      ANY SUPPORT AVAILABLE FOR THESE PROCEDURES.

      -------------------
      ABOUT EFLIB STRINGS
      -------------------
      This unit is donated to the public domain since EFLIB contains
      a 100% OO string engine, introduced in release 3 of EFLIB. This
      engine features sophisticated text structures, dynamic allocations,
      pattern matching, search algorithms (Boyer-Moore as well as KMP),
      extended text tokens, hyper strings, formatted strings and so on ...

      **********************************************************************
      |                                                                    |
      |  This program is DEVELOPED WITH EFLIB. EFLIB is a SOPHISTICATED    |
      |  OBJECT ORIENTED TOOLKIT for Borland Pascal. EFLIB contains        |
      |  hundreds of features, including ...                               |
      |                                                                    |
      |    o  Classic data structures       o  Data streams (in-/output)   |
      |    o  Full GUI                      o  Mathematics (matrixes, etc) |
      |    o  Windows, browsers, editors    o  Text handling               |
      |                                                                    |
      |  EFLIB combines the flexibility of the Borland C++ Class Library   |
      |  with features similar to Borland Turbo Vision.                    |
      |                                                                    |
      |  You can DOWNLOAD EFLIB together with 1 MB of kernel SOURCE CODE   |
      |  on Internet; http://www.ts.umu.se/~jola/EFLIB/. If you have any   |
      |  questions, write an e-mail to jola@ts.umu.se.                     |
      |                                                                    |
      **********************************************************************  }

    UNIT FREESTRI;

    INTERFACE

    type tCharSet = set of char;

    function BackwardPos (var SubString, Data : string; StartPosition : byte) : byte;
    function CountPos (var SubString, Data : string; Count : byte) : byte;
    function ForwardPos (var SubString, Data : string; StartPosition : byte) : byte;
    function IsCharactersInString (Chars : tCharSet; Data : string) : boolean;
    function IsInString (SubString : string; Data : string) : boolean;
    function Occurrence (var SubString, Data : string) : byte;
    function Replace (var Data, SubString1, SubString2 : string) : string;
    function SearchPos (var SubString, Data : string; StartPosition : byte) : byte;
    function StringBackwardPos (SubString, Data : string; StartPosition : byte) : byte;
    function StringCentered (Data : string) : string;
    function StringCountPos (SubString, Data : string; Count : byte) : byte;
    function StringDoubled (Data : string) : string;
    function StringFill (Count : byte; SubString : string) : string;
    function StringFixed (Data : string; FixedLength : byte) : string;
    function StringFixedCentered (Data : string; FixedLength : byte) : string;
    function StringFixedRight (Data : string; FixedLength : byte) : string;
    function StringForwardPos (SubString, Data : string; StartPosition : byte) : byte;
    function StringOccurrence (SubString, Data : string) : byte;
    function StringReplace (Data, SubString1, SubString2 : string) : string;
    function StringSearchPos (SubString, Data : string; StartPosition : byte) : byte;
    function StringSpace (Count : byte) : string;
    function StringStripped (Data : string) : string;
    function StringZeroStripped (Data : string) : string;
    procedure Fill (var Data : string; Count : byte; SubString : string);
    procedure StringRemoveLead (var Data : string; Character : char);
    procedure StringRemoveTrail (var Data : string; Character : char);

    IMPLEMENTATION

    { *****************************************
      *             Procedures                *
      ***************************************** }

    { Returns the position of a substring, beginning at specified position and
      searching forward }
    function ForwardPos (var SubString, Data : string; StartPosition : byte) : byte;
    var Position : integer;
    begin
         if StartPosition < 1 then StartPosition := 1;
         Position := Pos (SubString, Copy (Data, StartPosition, Length(Data) - StartPosition + 1));
         if Position > 0 then ForwardPos := Pred(Position + StartPosition)
            else ForwardPos := 0; { Not found }
    end;

    { Returns the position of a substring, beginning at specified position and
      searching forward }
    function StringForwardPos (SubString, Data : string; StartPosition : byte) : byte;
    begin
         StringForwardPos := ForwardPos (SubString, Data, StartPosition);
    end;

    { Returns the position of a substring, beginning at specified position and
      searching backward }
    function BackwardPos (var SubString, Data : string; StartPosition : byte) : byte;
    begin
         if StartPosition > Length(Data) then StartPosition := Length(Data);
         BackwardPos := Pos (SubString, Copy (Data, 1, StartPosition));
    end;

    { Returns the position of a substring, beginning at specified position and
      searching backward }
    function StringBackwardPos (SubString, Data : string; StartPosition : byte) : byte;
    begin
         StringBackwardPos := BackwardPos (SubString, Data, StartPosition);
    end;

    { Returns the position of a character closests to a certain position }
    function SearchPos (var SubString, Data : string; StartPosition : byte) : byte;
    var ForwardIndex, BackwardIndex : byte;
    begin
         ForwardIndex  := ForwardPos  (SubString, Data, StartPosition);
         BackwardIndex := BackwardPos (SubString, Data, StartPosition);
         { Return the position to the closest found substring }
         if StartPosition-ForwardIndex >= BackwardIndex-StartPosition then
            SearchPos := ForwardIndex else SearchPos := BackwardIndex;
    end;

    { Returns the position of a character closests to a certain position }
    function StringSearchPos (SubString, Data : string; StartPosition : byte) : byte;
    begin
         StringSearchPos := SearchPos (SubString, Data, StartPosition);
    end;

    { Returns the position of a numbered substring in a string (for example,
      if Count is set to two, the position of the second location of the substring
      is returned). }
    function CountPos (var SubString, Data : string; Count : byte) : byte;
    var Index : integer; Position : byte;
    begin
         Position := 0; { Reset search position }
         for Index := 1 to Count do
             Position := ForwardPos (SubString, Data, Succ(Position));
         CountPos := Position; { Zero if not found }
    end;

    { Returns the position of a numbered substring in a string (for example,
      if Count is set to two, the position of the second location of the substring
      is returned). }
    function StringCountPos (SubString, Data : string; Count : byte) : byte;
    begin
         StringCountPos := CountPos (SubString, Data, Count);
    end;

    { Returns the number of occurrences of a substring inside a string }
    function Occurrence (var SubString, Data : string) : byte;
    var Count, Position : integer;
    begin
         { Reset position and counter }
         Position := 0; Count    := 0;
         { Search for substring and go forward if one is found }
         repeat
               Position := ForwardPos (SubString, Data, Succ(Position));
               if Position <> 0 then Inc (Count);
         until (Position = 0);
         Occurrence := Count; { Return number of occurrences }
    end;

    { Returns the number of occurrences of a substring inside a string }
    function StringOccurrence (SubString, Data : string) : byte;
    begin
         StringOccurrence := Occurrence (SubString, Data);
    end;

    { Returns TRUE if substring is found inside string }
    function IsInString (SubString : string; Data : string) : boolean;
    begin
         IsInString := (Pos (SubString, Data) <> 0);
    end;

    { Returns TRUE if any character in specified set is found inside string }
    function IsCharactersInString (Chars : tCharSet; Data : string) : boolean;
    var Index : integer;
    begin
         IsCharactersInString := FALSE; { Assume that no character is found }
         for Index := 1 to Length(Data) do
             if Data[Index] in Chars then begin
                { Character in set found - break }
                IsCharactersInString := TRUE;
                Exit;
             end;
    end;

    { Replaces a sub-string in a string with another sub-string }
    function Replace (var Data, SubString1, SubString2 : string) : string;
    var Index, Position : integer; TempString : string;
    begin
         { Reset index variable and clear temporary string }
         Index := 0; TempString := '';
         while Index < Length(Data) do begin
               Inc (Index); { Go forward one step }
               Position := ForwardPos (SubString1, Data, Index);
               { Copy data if not search string found }
               if Index <> Position then TempString := TempString + Data[Index]
                  else begin
                       { Replace SubString1 with SubString2 }
                       TempString := TempString + SubString2;
                       Index := Position + Pred(Length (SubString1));
                  end;
         end;

         Replace := TempString; { Return replaced string }
    end;

    { Replaces a sub-string in a string with another sub-string }
    function StringReplace (Data, SubString1, SubString2 : string) : string;
    begin
         StringReplace := Replace (Data, SubString1, SubString2);
    end;

    { Generates a string filled with specified number of copies of the
      specified substring. }
    procedure Fill (var Data : string; Count : byte; SubString : string);
    var Index : byte;
    begin
         Data := ''; { Clear data string }
         if Length(SubString) = 1 then begin
            { Use memory filling if data is a character }
            if Count > 0 then FillChar (Data[1], Count, Ord(SubString[1]));
            Data[0] := Chr(Count); { Set string length }
         end else for Index := 1 to Count do Data := Data + SubString;
    end;

    { Generates a string filled with specified number of copies of the
      specified substring. }
    function StringFill (Count : byte; SubString : string) : string;
    var TempString : string;
    begin
         { Avoid overlap of filling - use temporary string for filling }
         Fill (TempString, Count, SubString);
         StringFill := TempString;
    end;

    { Generates a string containing specified number of blank spaces }
    function StringSpace (Count : byte) : string;
    begin
         StringSpace := StringFill (Count, #32);
    end;

    { Removes all leading characters in string }
    procedure StringRemoveLead (var Data : string; Character : char);
    var Length : byte absolute Data;
    begin
         { Delete all leading characters }
         while (Data[1] = Character) and (Length > 1) do Delete (Data, 1, 1);
    end;

    { Removes all trailing characters in string }
    procedure StringRemoveTrail (var Data : string; Character : char);
    var Length : byte absolute Data;
    begin
         { Delete all trailing characters }
         while (Data[Length] = Character) and (Length > 1) do Dec (Length);
    end;

    { Removes blank spaces before and after text inside a string }
    function StringStripped (Data : string) : string;
    begin
         { Delete all leading and trailing spaces }
         StringRemoveLead (Data, #32);
         StringRemoveTrail (Data, #32);
         { Return stripped string }
         StringStripped := Data;
    end;

    { Removes leading and trailing zeroes from a text string }
    function StringZeroStripped (Data : string) : string;
    begin
         { Delete all leading and trailing zeroes }
         StringRemoveLead (Data, '0');
         StringRemoveTrail (Data, '0');
         { Remove comma signs or add one leading zero if comma first in string }
         if (Data[Length(Data)] = '.') then Delete (Data, Length(Data), 1); { Delete last character }
         if (Data[1] = '.') then Data := '0' + Data;
         StringZeroStripped := Data;
    end;

    { Centers text inside a string }
    function StringCentered (Data : string) : string;
    var FixSpace, StrippedStr : string; StartLength : byte;
    begin
         StrippedStr := StringStripped(Data); { Removes leading and trailing spaces }
         { Calculate number of spaces available for centering }
         FixSpace    := StringSpace((Length(Data) - Length(StrippedStr)) div 2);
         StartLength := Length(Data);
         Data        := FixSpace + StrippedStr + FixSpace;
         if Length(Data) <  StartLength then Data := Chr(32) + Data;
         StringCentered := Data;
    end;

    { Fixes the length of a string by inserting spaces or removing characters }
    function StringFixed (Data : string; FixedLength : byte) : string;
    var Length : byte absolute Data;
    begin
         if (Data <> '') then Data := Copy (Data, 1, FixedLength);
         while (Length < FixedLength) do Insert (#32, Data, Succ(Length));
         StringFixed := Data;
    end;

    { Centers and fixes the length of a string }
    function StringFixedCentered (Data : string; FixedLength : byte) : string;
    begin
         StringFixedCentered := StringCentered(StringFixed(Data, FixedLength));
    end;

    { Right justifies and fixes the length of a string }
    function StringFixedRight (Data : string; FixedLength : byte) : string;
    begin
         if FixedLength >= Length(Data) then
            StringFixedRight := StringSpace (FixedLength - Length(Data)) + Data
         else StringFixedRight := StringFixed (Data, FixedLength);
    end;

    { Inserts one blank space between each character inside string }
    function StringDoubled (Data : string) : string;
    var Index : byte; TempString : string;
    begin
         TempString := '';
         for Index := 1 to Length(Data) do TempString := TempString + Data[Index] + #32;
         StringDoubled := Copy (TempString, 1, Pred(Length(TempString)));
    end;

    end. { unit }

    { (C) Johan Larsson, 1992 - 1997. Donated to the public domain. No warranty. }

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