Calcular pesos moleculares  

Send By: Roberto Saettone
Web : N.A.
Email: saettoner@hotmail.com
Date: 03/01/03

Tip accessed 534 times

 



 interface

   function CalcularMW(Texto : String ) : Double;
   function BuscarProximoElemento(Texto : String ; var inicio : Integer ; var
   Numero, Error : boolean) : string;
   function BuscarElemento( Texto : String ): integer;
   function EsNumero(Texto : string) : boolean;


 const

   Elementos : Array [1..77] of String =
     ('AC','AG','AL','AR','AS','AT','AU','B' ,'BA','BE','BI','BR','C'
 ,'CA','CD','CL','CO','CR','CS','CU','FE','FE',
     'FR','GA','GE','H' ,'HA','HE','HF','HG','IN','IN','IR','K'
 ,'KR','KU','LA','LI','MG','MN','MO','N' ,'NA','NB',
     'NE','NI','O' ,'OS','P'
 ,'PB','PD','PO','PT','RA','RB','RE','RH','RN','RU','S'
 ,'SB','SC','SE','SI','SN','SR',
     'TA','TC','TE','TI','TI','V' ,'W' ,'XE','Y' ,'ZN','ZR');

   ValElemen : Array [1..77] of Double = (
     227, 107.868, 26.98154, 39.948, 74.9216, 210, 196.9665, 10.81, 137.34,
 9.01218,
     208.9804, 79.904, 12.01115, 40.08, 112.4, 35.453, 58.9332, 51.996,
 132.9054,
     63.546, 55.847, 18.9984, 223, 69.72, 72.59, 1.0797, 260, 4.0026, 178.49,
 200.59,
     114.82, 126.9045, 192.22, 39.098, 83.8, 261, 138.9055, 6.941, 24.305,
 54.938,
     95.94, 14.0067, 22.98977, 92.9064, 20.179, 58.71, 15.9994, 190.2,
 30.97376,
     207.19, 106.4, 210, 195.09, 226.0254, 85.4678, 186.2, 102.9055, 222,
 101.07,
     32.06, 121.75, 44.9559, 78.96, 28.086, 118.69, 87.62, 180.9479, 98.9063,
 127.6,
     47.9, 204.37, 50.9414, 183.85, 131.3, 88.9059, 65.38, 91.22);









 implementation

 function CalcularMW(Texto : String ) : Double;
 var
   Inicio,
   A             : Integer;
   Variado       : String;
   Numero,
   Error         : Boolean;
   Suma,
   UltElemento,
   Multiplicador : Double;
 begin
   Inicio        := 1;
   Multiplicador := 1;
   Texto         := UpperCase(Trim(Texto));
   Variado       := BuscarProximoElemento(Texto, Inicio, Numero, Error);
   Suma          := 0;
   UltElemento   := 0;
   repeat
     if Numero then
     begin
       if UltElemento <> 0 then Suma := Suma +
 UltElemento*StrToFloat(Variado)
       else Multiplicador := StrToFloat(Variado);
       Variado := BuscarProximoElemento(Texto, Inicio, Numero, Error);
     end else
     begin
       A := BuscarElemento(Variado);
       if A > 0 then
         UltElemento := ValElemen[A];

       Variado := BuscarProximoElemento(Texto, Inicio, Numero, Error);
       if not Numero then
         Suma := Suma + UltElemento;
     end;

   until Variado = '';

   Result := Multiplicador*Suma;
 end;

 function BuscarProximoElemento(Texto : String ; var inicio : Integer ; var
 Numero, Error : boolean) : string;
 var
   Listo : boolean;
   A : integer;
 begin
   Error := false;
   Result := '';
   Numero := false;

   if Inicio <= 0 then Inicio := 1;
   if Inicio > Length(Texto) then Exit;

   if EsNumero(Texto[Inicio]) then
   begin
     Numero := true;
     while (Inicio <= Length(Texto)) and ( EsNumero(Texto[Inicio]) ) do
     begin
       Result := Result + Texto[Inicio];
       Inc(Inicio);
     end;
   end else
   begin
     while (Inicio <= Length(Texto)) and not ( EsNumero(Texto[Inicio]) ) do
     begin
       Result := Result + Texto[Inicio];
       Inc(Inicio);
     end;
   end;

   if not Numero then
   begin
     Listo := false;

     for A := Length(Result) downto 1 do
     begin
       if BuscarElemento(Copy(Result, 1, A)) > 0 then
       begin
         Inicio := Inicio - (Length(Result) - A);
         Result := Copy(Result, 1, A);
         Listo := true;
         Break;
       end;
     end;

     if not Listo then
     begin
       Inicio := Inicio - Length(Result);
       Result := '';
       Error := true;
     end;
   end;
 end;

 function BuscarElemento( Texto : String ): integer;
 var
   A : Integer;
 begin
   Result := 0;
   for A := Low(Elementos) to High(Elementos) do
   begin
     if Elementos[A] = Texto then
     begin
       Result := A;
       break;
     end;
   end;
 end;

 function EsNumero(Texto : string) : boolean;
 var
   A: integer;
 begin
   Texto := Trim(Texto);

   Result := true;
   for A := 1 to Length(Texto) do
   begin
     if Pos(Texto[A],'0123456789,.+-E') <= 0 then
     begin
       Result := false;
       break;
     end;
   end;

   if Result then
   begin
     try
       StrTOFloat(Texto);
     except
       Result := false;
     end;
   end;
 end;