Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > Varios
Registrarse FAQ Miembros Calendario Guía de estilo Buscar Temas de Hoy Marcar Foros Como Leídos

Grupo de Teaming del ClubDelphi

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 24-11-2005
chechu chechu is offline
Miembro
 
Registrado: oct 2004
Ubicación: argentina
Posts: 26
Poder: 0
chechu Va por buen camino
componente para mostrar calculo

hola quisiera pedir una ayuda, no se que componente puedo utilizar para mostrar los resultados de un calculo matematico, alguin me puede decir?
Responder Con Cita
  #2  
Antiguo 24-11-2005
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
Pues para mostrar un resultado vale cualquier control, desde el TLabel hasta el Tedit....

Intuyo que lo que estás pidiendo es un componente que interprete expresiones matemáticas?

Un Saludo.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #3  
Antiguo 24-11-2005
chechu chechu is offline
Miembro
 
Registrado: oct 2004
Ubicación: argentina
Posts: 26
Poder: 0
chechu Va por buen camino
Lo que Quiero es...

por ejemplo el usuario ingresa un numero y con este yo en mi codigo realizo calculos y retorno ese valor en la interfaz y no se como hacer con que evento y que componente utilizo....desde ya mil gracias
Responder Con Cita
  #4  
Antiguo 24-11-2005
Avatar de marcoszorrilla
marcoszorrilla marcoszorrilla is offline
Capo
 
Registrado: may 2003
Ubicación: Cantabria - España
Posts: 11.221
Poder: 10
marcoszorrilla Va por buen camino
Por ejemplo:
En edit1 introduce un 10
En edit2 introudce un 20
Los sumamos y mostramos el resultado en label1.
Código Delphi [-]
 label1.Caption:=IntToSTr(StrToInt(Edit1.text)+StrtoInt(Edit2.Text));

Un Saludo.
__________________
Guía de Estilo de los Foros
Cita:
- Ça c'est la caisse. Le mouton que tu veux est dedans.
Responder Con Cita
  #5  
Antiguo 24-11-2005
chechu chechu is offline
Miembro
 
Registrado: oct 2004
Ubicación: argentina
Posts: 26
Poder: 0
chechu Va por buen camino
Gracias Marcos

ya logre avanzar otro pasito muchas gracias
Responder Con Cita
  #6  
Antiguo 24-11-2005
Avatar de Lepe
[Lepe] Lepe is offline
Miembro Premium
 
Registrado: may 2003
Posts: 7.424
Poder: 28
Lepe Va por buen camino
Revisa tambien:

StrToIntDef
TryStrToInt

seguro que son de utilidad.

saludos
__________________
Si usted entendió mi comentario, contácteme y gustosamente,
se lo volveré a explicar hasta que no lo entienda, Gracias.
Responder Con Cita
  #7  
Antiguo 26-11-2005
Avatar de rastafarey
rastafarey rastafarey is offline
Miembro
 
Registrado: nov 2003
Posts: 927
Poder: 21
rastafarey Va por buen camino
Resp

Haber si esto es lo que quieres

Código Delphi [-]
unit MathComponent;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, math;

type
  TOperandtype = (ttradians, ttdegrees, ttgradients);
  TMathtype = (mtnil, mtoperator, mtlbracket, mtrbracket, mtoperand, mtfunction);
  TMathSubtype = (msnone, mstrignometric);
  TMathOperator = (monone, moadd, mosub, modiv, momul, mopow, momod, modivint);
  TMathFunction = (mfnone, mfsinh, mfcosh, mftanh, mfcosech, mfsech, mfcoth, mfsin,
    mfcos, mftan, mfcot, mfsec, mfcosec, mflog, mfln, mfsub, mfadd);

type
  pmathchar = ^Tmathchar;
  TMathChar = record
    case mathtype: Tmathtype of
      mtoperand: (data: extended);
      mtoperator: (op: TMathOperator);
      mtfunction: (func: TMathfunction; subtype: (mstnone, msttrignometric));
  end;

