相对分子质量计算

最新推荐文章于 2022-12-25 19:42:53 发布

undrewh446101

最新推荐文章于 2022-12-25 19:42:53 发布

阅读量1.5k

点赞数

分类专栏： delphi 文章标签： delphi programing

本文链接：https://blog.csdn.net/undrewh446101/article/details/8655410

版权

delphi 专栏收录该内容

1 篇文章

订阅专栏

本文详细介绍了如何将一个已有的Pascal版本的算法转换为Delphi版本，包括具体实现过程和使用效果。算法涉及字符数组、数值数组等基本数据结构的应用，以及如何优化代码以提升效率。通过实例分析，展示了从Pascal到Delphi的转换技巧，对于编程爱好者和开发者来说，是一次深入理解不同编程语言特性的宝贵经验。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

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

使用效果

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

贴代码...

unit Unit1;

interface

uses
  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.