Fórum Udf Não funciona #57438

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export;
var
  I    : Integer;
  S, S2: ShortString;
begin
  S := ´0´ + DecimalSeparator;
  For I:= 0 to Decimais-1 do
      S:= S + ´0´;
  Result := AllocMem(Length(S));
  StrPCopy(Result, S);
end;

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export; 
var 
  I    : Integer; 
  S, S2: ShortString; 
begin 
  S := ´0´ + DecimalSeparator; 
  For I:= 0 to Decimais-1 do 
      S:= S + ´0´;

[b]      S:= StrPCopy(S + Str);[/b]  Result := AllocMem(Length(S)); 
  StrPCopy(Result, S); 
end; 

function Formata(Str: Pchar; Decimais: Integer): Pchar;
var
  i : Integer;
  s, s2: ShortString;
begin
  i := pos(´,´{ou DecimalSeparator}, Str);
  s2 := str;

  delete( s2,1,i);

  if i > 0 then
     dec(decimais,length(s2));

  if decimais > 0 then
  begin
    if i = 0 then Str := PChar(Str + ´,´);

    for i := 1 to Decimais do
      Str := PChar(Str + ´0´);
  end;

  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;

function Formata(Str: Pchar; Decimais: Integer): Pchar;
var
  i : Integer;
  s: ShortString;
  d: double;
begin
  s := ´,#0.´+stringofchar(´0´, decimais);

  try
    d := strtofloat(str);
    str := PChar(formatfloat(s, d));
  except
  end;

  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;

Result := AllocMem(Length(´30,3´));
StrPCopy(Result, ´30,3´);

library sahudf;

uses
  SysUtils;

{ *** String functions *** }

{Retorna com a formatação de casas decimais
  DECLARE EXTERNAL FUNCTION FORMATA
  DOUBLE PRECISION,
  INTEGER
  RETURNS CSTRING(30) CHARACTER SET NONE
  ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´;}

function Formata(Str: Pchar; Decimais: Integer): Pchar; cdecl; export;
var
  i : Integer;
  s: ShortString;
  d: double;
begin 
  s := ´,#0.´+stringofchar(´0´, decimais); 

  try 
    d := strtofloat(str); 
    str := PChar(formatfloat(s, d)); 
  except 
  end;
  Result := AllocMem(Length(Str));
  StrPCopy(Result, Str);
end;

exports

  Formata;

begin
  Randomize;
end.

library sahudf;

uses
  SysUtils;

{ *** String functions *** }

{Retorna com a formatação de casas decimais
  DECLARE EXTERNAL FUNCTION FORMATA
  CSTRING(30),
  INTEGER
  RETURNS CSTRING(30)
  ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´;}

function Formata(Str: Pchar; var Decimais: Integer): Pchar; cdecl; export;
var
  s: shortstring;
  d: double;
begin
  s := ´,#0.´+stringofchar(´0´, decimais);

  try
    d := strtofloat(str);
  except
    d := 0;
  end;

  Str := PChar(formatfloat(s, d));
  Result := StrAlloc(Length(Str));
  Result := PChar(Str);
end;

exports
  Formata;

begin
end.

DECLARE EXTERNAL FUNCTION FORMATA
  CSTRING(30),
  INTEGER
RETURNS
  CSTRING(30)
ENTRY_POINT ´Formata´ MODULE_NAME ´sahudf´

 SELECT DERS,  DEDZ FROM DIAG_RESULTVALORES
                  WHERE DEAM=:CONTA AND DEFR=:EXMM AND DETT=:DDTT
                  INTO  :TNDC, :DDDZ; BEGIN
                [b]        DESR= FORMATA(10, 3);
--                        DESR= FORMATA(:TNDC, :DECI);[/b]                        END
                  END

CREATE PROCEDURE DIAG_RESULTADOSFINAL(
  CONTA INTEGER,
  EXMM INTEGER)
RETURNS(
  ITEM INTEGER,
  RESU VARCHAR(50) CHARACTER SET NONE,
  DESR VARCHAR(50) CHARACTER SET NONE,
  DDDZ INTEGER,
  BLBS BLOB,
  DECI INTEGER,
  TIPO INTEGER,
  NDEC NUMERIC(18, 6))
AS
DECLARE VARIABLE TEXT VARCHAR(50);
DECLARE VARIABLE DDDR INTEGER;
DECLARE VARIABLE DDGO INTEGER;
DECLARE VARIABLE TPTT INTEGER;
DECLARE VARIABLE DDTT INTEGER;
[b]DECLARE VARIABLE TNDC VARCHAR(18);[/b]
BEGIN
    FOR SELECT  DDDR,  DDGO,  DDTT,  DZCD,  DDCC FROM DIAG_DET_FORMTEXAMES
          INNER JOIN DIAG_ITENS_PARFORMEXAM ON (DDDZ=DZCD)
          WHERE DDFR=:EXMM
          INTO :DDDR, :DDGO, :DDTT, :DDDZ, :DECI DO BEGIN
          NDEC=NULL;
          RESU=NULL;
          DESR=NULL;
          IF (:DDDR IS NOT NULL) THEN BEGIN --RESULTADO POR FOMULA
               TIPO=1;
               SELECT CAST(DFRS AS DECIMAL (18, 4)) FROM DIAG_RESTFORMUL
               WHERE DFAM=:CONTA AND DFFR=:EXMM AND DFDR=:DDDZ
               INTO RESU;
             END

          IF (:DDGO IS NOT NULL) THEN BEGIN --RESULTADO POR GRUPO DE OPÇÕES
               TIPO=2;
               SELECT DLID, IDDS FROM DIAG_RESULTGRPOPC
               INNER JOIN DIAG_ITEMGRP_OPC ON IDCD=DLID
               WHERE DLAM=:CONTA AND DLFR=:EXMM AND DLDZ=:DDDZ
               INTO RESU, DESR;
               END

          IF (:DDTT IS NOT NULL) THEN BEGIN --RESULTADO POR TEXTO
               ITEM=NULL;
               SELECT TTTP FROM DIAG_TEXTOLIVRE
                      WHERE TTCD=:DDTT
                      INTO TPTT;

               IF (TPTT = 1) THEN BEGIN
                  TIPO=4;
                  ITEM=1;
                  SELECT   0,  DSDZ,  DSRS FROM DIAG_RESULTTEXTOS --TEXTO BLOB
                  WHERE DSAM=:CONTA AND DSFR=:EXMM AND DSTT=:DDDZ
                  INTO :DESR, :DDDZ, :BLBS;
                  END ELSE BEGIN
                  TIPO=3;
                  ITEM=0;
                  SELECT DERS,  DEDZ FROM DIAG_RESULTVALORES
                  WHERE DEAM=:CONTA AND DEFR=:EXMM AND DETT=:DDTT
                  INTO  :TNDC, :DDDZ; BEGIN
[b]                        DESR= FORMATA(:TNDC, :DECI);
--                        DESR=:TNDC;[/b]
                        END
                  END
               END
             SUSPEND;
   END
  END

d := strtofloat(StringReplace(Str,´.´, ´,´, [rfReplaceAll]));