type
  TMathControl = class(TComponent)
  private
    input, output, stack: array of tmathchar;
    fmathstring: string;
    ftrignometrictype: Toperandtype;
    fExpressionValid: boolean;
    procedure removespace;
    function isvalidchar(c: char): boolean;
    function getresult: extended;
    function checkbrackets: boolean;
    function calculate(operand1, operand2, operator: Tmathchar): extended; overload;
    function calculate(operand1, operator: Tmathchar): extended; overload;
    function getoperator(pos: integer; var len: integer; var amathoperator:
      TMathOperator): boolean;
    function getoperand(pos: integer; var len: integer; var value: extended): boolean;
    function getmathfunc(pos: integer; var len: integer; var amathfunc:
      TmathFunction): boolean;
    function processstring: boolean;
    procedure convertinfixtopostfix;
    function isdigit(c: char): boolean;
    function getprecedence(mop: TMathchar): integer;
  protected
    procedure loaded; override;
  published
    property MathExpression: string read fmathstring write fmathstring;
    property MathResult: extended read getresult;
    property ExpressionValid: boolean read fExpressionvalid;
    property Trignometrictype: Toperandtype read ftrignometrictype write
      ftrignometrictype;
  end;

procedure Register;

implementation

function tmathcontrol.calculate(operand1, operator: Tmathchar): extended;
begin
  result := 0;
  if (operator.subtype = msttrignometric) then
  begin
    if ftrignometrictype = ttdegrees then
      operand1.data := operand1.data * (pi / 180);
    if ftrignometrictype = ttgradients then
      operand1.data := GradToRad(operand1.data);
  end;
  case operator.func of
    mfsub: result := -operand1.data;
    mfadd: result := operand1.data;
    mfsin: result := sin(operand1.data);
    mfcos: result := cos(operand1.data);
    mfcot: result := 1 / tan(operand1.data);
    mfcosec: result := 1 / sin(operand1.data);
    mfsec: result := 1 / cos(operand1.data);
    mftan: result := tan(operand1.data);
    mflog: result := log10(operand1.data);
    mfln: result := ln(operand1.data);
  end;
end;

function tmathcontrol.getmathfunc(pos: integer; var len: integer; var amathfunc:
  TmathFunction): boolean;
var
  tmp: string;
  i: integer;
begin
  amathfunc := mfnone;
  result := false;
  tmp := '';
  if (fmathstring[pos] = '+') then
  begin
    amathfunc := mfadd;
    len := 1;
    result := true;
  end;
  if (fmathstring[pos] = '-') then
  begin
    amathfunc := mfsub;
    len := 1;
    result := true;
  end;
  if (fmathstring[pos] = 's') then
  begin
    for i := pos to pos + 3 do
      tmp := tmp + fmathstring[i];
    if strcomp(pchar(tmp), 'sin(') = 0 then
    begin
      amathfunc := mfsin;
      len := 3;
      result := true;
    end
    else if strcomp(pchar(tmp), 'sec(') = 0 then
    begin
      amathfunc := mfsec;
      len := 3;
      result := true;
    end;
  end;
  if (fmathstring[pos] = 'c') then
  begin
    for i := pos to pos + 5 do
      tmp := tmp + fmathstring[i];
    if strlcomp(pchar(tmp), 'cos(', 4) = 0 then
    begin
      amathfunc := mfcos;
      len := 3;
      result := true;
    end
    else if strlcomp(pchar(tmp), 'cot(', 4) = 0 then
    begin
      amathfunc := mfcot;
      len := 3;
      result := true;
    end
    else if strlcomp(pchar(tmp), 'cosec(', 6) = 0 then
    begin
      amathfunc := mfcosec;
      len := 3;
      result := true;
    end
  end;
  if (fmathstring[pos] = 't') then
  begin
    for i := pos to pos + 3 do
      tmp := tmp + fmathstring[i];
    if strlcomp(pchar(tmp), 'tan(', 4) = 0 then
    begin
      amathfunc := mflog;
      len := 3;
      result := true;
    end;
  end;
  if (fmathstring[pos] = 'l') then
  begin
    for i := pos to pos + 3 do
      tmp := tmp + fmathstring[i];
    if strlcomp(pchar(tmp), 'log(', 4) = 0 then
    begin
      amathfunc := mflog;
      len := 3;
      result := true;
    end
    else if strlcomp(pchar(tmp), 'ln(', 3) = 0 then
    begin
      amathfunc := mfln;
      len := 3;
      result := true;
    end
  end;
end;

procedure tmathcontrol.loaded;
begin
  inherited;
  fexpressionvalid := processstring;
