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;