Criando um tipo de dado Avançado em Delphi - Parte 2

No post anterior você conferiu como podemos usar o record do pascal apartir do Delphi 2006 para criar um tipo de dado mais avançado, que nos permitia agrupar as principais operações com string em um único tipo.
Agora vamos dar sequência ao artigo adicionando novas operações para o nosso dado:

TEAMString = record
    Text: string;

     { Substituição}
    function ReplaceChar(Caracter, Subst: char): string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

    {Conversão}
    function Lower: string;
    function Upper: string;
    function CaixaMista: string;

    {Pesquisa um caractere }
    function SearchLeft(Caracter: string): integer;
    function SearchRigth(Caracter: string): integer;

    {Variaveis}
    function Count: integer;
    function IsEmpty: Boolean;
    function Wordcount: integer;

    {Operações}
    function QuebraString(APosicao: Integer; ASeparador: string): string;
    function ReverseStr: string;
    function ToFloat: Double;
    function ToDateTime: TDateTime;
    function ToPChar: PChar;
    function ToFloatExtended: Extended;
    function ToCurrency: Currency;
    function ToCurrencyString: string;
    function ToInt: Integer;
    function ToCNPJCpf: string;
    function ToAspas: string;
    function ToCustomFormat(Mask: string): string;
    function Empty: string;

    function RemoveAcento: string;
    function RemoveChar(Caracter: char): string;
    function ReplicaChar(const Ch: Char; const Len: integer): string;
    function StrIntComZero(const Value, Len: integer): string;
    function Explode(const Ch: Char): TStringList;
    function ExplodeTrim(const Ch: Char): TStringList;
    function ExisteInt: Boolean;
    procedure StrResetLength(var S: AnsiString);
    function SubString(PosInicial, PosFinal: Integer): string;
    procedure Concate(Separador, Valor: string);
    procedure DeleteFinalText(Tam: Integer);
    function HashMD5: string;
    procedure ADD(s: string);
    procedure Clear;
    function ContemString(s: string): Boolean;
    procedure SetTextLength(Tam: integer);
    procedure ADDQuote(Separador, valor,Quote : string);

    function IsNumeric: Boolean;
    function IsFloat: Boolean;
    function IsInteger: Boolean;
    function IsDateTime: Boolean;

    { Operações PAD}
    function PadC(const Len: integer; const Ch: Char): string;
    function PadL(const Len: integer; const Ch: Char): string;
    function PadR(const Len: integer; const Ch: Char): string;

  end;

Repare que na nossa listagem temos funções para os mais variados fins, deste funções simples como apagar o conteúdo da string até uma função hash MD5 pronta pra ser usada.  Dessa forma agrupamos as operações com string em um só lugar, organizando melhor o nosso código e deixando-o muito mais legível!

Vamos a implementação dos métodos:

unit untTEAMString;

unit untTEAMString;

interface
   uses Classes,SysUtils, IdGlobal, IdHash, IdHashMessageDigest;