end;

procedure tmathcontrol.removespace;
var
  i: integer;
  tmp: string;
begin
  tmp := '';
  for i := 1 to length(fmathstring) do
    if fmathstring[i] <> ' ' then
      tmp := tmp + fmathstring[i];
  fmathstring := tmp;
end;

function tmathcontrol.isvalidchar(c: char): boolean;
begin
  result := true;
  if (not (isdigit(c))) and (not (c in ['(', ')', 't', 'l', 'c', 'm', 'd', 's', '*',
    '/', '+', '-', '^'])) then
    result := false;
end;

function tmathcontrol.checkbrackets: boolean;
var
  i: integer;
  bracketchk: integer;
begin
  result := true;
  bracketchk := 0;
  i := 1;
  if length(fmathstring) = 0 then
    result := false;
  while i <= length(fmathstring) do
  begin
    if fmathstring[i] = '(' then
      bracketchk := bracketchk + 1
    else if fmathstring[i] = ')' then
      bracketchk := bracketchk - 1;
    i := i + 1;
  end;
  if bracketchk <> 0 then
    result := false;
end;

function Tmathcontrol.calculate(operand1, operand2, operator: Tmathchar): extended;
begin
  result := 0;
  case operator.op of
    moadd:
      result := operand1.data + operand2.data;
    mosub:
      result := operand1.data - operand2.data;
    momul:
      result := operand1.data * operand2.data;
    modiv:
      if (operand1.data <> 0) and (operand2.data <> 0) then
        result := operand1.data / operand2.data
      else
        result := 0;
    mopow: result := power(operand1.data, operand2.data);
    modivint:
      if (operand1.data <> 0) and (operand2.data <> 0) then
        result := round(operand1.data) div round(operand2.data)
      else
        result := 0;
    momod:
      if (operand1.data >= 0.5) and (operand2.data >= 0.5) then
        result := round(operand1.data) mod round(operand2.data)
      else
        result := 0;
  end;
end;

function Tmathcontrol.getresult: extended;
var
  i: integer;
  tmp1, tmp2, tmp3: tmathchar;
begin
  fExpressionValid := processstring;
  if fExpressionValid = false then
  begin
    result := 0;
    exit;
  end;
  convertinfixtopostfix;
  setlength(stack, 0);
  for i := 0 to length(output) - 1 do
  begin
    if output[i].mathtype = mtoperand then
    begin
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1] := output[i];
    end
    else if output[i].mathtype = mtoperator then
    begin
      tmp1 := stack[length(stack) - 1];
      tmp2 := stack[length(stack) - 2];
      setlength(stack, length(stack) - 2);
      tmp3.mathtype := mtoperand;
      tmp3.data := calculate(tmp2, tmp1, output[i]);
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1] := tmp3;
    end
    else if output[i].mathtype = mtfunction then
    begin
      tmp1 := stack[length(stack) - 1];
      setlength(stack, length(stack) - 1);
      tmp2.mathtype := mtoperand;
      tmp2.data := calculate(tmp1, output[i]);
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1] := tmp2;
    end;
  end;
  result := stack[0].data;
  setlength(stack, 0);
  setlength(input, 0);
  setlength(output, 0);
end;

function Tmathcontrol.getoperator(pos: integer; var len: integer; var amathoperator:
  TMathOperator): boolean;
var
  tmp: string;
  i: integer;
begin
  tmp := '';
  result := false;
  if fmathstring[pos] = '+' then
  begin
    amathoperator := moadd;
    len := 1;
    result := true;
  end
  else if fmathstring[pos] = '*' then
  begin
    amathoperator := momul;
    len := 1;
    result := true;
  end
  else if fmathstring[pos] = '/' then
  begin
    amathoperator := modiv;
    len := 1;
    result := true;
  end
  else if fmathstring[pos] = '-' then
  begin
    amathoperator := mosub;
    len := 1;
    result := true;
  end
  else if fmathstring[pos] = '^' then
  begin
    amathoperator := mopow;
    len := 1;
    result := true;
  end
  else if fmathstring[pos] = 'd' then
  begin
    for i := pos to pos + 2 do
      tmp := tmp + fmathstring[i];
    if strcomp(pchar(tmp), 'div') = 0 then
    begin
      amathoperator := modivint;
      len := 3;
      result := true;
    end;
  end
  else if fmathstring[pos] = 'm' then
  begin
    for i := pos to pos + 2 do
      tmp := tmp + fmathstring[i];
    if strcomp(pchar(tmp), 'mod') = 0 then
    begin
      amathoperator := momod;
      len := 3;
      result := true;
    end;
  end;
