'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' REPLELEM.BAS                                                        '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'   The utility changes all the atoms of the given type to another    '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

Function Main As String
Dim Form, page,diag,asm,struc As Object, e1,e2,m,nd As Integer, fm As Double
Dim s As String, OK As Boolean

' Get 1st structure from the curent page
  page=ActiveDocument.ActivePage
  nd=page.Diagrams.Count
  if nd<1 then
    Main="There are no structures on your page."+Chr(13)+Chr(13)+"Draw structure and restart Replace Element."
    exit function
  else
    if nd>1 then 
      Main="There are several structures on your page."+Chr(13)+Chr(13)+"Keep one structure on the page and restart Replace Element."
      exit function
    else
      diag=page.Diagrams.Item(1)
    end if 
  end if
  asm=Assemblies.AddFromCS(diag)
  If asm=NULL Then Exit Function
  struc=Asm.Structures.Item(1)
  If struc=NULL Then Exit Function

  Form=ReadForm("Replelem.frm")
  If Form.ExecForm Then
    s=Form.GetStrValue("ElementToReplace")
    If AtProp(s,e1,m,fm) Then
      if ElementExists(struc, e1)=FALSE then
        Main="There are no "+UCase(s)+" atoms in your structure."
        exit function
      end if 
      s=Form.GetStrValue("ReplaceWith")
      If AtProp(s,e2,m,fm)  Then
        ' Change element
        Call ReplaceAllElementsByKind(struc,e1,e2,fm)
        ' Show results
        RefreshDiagram(diag,struc)
        Main="Completed."
      End If
    End If
  Else
    Main="Cancelled"
    Exit Function
  End If

End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ReplaceAllElementsByKind(struc As Object,ByVal e1 As Integer, ByVal e2 As Integer,ByVal mass2 As Double)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim asm,at As Object
  asm=struc.Assembly
  For Each at In asm
    If e1=at.GetElNumber Then
      at.SetElNumber(e2)
      at.SetMass(mass2)
    End If
  Next at
End Sub