type
  TEAMString = record
    Text: string;

     { Substituição}
    function ReplaceChar(Caracter, Subst: char): string;

    {Remove os Espaços em branco }
    function Alltrim: string;
    function LTrim: string;
    function RTrim: string;

    {Conversão}
    function Lower: string;
    function Upper: string;
    function CaixaMista: string;

    {Pesquisa um caractere }
    function SearchLeft(Caracter: string): integer;
    function SearchRigth(Caracter: string): integer;

    {Variaveis}
    function Count: integer;
    function IsEmpty: Boolean;
    function Wordcount: integer;

    {Operações}
    function QuebraString(APosicao: Integer; ASeparador: string): string;
    function ReverseStr: string;
    function ToFloat: Double;
    function ToDateTime: TDateTime;
    function ToPChar: PChar;
    function ToFloatExtended: Extended;
    function ToCurrency: Currency;
    function ToCurrencyString: string;
    function ToInt: Integer;
    function ToCNPJCpf: string;
    function ToAspas: string;
    function ToCustomFormat(Mask: string): string;
    function Empty: string;

    function RemoveAcento: string;
    function RemoveChar(Caracter: char): string;
    function ReplicaChar(const Ch: Char; const Len: integer): string;
    function StrIntComZero(const Value, Len: integer): string;
    function Explode(const Ch: Char): TStringList;
    function ExplodeTrim(const Ch: Char): TStringList;
    function ExisteInt: Boolean;
    function SubString(PosInicial, PosFinal: Integer): string;
    procedure Concate(Separador, Valor: string);
    procedure DeleteFinalText(Tam: Integer);
    function HashMD5: string;
    procedure ADD(s: string);
    procedure Clear;
    function ContemString(s: string): Boolean;
    procedure SetTextLength(Tam: integer);
    procedure ADDQuote(Separador, valor,Quote : string);

    function IsNumeric: Boolean;
    function IsFloat: Boolean;
    function IsInteger: Boolean;
    function IsDateTime: Boolean;

    { Operações PAD}
    function PadC(const Len: integer; const Ch: Char): string;
    function PadL(const Len: integer; const Ch: Char): string;
    function PadR(const Len: integer; const Ch: Char): string;
  end;


{ TEAMString }

{$ENDREGION}


implementation



{$REGION 'TEAMString'}

{ TEAMString }


function TEAMString.SubString(PosInicial, PosFinal: Integer): string;
begin
  Result := Copy(Self.Text, PosInicial, PosFinal - PosInicial);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Concate
  Arguments: Separador, Valor: string
  Result:    None
  Objetivo:  Concatenar uma valor passado a string separado por um caracter
-------------------------------------------------------------------------------}

procedure TEAMString.Concate(Separador, Valor: string);
begin
  if Self.Text = '' then
    Self.Text := Self.Text + Valor
  else
    Self.Text := Self.Text + Separador + Valor;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ContemString
  Arguments: s: string
  Result:    Boolean
  Objetivo:  verifica se existe uma substring
-------------------------------------------------------------------------------}

function TEAMString.ContemString(s: string): Boolean;
begin
  Result := (Pos(s, Self.Text) > 0);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Count
  Arguments: None
  Result:    integer
  Objetivo:  Retornar o tamanho da string
-------------------------------------------------------------------------------}

function TEAMString.Count: integer;
begin
  Result := Length(Self.Text);
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.DeleteFinalText
  Arguments: Tam: Integer
  Result:    None
  Objetivo:  Apagar a ultima posicao da string
-------------------------------------------------------------------------------}
procedure TEAMString.DeleteFinalText(Tam: Integer);
begin
  Delete(Self.Text, (self.Count - Tam) + 1, Tam);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.CaixaMista
  Arguments: None
  Result:    None
  Objetivo:  Transforma a primeira letra dos nomes em Maiúscula
-------------------------------------------------------------------------------}

function TEAMString.CaixaMista: string;
var
  tam, pos1, pos2: integer;
  stPal, stTmp, stAux: string;
begin
  stAux := Self.Text;
  tam := Length(stAux);
  stAux := TrimRight(stAux) + ' ';
  stAux := AnsiUpperCase(stAux);
  while True do
  begin
    pos1 := POS(' ', stAux);
    if pos1 = 0 then
      break;
    stPal := Copy(stAux, 1, pos1);
    pos2 := pos(stPal, ' DA - DAS - DE - DO - DOS ');
    if pos2 > 0 then
      stPal := AnsiLowerCase(stPal)
    else
      stPal := Copy(stPal, 1, 1) + AnsiLowerCase(Copy(stPal, 2, tam));
    stTmp := stTmp + stPal;
    stAux := copy(stAux, pos1 + 1, tam)
  end;
  Result := stTmp;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.Clear
  Arguments: None
  Result:    None
  Objetivo:  Apagar o conteudo da string
-------------------------------------------------------------------------------}
procedure TEAMString.Clear;
begin
  Self.Text := '';
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCNPJ
  Arguments: None
  Result:    string
  Objetivo:  formata Cpf/Cnpj sem q o usuario tenha q digitar os pontos, traços e barra