end;

function Tmathcontrol.getoperand(pos: integer; var len: integer; var value: extended):
  boolean;
var
  i, j: integer;
  tmpnum: string;
  dotflag: boolean;
begin
  j := 1;
  result := true;
  dotflag := false;
  for i := pos to length(fmathstring) - 1 do
  begin
    if isdigit(fmathstring[i]) then
    begin
      if (fmathstring[i] = '.') and (dotflag = true) then
      begin
        result := false;
        break;
      end
      else if (fmathstring[i] = '.') and (dotflag = false) then
        dotflag := true;
      tmpnum := tmpnum + fmathstring[i];
      j := j + 1;
    end
    else
      break;
  end;
  if result = true then
  begin
    value := strtofloat(tmpnum);
    len := j - 1;
  end;
end;

function Tmathcontrol.processstring: boolean;
var
  i: integer;
  mov: integer;
  tmpfunc: tmathfunction;
  tmpop: tmathoperator;
  numoperators: integer;
  numoperands: integer;
begin
  i := 0;
  mov := 0;
  numoperators := 0;
  numoperands := 0;
  setlength(output, 0);
  setlength(input, 0);
  setlength(stack, 0);
  removespace;
  result := true;
  if checkbrackets = false then
  begin
    result := false;
    exit;
  end;
  fmathstring := '(' + fmathstring + ')';
  while i <= length(fmathstring) - 1 do
  begin
    if not (isvalidchar(fmathstring[i + 1])) then
    begin
      result := false;
      break;
    end;
    if fmathstring[i + 1] = '(' then
    begin
      setlength(input, length(input) + 1);
      input[length(input) - 1].mathtype := mtlbracket;
      i := i + 1;
    end
    else if fmathstring[i + 1] = ')' then
    begin
      setlength(input, length(input) + 1);
      input[length(input) - 1].mathtype := mtrbracket;
      i := i + 1;
    end
    else if getoperator(i + 1, mov, tmpop) then
    begin
      if (tmpop <> moadd) and (tmpop <> mosub) then
      begin
        if i = 0 then //first character cannot be an operator
        begin // other than a '+' or '-'.
          result := false;
          break;
        end;
        setlength(input, length(input) + 1);
        input[length(input) - 1].mathtype := mtoperator;
        input[length(input) - 1].op := tmpop;
        i := i + mov;
        numoperators := numoperators + 1;
      end
      else if (tmpop = mosub) or (tmpop = moadd) then
      begin
        if (i = 0) or (input[length(input) - 1].mathtype = mtoperator) or
          (input[length(input) - 1].mathtype = mtlbracket) then
        begin //makes use of fact the if the first part of if expression is true then
          //remaining parts are not evaluated thus preventing a
          //exception from occuring.
          setlength(input, length(input) + 1);
          input[length(input) - 1].mathtype := mtfunction;
          getmathfunc(i + 1, mov, tmpfunc);
          input[length(input) - 1].func := tmpfunc;
          i := i + mov;
        end
        else
        begin
          setlength(input, length(input) + 1);
          numoperators := numoperators + 1;
          input[length(input) - 1].mathtype := mtoperator;
          input[length(input) - 1].op := tmpop;
          i := i + 1;
        end;
      end;
    end
    else if isdigit(fmathstring[i + 1]) then
    begin
      setlength(input, length(input) + 1);
      input[length(input) - 1].mathtype := mtoperand;
      if getoperand(i + 1, mov, input[length(input) - 1].data) = false then
      begin
        result := false;
        break;
      end;
      i := i + mov;
      numoperands := numoperands + 1;
    end
    else
    begin
      getmathfunc(i + 1, mov, tmpfunc);
      if tmpfunc <> mfnone then
      begin
        setlength(input, length(input) + 1);
        input[length(input) - 1].mathtype := mtfunction;
        input[length(input) - 1].func := tmpfunc;
        if tmpfunc in [mfsin, mfcos, mftan, mfcot, mfcosec, mfsec] then
          input[length(input) - 1].subtype := msttrignometric
        else
          input[length(input) - 1].subtype := mstnone;
        i := i + mov;
      end
      else
      begin
        result := false;
        break;
      end;
    end;
  end;
  if numoperands - numoperators <> 1 then
    result := false;