'***LIBRARY PROCEDURES BEGIN
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub RefreshDiagram(diag As Object,strmol As Object)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Redraws the diagram with a molecule or structure object             '
'                                                                     '
' ENTER                                                               '
'     diag            object of type CS_DIAGRAM                       '
'     strmol          object of type CB_MOLECULE or CB_STRUCTURE      '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim l,t,w,h,w1,h1 As Integer
  diag.GetBound(l,t,w,h)
  diag.Depict(strmol)
  diag.GetBound(w,h,w1,h1)
  diag.SetBound(l,t,w1,h1)
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function AtProp(ByVal ElSymb As String,ByRef elnum As Integer, imass As Integer, fmass As Double) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Returns element's properties                                        '
'                                                                     '
' ENTER                                                               '
'     ElSymb          the string for chemical symbol                  '
' EXIT                                                                '
'     returns TRUE if the string match some element otherwise FALSE   '
'     fills in if applicable:                                         '
'     ElNumber        element number, integer                         '
'     imass           element mass, integer                           '
'     fmass           element mass, double                            '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s As String
  AtProp=TRUE
  s=UCase(ElSymb)
  Select Case s
        Case "H"
          elnum=1 : imass=1 : fmass=1.0079
        Case "D"
          elnum=1 : imass=2: fmass=2.0100
        Case "T"
          elnum=1 : imass=3: fmass=3.0200
        Case "HE"
          elnum=2 : imass=4: fmass=4.0026
        Case "LI"
          elnum=3 : imass=7: fmass=6.9410
        Case "BE"
          elnum=4 : imass=9: fmass=9.0122
        Case "B"
          elnum=5 : imass=11: fmass=10.8110
        Case "C"
          elnum=6 : imass=12: fmass=12.0107
        Case "N"
          elnum=7 : imass=14: fmass=14.0067
        Case "O"
          elnum=8 : imass=16: fmass=15.9994
        Case "F"
          elnum=9 : imass=19: fmass=18.9984
        Case "NE"
          elnum=10 : imass=20: fmass=20.1797
        Case "NA"
          elnum=11 : imass=23: fmass=22.9898
        Case "MG"
          elnum=12 : imass=24: fmass=24.3050
        Case "AL"
          elnum=13 : imass=27: fmass=26.9815
        Case "SI"
          elnum=14 : imass=28: fmass=28.0855
        Case "P"
          elnum=15 : imass=31: fmass=30.9738
        Case "S"
          elnum=16 : imass=32: fmass=32.0660
        Case "CL"
          elnum=17 : imass=35: fmass=35.4527
        Case "AR"
          elnum=18 : imass=40: fmass=39.9480
        Case "K"
          elnum=19 : imass=39: fmass=39.0983
        Case "CA"
          elnum=20 : imass=40: fmass=40.0780
        Case "SC"
          elnum=21 : imass=45: fmass=44.9559
        Case "TI"
            elnum=22: imass=48: fmass=47.8670
        Case "V"
            elnum=23 : imass=51: fmass=50.9415
        Case "CR"
            elnum=24: imass=52: fmass=51.9961
        Case "MN"
            elnum=25: imass=55: fmass=54.9380
        Case "FE"
            elnum=26: imass=56: fmass=55.8450
        Case "CO"
            elnum=27: imass=59: fmass=58.9332
        Case "NI"
            elnum=28 : imass=59: fmass=58.6934
        Case "CU"
            elnum=29 : imass=64: fmass=63.5460
        Case "ZN"
            elnum=30 : imass=65: fmass=65.3900
        Case "GA"
            elnum=31 : imass=70: fmass=69.7230
        Case "GE"
            elnum=32 : imass=73: fmass=72.6100
        Case "AS"
            elnum=33 : imass=75: fmass=74.9216
        Case "SE"
            elnum=34 : imass=79: fmass=78.9600
        Case "BR"
            elnum=35 : imass=80: fmass=79.9040
        Case "KR"
            elnum=36 : imass=84: fmass=83.8000
        Case "RB"
            elnum=37 : imass=85: fmass=85.4678
        Case "SR"
            elnum=38 : imass=88: fmass=87.6200
        Case "Y"
            elnum=39 : imass=89: fmass=88.9058
        Case "ZR"
            elnum=40 : imass=91: fmass=91.2240
        Case "NB"
            elnum=41 : imass=93: fmass=92.9064
        Case "MO"
            elnum=42 : imass=96: fmass=95.9400
        Case "TC"
            elnum=43 : imass=98: fmass=98.0000
        Case "RU"
            elnum=44 : imass=101: fmass=101.0700
        Case "RH"
            elnum=45 : imass=103: fmass=102.9055
        Case "PD"
            elnum=46 : imass=106: fmass=106.4200
        Case "AG"
            elnum=47 : imass=108: fmass=107.8682
        Case "CD"
            elnum=48 : imass=112: fmass=112.4110
        Case "IN"
            elnum=49 : imass=115: fmass=114.8180
        Case "SN"
            elnum=50 : imass=119: fmass=118.7100
        Case "SB"
            elnum=51 : imass=122: fmass=121.7600
        Case "TE"
            elnum=52 : imass=128: fmass=127.6000
        Case "I"
            elnum=53 : imass=127: fmass=126.9045
        Case "XE"
            elnum=54 : imass=131: fmass=131.2900
        Case "CS"
            elnum=55 : imass=133: fmass=132.9054
        Case "BA"
            elnum=56 : imass=137: fmass=137.3270
        Case "LA"
            elnum=57 : imass=139: fmass=138.9055
        Case "CE"
            elnum=58 : imass=140: fmass=140.1160
        Case "PR"
            elnum=59 : imass=141: fmass=140.9076
        Case "ND"
            elnum=60 : imass=144: fmass=144.2400
        Case "PM"
            elnum=61 : imass=145: fmass=145.0000
        Case "SM"
            elnum=62 : imass=150: fmass=150.3600
        Case "EU"
            elnum=63 : imass=152: fmass=151.9640
        Case "GD"
            elnum=64 : imass=157: fmass=157.2500
        Case "TB"
            elnum=65 : imass=159: fmass=158.9253
        Case "DY"
            elnum=66 : imass=163: fmass=162.5
        Case "HO"
            elnum=67 : imass=165: fmass=164.9303
        Case "ER"
            elnum=68 : imass=167: fmass=167.2600
        Case "TM"
            elnum=69 : imass=169: fmass=168.9342
        Case "YB"
            elnum=70 : imass=173: fmass=173.0400
        Case "LU"
            elnum=71 : imass=175: fmass=174.9670
        Case "HF"
            elnum=72 : imass=178: fmass=178.4900
        Case "TA"
            elnum=73 : imass=181: fmass=180.9479
        Case "W"
            elnum=74 : imass=184: fmass=183.8400
        Case "RE"
            elnum=75 : imass=186: fmass=186.2070
        Case "OS"
            elnum=76 : imass=190: fmass=190.2300
        Case "IR"
            elnum=77 : imass=192: fmass=192.2170
        Case "PT"
            elnum=78 : imass=195: fmass=195.0780
        Case "AU"
            elnum=79 : imass=197: fmass=196.9666
        Case "HG"
            elnum=80 : imass=201: fmass=200.5900
        Case "TL"
            elnum=81 : imass=204: fmass=204.3833
        Case "PB"
            elnum=82 : imass=207: fmass=207.2000
        Case "BI"
            elnum=83 : imass=209: fmass=208.9804
        Case "PO"
            elnum=84 : imass=209: fmass=209.0000
        Case "AT"
            elnum=85 : imass=210: fmass=210.0000
        Case "RN"
            elnum=86 : imass=222: fmass=222.0000
        Case "FR"
            elnum=87 : imass=223: fmass=223.0000
        Case "RA"
            elnum=88 : imass=226: fmass=226.0000
        Case "AC"
            elnum=89 : imass=227: fmass=227.0000
        Case "TH"
            elnum=90 : imass=232: fmass=232.0381
        Case "PA"
            elnum=91 : imass=231: fmass=231.0359
        Case "U"
            elnum=92 : imass=238: fmass=238.0289
        Case "NP"
            elnum=93 : imass=237: fmass=237.0000
        Case "PU"
            elnum=94 : imass=244: fmass=244.0000
        Case "AM"
            elnum=95 : imass=243: fmass=243.0000
        Case "CM"
            elnum=96 : imass=247: fmass=247.0000
        Case "BK"
            elnum=97 : imass=247: fmass=247.0000
        Case "CF"
            elnum=98 : imass=251: fmass=251.0000
        Case "ES"
            elnum=99 : imass=252: fmass=252.0000
        Case "FM"
            elnum=100 : imass=257: fmass=257.0000
        Case "MD"
            elnum=101 : imass=258: fmass=258.0000
        Case "NO"
            elnum=102 : imass=259: fmass=259.0000
        Case "LR"
            elnum=103 : imass=262: fmass=262.0000
        Case "KU"
            elnum=104 : imass=265: fmass=Dbl(imass)
        Case else
            elnum=0:imass=0: fmass=0.0 : AtProp=FALSE
  End Select
End Function

'''''''''''''''''''''''''
function ElementExists(struc as object,byval e1 as integer) as boolean
Dim asm,at As Object
  asm=struc.Assembly
  For Each at In asm
    If e1=at.GetElNumber Then
      ElementExists=TRUE
      exit function
    End If
  Next at
ElementExists=FALSE
End Function

'***LIBRARY PROCEDURES END