-------------------------------------------------------------------------------}

function TEAMString.ToCNPJCpf: string;
var
  vTam, xx: Integer;
  vDoc: string;
begin
  vTam := Length(Self.Text);
  for xx := 1 to vTam do
    if (Copy(Self.Text, xx, 1) <> '.') and (Copy(Self.Text, xx, 1) <> '-') and (Copy(Self.Text, xx, 1) <> '/') then
      vDoc := vDoc + Copy(Self.Text, xx, 1);
  Self.Text := vDoc;
  vTam := Length(Self.Text);
  vDoc := '';
  vDoc := '';
  for xx := 1 to vTam do
  begin
    vDoc := vDoc + Copy(Self.Text, xx, 1);
    if vTam = 11 then
    begin
      if (xx in [3, 6]) then
        vDoc := vDoc + '.';
      if xx = 9 then
        vDoc := vDoc + '-';
    end;
    if vTam = 14 then
    begin
      if (xx in [2, 5]) then
        vDoc := vDoc + '.';
      if xx = 8 then
        vDoc := vDoc + '/';
      if xx = 12 then
        vDoc := vDoc + '-';
    end;
  end;
  Result := vDoc;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.Empty
  Arguments: None
  Result:    string
  Objetivo:  Retornar uma string Vazia
-------------------------------------------------------------------------------}
function TEAMString.Empty: string;
begin
  result := '';
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ExisteInt
  Arguments: None
  Result:    Boolean
  Objetivo:  Testar se na string existe um numero inteiro valido ou não
-------------------------------------------------------------------------------}

function TEAMString.ExisteInt: Boolean;
begin
  try
    StrToInt(Text);
    Result := True;
  except
    Result := False;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Explode
  Arguments: const Ch: Char
  Result:    TStringList
  Objetivo:   Explodir a string em uma TStringList de acordo com o carater separador
-------------------------------------------------------------------------------}

function TEAMString.Explode(const Ch: Char): TStringList;
var
  c: word;
  Source: string;
begin
  Result := TStringList.Create;
  c := 0;

  Source := Self.Text;
  while source <> '' do
  begin
    if Pos(CH, source) > 0 then
    begin
      Result.Add(Copy(Source, 1, Pos(CH, source) - 1));
      Delete(Source, 1, Length(Result[c]) + Length(CH));
    end
    else
    begin
      Result.Add(Source);
      Source := '';
    end;
    inc(c);
  end;
end;
 {-------------------------------------------------------------------------------
  Procedure: TEAMString.Explode
  Arguments: const Ch: Char
  Result:    TStringList
  Objetivo:  Explodir a string em uma TStringList de acordo com o carater separador
  removendo os espaços em branco
-------------------------------------------------------------------------------}

function TEAMString.ExplodeTrim(const Ch: Char): TStringList;
var
  I: Integer;
begin
  Result := Self.Explode(ch);

  for I := 0 to Result.Count - 1 do
  begin
    Result.Strings[i] := Trim(Result.Strings[i]);
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsDateTime
  Arguments: self.value: string
  Result:    Boolean
  Objetivo:  Verificar se a string é do tipo DateTime
-------------------------------------------------------------------------------}

function TEAMString.IsDateTime: Boolean;
var
  i: Integer;
begin
  if (self.Text = '') then
  begin
    Result := False;
    Exit;
  end;

  Result := True;

  for i := 1 to Length(self.Text) do
    if not (self.Text[i] in ['0'..'9', DateSeparator]) then
    begin
      Result := False;
      Break;
    end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsEmpty
  Arguments: inString: string
  Result:    Boolean
  Objetivo:  Verificar se a string está vazia
-------------------------------------------------------------------------------}

function TEAMString.IsEmpty: Boolean;
begin
  Result := (self.Text = '');
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsFloat
  Arguments: None
  Result:    Boolean
  Objetivo:  Verificar se a string é um float
-------------------------------------------------------------------------------}