end;

function Tmathcontrol.isdigit(c: char): boolean;
begin
  result := false;
  if ((integer(c) > 47) and (integer(c) < 58)) or (c = '.') then
    result := true;
end;

function Tmathcontrol.getprecedence(mop: TMathchar): integer;
begin
  result := -1;
  if mop.mathtype = mtoperator then
  begin
    case mop.op of
      moadd: result := 1;
      mosub: result := 1;
      momul: result := 2;
      modiv: result := 2;
      modivint: result := 2;
      momod: result := 2;
      mopow: result := 3;
    end
  end
  else if mop.mathtype = mtfunction then
    result := 4;
end;

procedure Tmathcontrol.convertinfixtopostfix;
var
  i, j, prec: integer;
begin
  for i := 0 to length(input) - 1 do
  begin
    if input[i].mathtype = mtoperand then
    begin
      setlength(output, length(output) + 1);
      output[length(output) - 1] := input[i];
    end
    else if input[i].mathtype = mtlbracket then
    begin
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1] := input[i];
    end
    else if (input[i].mathtype = mtoperator) then
    begin
      prec := getprecedence(input[i]);
      j := length(stack) - 1;
      if j >= 0 then
      begin
        while (getprecedence(stack[j]) >= prec) and (j >= 0) do
        begin
          setlength(output, length(output) + 1);
          output[length(output) - 1] := stack[j];
          setlength(stack, length(stack) - 1);
          j := j - 1;
        end;
        setlength(stack, length(stack) + 1);
        stack[length(stack) - 1] := input[i];
      end;
    end
    else if input[i].mathtype = mtfunction then
    begin
      setlength(stack, length(stack) + 1);
      stack[length(stack) - 1] := input[i];
    end
    else if input[i].mathtype = mtrbracket then
    begin
      j := length(stack) - 1;
      if j >= 0 then
      begin
        while (stack[j].mathtype <> mtlbracket) and (j >= 0) do
        begin
          setlength(output, length(output) + 1);
          output[length(output) - 1] := stack[j];
          setlength(stack, length(stack) - 1);
          j := j - 1;
        end;
        if j >= 0 then
          setlength(stack, length(stack) - 1);
      end;
    end;
  end;
end;

procedure Register;
begin
  RegisterComponents('Samples', [TMathControl]);
end;

end.
__________________
Todo se puede, que no exista la tecnología aun, es otra cosa.
Responder Con Cita
  #8  
Antiguo 26-05-2010
ronalg ronalg is offline
Miembro
 
Registrado: may 2003
Ubicación: Sucre - Bolivia
Posts: 68
Poder: 21
ronalg Va por buen camino
No eso no es lo el necesitaba

Pero Mil Millones De Gracias Porque Es Lo Que Yo Estaba Buscando.
__________________
Saludos desde Sucre - Bolivia
"Si te lo puedes imaginar lo
puedes resolver" Pyriel
Responder Con Cita
  #9  
Antiguo 26-05-2010
elarys elarys is offline
Miembro
 
Registrado: abr 2007
Posts: 94
Poder: 17
elarys Va por buen camino
para el 2015 te respondo algo
Responder Con Cita
  #10  
Antiguo 27-05-2010
ronalg ronalg is offline
Miembro
 
Registrado: may 2003
Ubicación: Sucre - Bolivia
Posts: 68
Poder: 21
ronalg Va por buen camino
Jajajajajaja

Si me di cuenta de la fecha un poco tarde.
La alegria del regreso supongo o talvez lo distraido que estaba en ese momento.

Quedo como nota de humor. pero aun asi gracias a rastafarey en TIEMPO y la DISTANCIA. JAJAJAJAJA
__________________
Saludos desde Sucre - Bolivia
"Si te lo puedes imaginar lo
puedes resolver" Pyriel
Responder Con Cita
Respuesta


Herramientas Buscar en Tema
Buscar en Tema:

Búsqueda Avanzada
Desplegado

Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro


La franja horaria es GMT +2. Ahora son las 23:07:25.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi