FUNCOES: de Clipper para Delphi

[rochinha]

Amiguinhos,

Veja algumas funções do Clipper compatibilizadas para Delphi Pascal:

procedure Commit( DataSet: TDataSet );
begin
  with DataSet do
  begin
    UpdateCursorPos;
    Check( dbiSaveChanges( Handle ) );
    CursorPosChanged;
  end;
end;

function LimpaNumeros( const Dados: string ): string;
var
  Contar: integer;
  Resultado: string;
begin
  Resultado := '';
  for Contar := 1 to Length( Dados ) do
  begin
    if Pos( Copy( Dados, Contar, 1 ) ,'-.0123456789' ) > 0 then
    begin
      if Copy( Dados, Contar, 1 ) = '.' then
        Resultado := Resultado + ','
      else
        Resultado := Resultado + Copy( Dados, Contar, 1 );
    end;
  end;
  if Copy( Resultado, 0, 1 ) = ',' then
    Resultado := '0' + Resultado;
  if Copy( Resultado, Length( Resultado ), 1 ) = ',' then
    Resultado := Resultado + '00';
  Result := Resultado;
end;

function FDateTime( const Mascara: string; Conteudo: TDateTime; Nulo: boolean ): string;
begin
  if Nulo then
    Result := Space( 10 )
  else
    Result := FormatDateTime( Mascara, Conteudo );
end;

function Transform( Conteudo: Extended; const Mascara: string ): string;
var
  TamMascara: integer;
  Brancos: string;
  Dados: string;
begin
  TamMascara := Length( Mascara );
  Dados := FormatFloat( Mascara, Conteudo );
  if TamMascara > Length( Dados ) then
  begin
    Brancos := Space( TamMascara - Length( Dados ) );
    Dados := Brancos + Dados;
  end;
  Transform := Dados;
end;

function Trim( Dados: string ): string;
var
  Contar: integer;
begin
  for Contar := Length( Dados ) downto 1 do
  begin
    if Copy( Dados, Contar, 1 ) <> ' ' then
      Break;
    Dados := Copy( Dados, 1, Contar - 1 );
    Application.ProcessMessages;
  end;
  Trim := Dados;
end;

function AllTrim( Dados: string ): string;
var
  Contar: integer;
begin
  Dados := Trim( Dados );
  for Contar := 1 to Length( Dados ) do
  begin
    if Copy( Dados, Contar, 1 ) <> ' ' then
      Break;
    Dados := Copy( Dados, Contar + 1, Length( Dados ) - 1 );
    Application.ProcessMessages;
  end;
  AllTrim := Dados;
end;

function Empty( Dados: string ): boolean;
begin
  if ( Length( Trim( Dados ) ) = 0 ) or
    ( Trim( Dados ) = '  /  /' ) then
    Empty := True
  else
    Empty := False;
end;

function NotEmpty( Dados: string ): boolean;
begin
  if Empty( Dados ) then
    NotEmpty := False
  else
    NotEmpty := True;
end;

function MMDDAA( Data: string ): string;
var
  sDia: string;
  sMes: string;
  sAno: string;
begin
  sDia := Copy( Data, 1, 2 );
  sMes := Copy( Data, 4, 2 );
  sAno := Copy( Data, 7, 4 );
  if sDia + sMes + sAno = '        ' then
    MMDDAA := ''
  else
    MMDDAA := sMes + '/' + sDia + '/' + sAno;
end;

function UltimoDiaDoMes( MesAno: string ): string;
var
  sMes: string;
  sAno: string;
begin
  sMes := Copy( MesAno, 1, 2 );
  if Length( MesAno ) = 7 then
    sAno := Copy( MesAno, 4, 4 )
  else
    sAno := Copy( MesAno, 4, 2 );
  if Pos( sMes, '01 03 05 07 08 10 12' ) > 0 then
    UltimoDiaDoMes := '31'
  else
    if sMes <> '02' then
      UltimoDiaDoMes := '30'
    else
      if ( StrToInt( sAno ) mod 4 ) = 0 then
        UltimoDiaDoMes := '29'
      else
        UltimoDiaDoMes := '28';
end;

function DiaMes( Data: TDateTime ): string;
begin
  Result := Dia(Data) + '/' + Mes(Data)
end;

function Dia( Data: TDateTime ): string;
var
  sAno, sMes, sDia: Word;
begin
  DecodeDate( Data, sAno, sMes, sDia );
  Dia := StrZero( sDia, 2 );
end;

function Mes( Data: TDateTime ): string;
var
  sAno, sMes, sDia: Word;
begin
  DecodeDate( Data, sAno, sMes, sDia );
  Mes := StrZero( sMes, 2 );
end;

function MesAno( Data: TDateTime ): string;
var
  sAno, sMes, sDia: Word;
begin
  DecodeDate( Data, sAno, sMes, sDia );
  MesAno := StrZero( sMes, 2 ) + '/' +
    StrZero( sAno, 4 );
end;

function Ano( Data: TDateTime ): string;
var
  sAno, sMes, sDia: Word;
begin
  DecodeDate( Data, sAno, sMes, sDia );
  Ano := StrZero( sAno, 4 );
end;

function Space(N: integer): string;
var
  I: integer;
  Dados: string;
begin
  Dados := '';
  for I := 1 to N do
  begin
    Dados := Dados + ' ';
    Application.ProcessMessages;
  end;
  Space := Dados;
end;

function StrZero(N: longint; Tamanho: integer): string;
var
  Conteudo: string;
  Diferenca: longint;
begin
  Conteudo := IntToStr( N );
  Diferenca := Tamanho - Length( Conteudo );
  if Diferenca > 0 then
    Conteudo := Repl( '0', Diferenca ) + Conteudo;
  StrZero := Conteudo;
end;

function Replicate(C: string; Tamanho: integer): string;
var
  Conteudo: string;
  Contar: integer;
begin
  Conteudo := '';
  for Contar := 1 to Tamanho do
  begin
    Conteudo := Conteudo + C;
    Application.ProcessMessages;
  end;
  Repl := Conteudo;
end;