strings1.pas

此控件可将数据表转换成多种格式:文本,HTML,RTF

{
**************
*  STRINGS1  *
**************

collection of string methods & utils

======================================
First Name   : Strings.PAS 
Second Name  : Strings1.PAS
Version      : No Version
Created      : May be 1990 or 1992
Place        : TSE "A.S.Popov", Sofia
Pascal       : Turbo Pascal 5.5
Banner Added : 10.1997
======================================

Copyright (c) 199? - 1997 By MAD Software

Telephone: Bulgaria, Sofia, 37-06-23
E_Mail:    [e-mail]
           [e-mail]
Web:       Http:\\WWW.NSI.BG\NMMM\Home.Htm

}

Unit
   Strings1;

INTERFACE

Type TString = String[100];

Function Left_Str       (S:String;I:byte):String;
Function Right_Str      (S:String;I:byte):String;

Function Up_Case        (S:String):String;

Function Left_Format    (S:String;L:Byte):String;
Function Right_Format   (S:String;L:Byte):String;

Function Center_Str     (S:String;L:Byte):String;

Function Spc_Str        (L:Byte):String;
Function Copy_Char      (C:Char;L:Byte):String;
Function Out_Char       (S:String;C:Char):String;

Procedure Out_More_Spc   (Var S:String);

Function Comp_Str       (S1,S2:String):Boolean;

Function ExtractMacro   (Var S:String;Ch1:String;Ch2:Char):String;
Function ExtractMacro1  (Var Source:String;Ch1:String;Ch2:Char;Var Macro:String;Var P:Byte):Boolean;
Function ExistMacro     (Var S:String;M:String):Boolean;
Procedure ChangeMacro    (Var S:String;M,N:String);

IMPLEMENTATION

Var
   I : Byte;

Function
   Right_Str(S:String;I:Byte):String;
   Begin
      If I=0
         Then
            Begin
               Right_str:='';
               Exit;
            End;
      Right_Str:=Copy(S,Length(S)-I+1,I);
   End;

Function
   Left_Str(S:String;I:Byte):String;
   Begin
      If I=0
         Then
            Begin
               Left_Str:='';
               Exit;
            End;
      Left_Str:=Copy(S,1,I);
   End;

Function
   Up_Case(S:String):String;
   Begin
      For I:=1 To Length(S) Do
         S[I]:=UpCase(S[I]);
      Up_Case:=S;
   End;

Function
   Left_Format(S:String;L:Byte):String;
   Begin
      If Length(S)>L
         Then
            S:=Left_Str(S,L);

      If Length(S)<L
         Then
            Repeat
               S:=S+' ';
            Until Length(S)=L;
      Left_Format:=S;
   End;

Function
   Right_Format(S:String;L:Byte):String;
   Begin
      If Length(S)>L
         Then
            S:=Left_Str(S,L);
      If Length(S)<L
         Then
            Repeat
               S:=' '+S;
            Until Length(S)=L;
      Right_Format:=S;
   End;

Function Center_Str(S:String;L:Byte):String;
   Begin
      Repeat
         S:=' ' + S + ' ';
      Until L<=Length(S);
      S:=Left_Str(S,L);
      Center_Str:=S;
   End;

Function
   Spc_Str(L:Byte):String;
   Var
      S : String;
   Begin
      S:='';
      If L = 0
         Then
            Begin
               Spc_Str:=S;
               Exit;
            End;
      For I:=1 To L Do
         S:=S + ' ';
      Spc_Str:=S;
   End;

Function Copy_Char     (C:Char;L:Byte):String;
   Var
      S : String;
   Begin
      S:='';
      If L=0
         Then
            Begin
               Copy_Char:=S;
               Exit;
            End;
      For I:=1 To L Do
         S:=S + C;
      Copy_Char:=S;
   End;

Function Out_Char      (S:String;C:Char):String;
   Var
      S1 : String;
      I  : Byte;
   Begin
      S1:='';
      If Length(S) > 0
         Then
            For I:=1 To Length(S) Do
               If S[I] <> C
                  Then
                     S1:=S1 + S[I];
      Out_Char:=S1;
   End;

Function Comp_Str      (S1,S2:String):Boolean;
   Begin
      If S1 = ''
         Then
            Begin
               Comp_Str:=True;
               Exit;
            End;

      If Pos(S1,S2) = 1
         Then
            Comp_Str:=True
         Else
            Comp_Str:=False;
   End;

Function ExtractMacro(Var S:String;Ch1:String;Ch2:Char):String;
   Var P   : Byte;
       Em  : String;
   Begin
      Ch1:=Up_Case(Ch1);
      Ch2:=UpCase(Ch2);

      P:=Pos(Ch1,Up_Case(S) );
      If P = 0 Then
         ExtractMacro:=''
      Else
         Begin
            Delete(S,P,Length(Ch1));
            Em:='';
            While (P <= Length(S)     ) And
                  (UpCase(S[P]) <> Ch2) Do
               Begin
                  Em:=Em + UpCase(S[P]);
                  Delete(S,P,1);
               End;
            Delete(S,P,1);

            ExtractMacro:=Em;
         End;
   End;

Function ExtractMacro1(Var Source:String;Ch1:String;Ch2:Char;Var Macro:String;Var P:Byte):Boolean;
   Begin
      Ch1:=Up_Case(Ch1);
      Ch2:=UpCase(Ch2);

      If Pos(Ch1,Up_Case(Source)) = 0 Then
         ExtractMacro1:=False
      Else
         Begin
            ExtractMacro1:=True;
            Macro:='';
            P:=Pos(Ch1,Up_Case(Source));
            Delete(Source,P,Length(Ch1));

            While (P <= Length(Source)     ) And
                  (UpCase(Source[P]) <> Ch2) Do
               Begin
                  Macro:=Macro + UpCase(Source[P]);
                  Delete(Source,P,1);
               End;
            Delete(Source,P,1);
         End;
   End;

Function ExistMacro(Var S:String;M:String):Boolean;
   Begin
      M:=Up_Case(M);
      If Pos(M,Up_Case(S)) <> 0 Then
         Begin
            Delete(S,Pos(M,Up_Case(S)),Length(M));
            ExistMacro:=True;
         End
      Else
         ExistMacro:=False;
   End;

Procedure Out_More_Spc   (Var S:String);
   Begin
      While Pos('  ',S) <> 0 Do
         Delete(S,Pos('  ',S),1);

      While Pos(' ' + #9 ,S) <> 0 Do
         Delete(S,Pos(' ' + #9,S),1);

      While Pos(#9 + ' ',S) <> 0 Do
         Delete(S,Pos(#9 + ' ',S) + 1,1);
   End;

Procedure ChangeMacro    (Var S:String;M,N:String);
   Var S1 : String;
   Begin
      I:=Pos(Up_Case(M),Up_Case(S));
      If I > 0 Then
         Begin
            Delete(S,I,Length(M));
            Insert(N,S,I);
         End;
   End;

BEGIN
END.