相对分子质量计算

很久以前写得，去年4月左右，先写了一个pascal版的然后转成了delphi

使用效果

感觉做得不错，也没有什么bug

贴代码...

unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls;const    aa=14;    a:array[1..aa]of char=('B','C','F','H','I','K','N','O','P','S','U','V',    'W','Y');    wa:array[1..aa]of real=(7,12,19,1,127,39,14,16,31,32,238,51,184,89);    bb=73;    b:array[1..bb]of string[2]=('Ac','Ag','Al','Ar','As','Au','Ba','Be','Bi','Br','Ca','Cd','Ce','Cl','Co','Cr','Cs','Cu','Dy','Er','Eu','Fe','Ga','Gd','Ge','He','Hf','Hg','Ho','In','Ir','Kr','La','Li','Lu','Mg','Mn','Mo','Na','Nb','Nd','Ne','Ni','Np','Os','Pa','Pb','Pd','Pr','Pt','Ra','Rb','Re','Rh','Ru','Sb','Sc','Se','Si','Sm','Sn','Sr','Ta','Tb','Te','Th','Ti','Tl','Tm','Xe','Yb','Zn','Zr');    wb:array[1..bb]of real=(227,108,27,40,75,197,137,9,209,80,40,112,140,35.5,59,52,133,64,163,167,152,56,70,157,72,4,178,201,165,115,192,84,139,7,175,24,55,96,23,93,144,20,59,237,190,231,207,106,141,195,226,85,186,103,101,122,45,79,28,150,119,88,181,159,128,232,48,204,169,132,173,65,91);type  TForm1 = class(TForm)    Edit1: TEdit;    Button1: TButton;    Button2: TButton;    Edit2: TEdit;    procedure Button1Click(Sender: TObject);    procedure Button2Click(Sender: TObject);  private    { Private declarations }  public    { Public declarations }  end;var  Form1: TForm1;  h,hh:string;  e:string;  t,tt,tx:real;  bin,i,x,p,ii,iii:integer;implementation{$R *.dfm}procedure orzx(ss:string);var    jj,bi1,bi2:integer;    pttx,jjb:real;    aax:char;    bbx:string[2];begin  if (length(ss)>=2)and([ss[2]]<=['a'..'z'])then    begin      bbx:=copy(ss,1,2);      delete(ss,1,2);      for jj:=1 to bb do        if bbx=b[jj] then          begin            pttx:=wb[jj];            break;          end;    end                                          else    begin      aax:=ss[1];      delete(ss,1,1);      for jj:=1 to aa do        if aax=a[jj] then          begin            pttx:=wa[jj];            break;          end;    end;  if (ss<>'')and([ss[1]]<=['0'..'9'])then    begin      val(ss,jjb,bi1);      if bi1=0 then bi1:=length(ss)+1;      val(copy(ss,1,bi1-1),jjb,bi2);      delete(ss,1,bi1-1);      tx:=tx+pttx*jjb;    end                                   else    tx:=tx+pttx;  if ss<>'' then orzx(ss);end;function qkh(w:string):string;var    o,oo,ooo,oooo,l,r,q:integer;    binx:string;begin  q:=0;  for o:=1 to length(w)do if w[o]='('then q:=q+1;  for o:=1 to q do    begin      for l:=length(w)downto 1 do if w[l]='('then break;      for r:=l+2 to length(w)do if w[r]=')'then break;      tx:=0;      orzx(copy(w,l+1,r-l-1));      binx:=copy(w,r+1,length(w)-r);      val(binx,oo,ooo);      if ooo=0 then        ooo:=length(w)+1;      val(copy(binx,1,ooo-1),oo,oooo);      delete(w,l,r+ooo-l);      tx:=tx*oo;      str(tx:0:0,binx);      binx:=binx;      w:=copy(w,1,l-1)+'H'+binx+copy(w,l,300);    end;  qkh:=w;end;procedure orz(s:string);var    k,j,bin1,bin2:integer;    ptt,jb:real;    aaa:char;    bbb:string[2];begin  k:=pos('(',s);  if k>0 then s:=qkh(s);  if (length(s)>=2)and([s[2]]<=['a'..'z'])then    begin      bbb:=copy(s,1,2);      delete(s,1,2);      for j:=1 to bb do        if bbb=b[j] then          begin            ptt:=wb[j];            break;          end;    end                                          else    begin      aaa:=s[1];      delete(s,1,1);      for j:=1 to aa do        if aaa=a[j] then          begin            ptt:=wa[j];            break;          end;    end;  if (s<>'')and([s[1]]<=['0'..'9'])then    begin      val(s,jb,bin1);      if bin1=0 then bin1:=length(s)+1;      val(copy(s,1,bin1-1),jb,bin2);      delete(s,1,bin-1);      t:=t+ptt*jb;    end                                   else    t:=t+ptt;  if s<>'' then orz(s);end;procedure TForm1.Button1Click(Sender: TObject);begin  h:=edit1.Text;  if h='' then exit;  h:=h+'.';  for ii:=1 to length(h)do if h[ii]='.'then iii:=iii+1;  for ii:=1 to iii do    begin      p:=pos('.',h);      hh:=copy(h,1,p-1);      val(hh,bin,i);      if i=0 then exit;      x:=1;      if i>1 then        begin          val(copy(hh,1,i-1),x,bin);          delete(hh,1,i-1);        end;      orz(hh);      tt:=tt+t*x;      t:=0;      delete(h,1,p);    end;  str(tt:0:0,e);  edit2.Text:=e;  iii:=0;  tt:=0;end;procedure TForm1.Button2Click(Sender: TObject);begin  edit1.Text:='';  edit2.Text:='';end;end.