function TEAMString.IsFloat: Boolean;
var
  Value: Extended;
begin
  Result := TextToFloat(Self.ToPChar, Value, fvExtended);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsInteger
  Arguments:
  Result:    Boolean
  Objetivo:  Verificar se a string é um inteiro
-------------------------------------------------------------------------------}

function TEAMString.IsInteger(): Boolean;
begin
  if (Pos('.', Self.Text) > 0) or not IsNumeric then
  begin
    Result := False;
    Exit;
  end;

  try
    StrToInt(Self.Text);
    Result := True;
  except
    Result := False;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.IsNumeric
  Arguments: None
  Result:    Boolean
  Objetivo:  Verificar se a string contem caracteres numericos
-------------------------------------------------------------------------------}

function TEAMString.IsNumeric: Boolean;
var
  i: Integer;
begin
  if (Self.Text = '') then
  begin
    Result := False;
    Exit;
  end;

  Result := True;

  for i := 1 to Length(Self.Text) do
    if not (self.Text[i] in ['0'..'9', '.', ',']) then
    begin
      Result := False;
      Break;
    end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Lowercase_S
  Arguments: None
  Result:    None
  Objetivo:  Converter a string para minusculo
-------------------------------------------------------------------------------}

function TEAMString.Lower: string;
begin
  Result := LowerCase(self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.LTrim
  Arguments: None
  Result:    None
  Objetivo:  Remove os Espaços em branco à esquerda da string
-------------------------------------------------------------------------------}

function TEAMString.LTrim: string;
var
  I: Integer;
begin
  I := 0;
  while True do
  begin
    inc(I);
    if I > length(self.Text) then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, I, length(self.Text));
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.MD5
 11/2/2011
  Arguments: None
  Result:    string
  Objetivo:  Retorna o Md5 da string
-------------------------------------------------------------------------------}

function TEAMString.HashMD5: string;
begin
  with TIdHashMessageDigest5.Create do
    try
      Result := TIdHash128.AsHex(HashValue(Self.Text));
    finally
      Free;
    end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.QuebraString
  Arguments: APosicao: Integer; ASeparador: string
  Result:    string
  Objetivo:  Retornar o que está após o separador
-------------------------------------------------------------------------------}

function TEAMString.QuebraString(APosicao: Integer; ASeparador: string): string;
var
  i, cont: integer;
begin
  cont := 0;
  if (APosicao <= 0) then
    exit;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = ASeparador then
    begin
      inc(cont);
    end;
    if cont = APosicao then
    begin
      Result := self.Text[i];
    end;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.RemoveAcento
  Arguments: None
  Result:    None
  Objetivo:  Remover os acentos da string
-------------------------------------------------------------------------------}

function TEAMString.RemoveAcento: string;
const
  ComAcento = 'àâêôûãõáéíóúçüÀÂÊÔÛÃÕÁÉÍÓÚÇÜ';
  SemAcento = 'aaeouaoaeioucuAAEOUAOAEIOUCU';
var
  x: Integer;
begin

  Result := Self.Text;
  for x := 1 to Length(Self.Text) do
  begin
    if Pos(Self.Text[x], ComAcento) <> 0 then
      Result[x] := SemAcento[Pos(Text[x], ComAcento)]
  end;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.RemoveChar
  Arguments: Caracter: char
  Result:    string
  Objetivo:  Remove o caracter passado da string
-------------------------------------------------------------------------------}
function TEAMString.RemoveChar(Caracter: char): string;
var
  i: integer;
begin
  Result := '';
  for i := 1 to length(self.Text) do
  begin
    if self.Text[i] <> Caracter then
    begin
      Result := Result + Self.Text[i];
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReplaceChar
  Arguments: Caracter, Subst: char
  Result:    None
  Objetivo:  Substiuir um caracter  dentro da string
-------------------------------------------------------------------------------}

function TEAMString.ReplaceChar(Caracter, Subst: char): string;
var
  i: integer;
