adriano_servitec
Colaborador
Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17618
|
 Enviada: Ter Mai 13, 2008 11:16 am Assunto: |
 |
|
Veja se esta função ajuda
| Código: | unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Edit1: TEdit;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function Calcular(SMyExpression: string; digits: Byte): string;
// Funçao para calcular uma simples operação matematica
var
z: Char;
ipos: Integer;
function StrToReal(chaine: string): Real;
var
r: Real;
Pos: Integer;
begin
Val(chaine, r, Pos);
if Pos > 0 then Val(Copy(chaine, 1, Pos - 1), r, Pos);
Result := r;
end;
function RealToStr(inreal: Extended; digits: Byte): string;
var
S: string;
begin
Str(inreal: 0: digits, S);
realToStr := S;
end;
procedure NextChar;
var
s: string;
begin
if ipos > Length(SMyExpression) then
begin
z := #9;
Exit;
end
else
begin
s := Copy(SMyExpression, ipos, 1);
z := s[1];
Inc(ipos);
end;
if z = ' ' then nextchar;
end;
function Expression: Real;
var
w: Real;
function Factor: Real;
var
ws: string;
begin
Nextchar;
if z in ['0'..'9'] then
begin
ws := '';
repeat
ws := ws + z;
nextchar
until not (z in ['0'..'9', '.']);
Factor := StrToReal(ws);
end
else if z = '(' then
begin
Factor := Expression;
nextchar
end
else if z = '+' then Factor := +Factor
else if Z = '-' then Factor := -Factor;
end;
function Term: Real;
var
W: Real;
begin
W := Factor;
while Z in ['*', '/'] do
if z = '*' then w := w * Factor
else
w := w / Factor;
Term := w;
end;
begin
w := term;
while z in ['+', '-'] do
if z = '+' then w := w + term
else
w := w - term;
Expression := w;
end;
begin
ipos := 1;
Result := RealToStr(Expression, digits);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Expressao: string;
begin
Expressao := Edit1.text;
ShowMessage(Expressao + ' = ' + Calcular(Expressao, 2));
end;
end. |
O JEDI tambem tem componente pra isso
JvInterpreterProgram
JvInterpreterFm
Nesta página do Torry.net tem alguns componentes que são capazes de analisar e avaliar expressões/fórmulas.[*]Na JCL (Jedi Code Library) tem uma unit chamada JclExprEval onde você encontrará as classes TEvaluator e TCompiledEvaluator[*]Para uma solução mais sofisticada, tem o [url=http://www.remobjects.com/page.asp?id={9A30A672-62C8-4131-BA89-EEBBE7E302E6}]Pascal Script[/url]; com ele você poderia escrever pequenos scripts ao invés de fórmulas para fazer os cálculos[/list]
Ou tambem usando uma stored procedure, usando o comando execute statement
Olhe um exemplo que eu uso aqui na SP
| Código: | CREATE PROCEDURE ESSQLFUNC
returns (
id_empresa integer,
salario numeric(15,2),
id_sal integer,
id_formula integer,
descricao varchar(100),
id_func integer,
nome varchar(50),
id_gerarformula integer,
calculo varchar(100),
proventos numeric(15,2),
descontos numeric(15,2))
as
declare variable b_calculo varchar(50);
declare variable valor varchar(50);
declare variable quantidade varchar(50);
declare variable formula varchar(50);
declare variable quantia varchar(50);
declare variable vl_informado varchar(50);
declare variable prov_desc char(1);
begin
for
select
A.id_empresa, A.salario, A.id_sal, B.id_formula, B.descricao,
A.id_func, A.nome, B.id_gerarformula, b.b_calculo, b.valor,
b.quantidade, b.formula, b.quantia, b.vl_informado, b.p_d
from
salario_m A
left join
formulas B on B.id_gerarformula = A.id_sal
where
(B.marcar = 'True')
order by
a.id_empresa, a.id_func
into :id_empresa, :salario, :id_sal, :id_formula, :descricao,
:id_func, :nome, :id_gerarformula, :b_calculo, :valor,
:quantidade, :formula, :quantia, :vl_informado, :prov_desc
do
begin
if (b_calculo = 'Fixo') then
calculo = salario;
else
begin
if (quantidade = 'True') then
calculo = cast(salario as varchar(10)) || formula || '*' || quantia;
else
begin
if (valor = 'True') then
calculo = vl_informado;
else
calculo = cast(salario as varchar (10)) || formula;
end
end
proventos = 0;
descontos = 0;
--- Aqui será executada a fórmula
if (prov_desc = 'P') then
execute statement 'select ' || calculo || ' from rdb$database' into proventos;
else
execute statement 'select ' || calculo || ' from rdb$database' into descontos;
suspend;
end
end |
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree |
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
