Foros Club Delphi

Foros Club Delphi (https://www.clubdelphi.com/foros/index.php)
-   Varios (https://www.clubdelphi.com/foros/forumdisplay.php?f=11)
-   -   componente para mostrar calculo (https://www.clubdelphi.com/foros/showthread.php?t=27573)

chechu 24-11-2005 15:09:58

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?

marcoszorrilla 24-11-2005 15:14:06

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.

chechu 24-11-2005 15:19:04

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

marcoszorrilla 24-11-2005 15:21:21

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.

chechu 24-11-2005 16:02:31

Gracias Marcos
 
ya logre avanzar otro pasito muchas gracias

Lepe 24-11-2005 17:36:31

Revisa tambien:

StrToIntDef
TryStrToInt

seguro que son de utilidad.

saludos

rastafarey 26-11-2005 15:07:24

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.

ronalg 26-05-2010 17:47:16

No eso no es lo el necesitaba
 
Pero Mil Millones De Gracias Porque Es Lo Que Yo Estaba Buscando.

elarys 26-05-2010 21:47:18

para el 2015 te respondo algo

ronalg 27-05-2010 06:16:00

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


La franja horaria es GMT +2. Ahora son las 04:03:12.

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