begin
  Result := Self.Text;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = Caracter then
    begin
      Result[i] := Subst;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReplChar
  Arguments: const Ch: Char; const Len: integer
  Result:    string
  Objetivo:  Replica um caractere n vezes formando uma string
-------------------------------------------------------------------------------}

function TEAMString.ReplicaChar(const Ch: Char; const Len: integer): string;
var
  I: integer;
begin
  SetLength(Result, Len);
  for I := 1 to Len do
    Result[I] := Ch;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ReverseStr
  Arguments: None
  Result:    string
  Objetivo:  Retornar o inverso da string
-------------------------------------------------------------------------------}

function TEAMString.ReverseStr: string;
var
  I: Integer;
begin
  Result := '';
  for I := Length(self.Text) downto 1 do
    Result := Result + self.Text[I];
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.RTrim
  Arguments: None
  Result:    None
  Objetivo:  Remover os espaços em branco a direita da string
-------------------------------------------------------------------------------}

function TEAMString.RTrim: string;
var
  I: Integer;
begin
  I := length(self.Text) + 1;
  while True do
  begin
    Dec(I);
    if I <= 0 then
      break;
    if self.Text[I] <> #32 then
      break;
  end;
  Result := Copy(self.Text, 1, I);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.SearchLeft
  Arguments: Caracter: string; PosInicial: integer
  Result:    integer
  Objetivo:  Pesquisa um caractere à esquerda da string, retornando sua posição
-------------------------------------------------------------------------------}

function TEAMString.SearchLeft(Caracter: string): integer;
var
  i: integer;
begin
  result := -1;
  for i := 0 to length(self.Text) do
  begin
    if self.Text[i] = Caracter then
    begin
      Result := i;
      exit;
    end;
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.SearchRigth
  Arguments: Caracter: string; PosInicial: integer
  Result:    integer
  Objetivo:  Pesquisa um caractere à direita da string, retornando sua posição
-------------------------------------------------------------------------------}

function TEAMString.SearchRigth(Caracter: string): integer;
var
  i: integer;
begin
  result := -1;
  for i := length(self.Text) downto 0 do
  begin
    if self.Text[i] = Caracter then
    begin
      Result := i;
      exit;
    end;
  end;
end;

procedure TEAMString.SetTextLength(Tam: integer);
begin
  Self.Text := StringOfChar(' ', Tam);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.StrIntComZero
  Arguments: const Value, Len: integer
  Result:    string
  Objetivo:  Forma um número inteiro com zeros à esquerda
-------------------------------------------------------------------------------}

function TEAMString.StrIntComZero(const Value, Len: integer): string;
var
  I: integer;
begin
  Result := IntToStr(Value);
  I := Length(Result);
  if I < Len then
    Result := Self.ReplicaChar('0', Len - I) + Result
  else if I > Len then
    Result := ReplicaChar('*', Len);

end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToAspas
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: None
  Result:    string
  Objetivo:  Retornar uma string com aspas
-------------------------------------------------------------------------------}
function TEAMString.ToAspas: string;
begin
  Result := QuotedStr(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCurrency

  DateTime:  10/6/2010
  Arguments: None
  Result:    Currency
  Objetivo:  Converter para Currency
-------------------------------------------------------------------------------}

function TEAMString.ToCurrency: Currency;
begin
  Result := StrToCurr(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCurrencyString
  Arguments: None
  Result:    string
  Objetivo:  Formatar um valor double em monetário
-------------------------------------------------------------------------------}

function TEAMString.ToCurrencyString: string;
begin
  Result := 'R$ ' + FormatCurr('0.,00', Self.ToCurrency);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToCustomFormat
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: Mask: string
  Result:    string
  Objetivo:  Mascara customizada
-------------------------------------------------------------------------------}
function TEAMString.ToCustomFormat(Mask: string): string;
begin
  result := Format(Mask, [Self.Text])
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToDateTime
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: None
  Result:    TDateTime
  Objetivo:  Converte para DataHora
-------------------------------------------------------------------------------}
function TEAMString.ToDateTime: TDateTime;
begin
  Result := StrToDateTime(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToFloat
  Arguments: None
  Result:    Extended
  Objetivo:  Filtra uma string qualquer, convertendo as suas partes
  numéricas para sua representação decimal, por exemplo:
  'R$ 1.200,00' para 1200,00 '1AB34TZ' para 134
-------------------------------------------------------------------------------}

function TEAMString.ToFloat: Double;
var
  Aux: string;
begin
  Aux := self.ReplaceChar('.', ',');

  Result := StrToFloat(aux);
end;

function TEAMString.ToFloatExtended: Extended;
var
  i: Integer;
  stAux: string;
  blSeenDecimal, blSeenSgn: Boolean;
begin
  stAux := '';
  blSeenDecimal := False;
  blSeenSgn := False;
  {Percorre os caracteres da string:}
  for i := Length(Self.Text) downto 0 do
    {Filtra a string, aceitando somente números e separador decimal:}
    if (Self.Text[i] in ['0'..'9', '-', '+', DecimalSeparator]) then
    begin
      if (Self.Text[i] = DecimalSeparator) and (not blSeenDecimal) then
      begin
        stAux := Self.Text[i] + stAux;
        blSeenDecimal := True;
      end
      else if (Self.Text[i] in ['+', '-']) and (not blSeenSgn) and (i = 1) then
      begin
        stAux := Self.Text[i] + stAux;
        blSeenSgn := True;
      end
      else if Self.Text[i] in ['0'..'9'] then
      begin
        stAux := Self.Text[i] + stAux;
      end;
    end;
  Result := StrToFloat(stAux);

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToInt

  DateTime:  7/6/2010
  Arguments: None
  Result:    Integer
  Objetivo:  Converter para inteiro
-------------------------------------------------------------------------------}

function TEAMString.ToInt: Integer;
begin
  Result := StrToInt(Self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.ToPChar


  Arguments: None
  Result:    PChar
  Objetivo:  Retornar um ponteiro para char
-------------------------------------------------------------------------------}

function TEAMString.ToPChar: PChar;
{Converte String em Pchar}
type
  TRingIndex = 0..7;
var
  Ring: array[TRingIndex] of PChar;
  RingIndex: TRingIndex;
  Ptr: PChar;
begin
  Ptr := @self.Text[Length(self.Text)];
  Inc(Ptr);
  if Ptr^ = #0 then
  begin
    Result := @self.Text[1];
  end
  else
  begin
    Result := StrAlloc(Length(self.Text) + 1);
    RingIndex := (RingIndex + 1) mod (High(TRingIndex) + 1);
    StrPCopy(Result, self.Text);
    StrDispose(Ring[RingIndex]);
    Ring[RingIndex] := Result;
  end;

end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.Alltrim


  Arguments: None
  Result:    None
  Objetivo:  Remover os espaços em branco a direita e a esquerda da string
-------------------------------------------------------------------------------}

procedure TEAMString.ADD(s: string);
begin
  Self.Text := Self.Text + s;
end;


{-------------------------------------------------------------------------------
  Procedure: TEAMString.ADDQuote
  Author:    Evaldo
  DateTime:  04/08/2011
  Arguments: Separador, valor,Quote:string
  Result:    None
  Objetivo:  Retorna uma string com um separador e um Quote
-------------------------------------------------------------------------------}
procedure TEAMString.ADDQuote(Separador,  valor,Quote:string);
begin
  if Self.IsEmpty then
    Self.Text := Self.Text + Quote + valor + Quote
  else
    Self.Text := Self.Text + Separador + Quote + valor + Quote;
end;
{-------------------------------------------------------------------------------
  Procedure: TEAMString.Alltrim
  Arguments: None
  Result:    string
  Objetivo:  Remove os espaços em Branco de uma string
-------------------------------------------------------------------------------}
function TEAMString.Alltrim: string;
begin
  Result := Trim(Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.UpperCase_s
  Arguments: None
  Result:    None
  Objetivo:  Converter a string para maiúsculo
-------------------------------------------------------------------------------}

function TEAMString.Upper: string;
begin
  Result := UpperCase(self.Text);
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.wordcount
  Arguments: None
  Result:    integer
  Objetivo:  Retorna o número de palavras que contem em uma string
-------------------------------------------------------------------------------}

function TEAMString.Wordcount: integer;
var
  i: integer;
  len: integer;
begin
  len := length(Self.Text);
  Result := 0;
  i := 1;
  while i <= len do
  begin
    while ((i <= len) and ((Self.Text[i] = #32) or (Self.Text[i] = #9) or
      (Self.Text[i] = ';'))) do
      inc(i);
    if i <= len then
      inc(Result);
    while ((i <= len) and ((Self.Text[i] <> #32) and (Self.Text[i] <> #9) and
      (Self.Text[i] <>
      ';'))) do
      inc(i);
  end;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadC
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a esquerda e a direita da string
  de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadC(const Len: integer; const Ch: Char): string;
var
  I, J: integer;
  Pad: string;
  Impar: boolean;
begin
  I := Length(self.Text);
  if I < Len then
  begin
    J := Len - I;
    Impar := J mod 2 = 1;
    J := J div 2;
    Pad := self.ReplicaChar(Ch, J);
    Result := Pad + Self.Text + Pad;
    if Impar then
      Result := Result + Ch;
  end
  else if I > Len then
  begin
    J := I - Len;
    Impar := J mod 2 = 1;
    J := J div 2;
    Result := Self.Text;
    Delete(Result, I - J + 1, J);
    Delete(Result, 1, J);
    if Impar then
    begin
      Dec(I, J * 2);
      Delete(Result, I, 1);
    end;
  end
  else
    Result := Self.Text;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadL
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a esquerda da string de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadL(const Len: integer; const Ch: Char): string;
var
  LenS: integer;
begin
  LenS := Length(Self.Text);
  if LenS < Len then
    Result := self.ReplicaChar(Ch, Len - LenS) + self.Text
  else if LenS > Len then
    Result := Copy(self.Text, LenS - Len + 1, Len)
  else
    Result := self.Text;
end;

{-------------------------------------------------------------------------------
  Procedure: TEAMString.PadR
  Arguments: const Len: integer; const Ch: Char
  Result:    string
  Objetivo:  Completa a string com caracter passado a direita da string de acordo com o tamanho indicado
-------------------------------------------------------------------------------}

function TEAMString.PadR(const Len: integer; const Ch: Char): string;
var
  LenS: integer;
begin
  LenS := Length(self.Text);
  if LenS < Len then
    Result := self.Text + self.ReplicaChar(Ch, Len - LenS)
  else if LenS > Len then
    Result := Copy(self.Text, 1, Len)
  else
    Result := self.Text;
end;

{$ENDREGION}

end. 

Adicione alguns edits para o formulário de teste como abaixo:

 Adicione o seguinte código no onCLick do botão "ok" :

procedure TForm1.btn1Click(Sender: TObject);
var
  EAMString:TEAMString;
begin
  EAMString.Text := ' Teste ';

  edtTexto.Text := EAMString.Text;
  edtTrimALL.Text := EAMString.Alltrim;
  edtTrimL.Text := EAMString.LTrim;
  edtTrimR.Text := EAMString.RTrim;
  edtHash.Text := EAMString.HashMD5;
  edtPADL.Text := EAMString.PadL(10,'0');
  edtReverseStr.Text := EAMString.ReverseStr;
  edtToAspas.Text := EAMString.ToAspas;
end;

Execute a aplicação e observe o resultado:

Todos os métodos da listagem foram documentados para facilitar o entendimento da sua finalidade. Fique a vontade para adicionar novos métodos e procedures. :)

Confira aqui o próximo post

Observação: Algumas das procedure e functions usadas neste artigo são uma compilação de códigos encontrados na internet. se você econtrar aqui algum código de sua autoria, entre em contato para que possamos dar-lhe o devido crédito.