'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ACD CHEMBASIC DEMO PROGRAM                                          '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' Label Printer//LPRINTER.BAS                                         '
'                                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' This program  prepares and prints out the labels for chemicals.     '
'                                                                     '
' It accepts the molecules from active ChemSketch page,               '
' makes the labels filled with info on particular molecules and       '
' outputs them into newly created document. At the end, the program   '
' prints out the labels on a printer.                                 '
'                                                                     '
' If specIfied in label form, the labels will be automatically        '
' filled in  with molecular weight, name (IUPAC; requires that you    '
' have ACD/Name installed), brutto formula, and structure.            '
'                                                                     '
' There should exist the SK2 file with label sheet template           '
'(default name is as_5095.sk2) which should reside in LPRINTER        '
' directory. This file 1st page contains layout of label forms        '
' on the sheet.                                                       '
' The 2nd page contains single form with its layout                   '
' (and nothing else! Be sure that all what you place on that 2nd page '
' is reproduced upon label generating.)                               '
'                                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


' GLOBAL VARS AND CONSTANTS

'ERR CODES
CONST OK=0
CONST INVALID_PAGES_QTY=1
CONST NOSUCHFILE="File not found. Please check the name and path."
CONST EMPTYPAGE="Sorry, your page is empty."
CONST NOFORMS="Sorry, your page contains no forms."
'FORM TEXTBOXES KIND
CONST SOME_STRING=0
CONST USERDEFD_STRING=1
CONST MOLWT=2
CONST BRUTTOFORMULA=3
CONST IUPACMOLNAME=4
CONST MOLSTRUCTURE=5
'MISC
DIM ButtonPressed As Integer


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Main As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LPRINTER.BAS                                                        '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Form,FormDoc,FormPage,SheetDoc,SheetPage  As Object
Dim MolPage,LabelDoc,LabelPage As Object
Dim NTextBoxes, NDiagrams,Result, i,NLabel,nn,ll,tt,ww,hh As Integer
Dim FrameL,FrameT,FrameW,FrameH,lp(1),tp(1),wp(1),hp(1),nlsorted(1) As Integer
Dim NLRow,NLCol,NLPage,NLStart As Integer
Dim TBKind(),TBFrameL(),TBFrameT(),TBFrameH(),TBFrameW() As Integer
Dim TBContent() As String, Done As Boolean, sform,ss As Double
Dim ErrorMsg, ToPrint, ImpFile, TemplFile As String
Dim ImpFileExists, TemplFileExists As Boolean 
Dim ShouldDestroyMolPage As Boolean


' Setting up
  Main="Label Printer finished."
  Result=OK
  FormDoc=NULL
  SheetDoc=NULL
  MolPage = ActiveDocument.ActivePage
  ShouldDestroyMolPage = False
  ImpFile="Test.sdf"
  TemplFile="As_5095.sk2"
  ToPrint=""
  
  Do
    ' Analyze molecules page and import from SDF If necessary
    If MolPage.Diagrams.Count<1 Then
      Form = ReadFormFromLib("Lprinter.frl","Label Printer - SDF and Template Loading")
      Form.SetStrValue("FileName", ImpFile)
      Form.SetStrValue("TemplFile", TemplFile)
      Form.SetStrValue("Print", ToPrint)
      ' Display dialog
      If Form.ExecForm Then
        ImpFile = Form.GetStrValue("FileName")
        TemplFile = Form.GetStrValue("TemplFile")
        ToPrint = Form.GetStrValue("Print")
        ImpFileExists = FileExists(ImpFile)
        TemplFileExists = FileExists(TemplFile)
      Else 
        Main="Cancelled."
        Exit Function
      End If
    Else
      Form = ReadFormFromLib("Lprinter.frl","Label Printer - Template Loading")
      Form.SetStrValue("TemplFile", TemplFile)
      Form.SetStrValue("Print", ToPrint)
      ' Display dialog
      If Form.ExecForm Then
        TemplFile = Form.GetStrValue("TemplFile")
        ToPrint = Form.GetStrValue("Print")
        ImpFile = ""
        ImpFileExists = True
        TemplFileExists = FileExists(TemplFile)
      Else 
        Main = "Cancelled."
        Exit Function
      End If
    End If

    if not ImpFileExists and FileExists(AddDefaultExtension(ImpFile, "SDF")) then
      ImpFile = AddDefaultExtension(ImpFile, "SDF")
      ImpFileExists = True
    end if

    if not ImpFileExists then
      ErrorMsg = "File " + ImpFile + " was not found." + Chr(13) + Chr(13) + "Check the file name."
    else
      if not TemplFileExists then
        ErrorMsg = "File " + TemplFile + " was not found." + Chr(13) + Chr(13) + "Check the file name."
      else
        ErrorMsg = ""
      end if
    end if
    If ErrorMsg <> "" Then
      MessageBox(ErrorMsg, "Label Printer", MBB_OK or MBI_EXCLAMATION)
    End If
  Loop While ErrorMsg <> ""

  If ImpFile <> "" Then
    'MessageBox(ImpFile, "Label Printer", MBB_OK or MBI_EXCLAMATION)
    MolPage = ActiveDocument.AddEmpty
    ShouldDestroyMolPage = True
    Done = ImportSDF(ImpFile)
    If Not Done Then
      If MolPage <> NULL Then Kill(MolPage)
      Stop "Sorry, importing failed."
    End If
  End If

'Get sheet-layout page
  If Not GetSheet(SheetDoc,SheetPage,lp,tp,wp,hp,NLPage,NLStart, TemplFile) Then GoTo ShutDown
'Get form
  FormDoc=SheetDoc
  If Not GetForm(FormDoc,FormPage) Then GoTo ShutDown
'Init form layout
  If Not InitForm(FormPage,NTextBoxes,TBKind,TBContent,TBFrameL,TBFrameT,TBFrameH,TBFrameW,FrameL,FrameT,FrameW,FrameH) Then GoTo ShutDown
'Init sheet layout
  If Not InitSheet(SheetDoc,SheetPage,NLPage,lp,tp,wp,hp,nlsorted) Then GoTo ShutDown
'Init molecules
  NDiagrams=MolPage.Diagrams.Count

'Fill in the labels - go through molecules/labels
  LabelDoc=Documents.AddEmpty
  LabelPage = LabelDoc.Item(1)
  nn=NLStart-1
  For NLabel=1 To NDiagrams
    nn=nn+1
    ll=lp(nlsorted(nn))
    tt=tp(nlsorted(nn))
    ww=wp(nlsorted(nn))
    hh=hp(nlsorted(nn))
    MakeLabel(NLabel,LabelPage,MolPage,FormPage,NTextBoxes,TBKind,TBContent,TBFrameL,TBFrameT,TBFrameH,TBFrameW,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)
    If nn>=NLPage Then
      nn=0
      If NLabel<Ndiagrams Then LabelPage = ActiveDocument.AddEmpty
    End If
  Next NLabel

  If ToPrint="Print labels" Then ActiveDocument.PrintDoc

ShutDown:
  Main = StrErrorMess(result)
  If ShouldDestroyMolPage And MolPage <> NULL Then Kill(MolPage)
  If SheetDoc <> FormDoc And SheetDoc <> NULL Then Kill(SheetDoc)
  If FormDoc <> NULL Then Kill(FormDoc)

End Function 'Main

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function FileExists(ByVal FileName As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s As String

  FileExists = FindFirst(FileName, s)

End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetForm(FormDoc As Object,FormPage As Object) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim doc,obj As object, namedoc As String, s As Double, i, nd As Integer
Dim l,t,w,h As Integer
  GetForm=False
  If FormDoc.Count<2 Then
    ButtonPressed=MessageBox("Too little pages in template sheet. Please check.", "Label Printer", MBB_OK + MBI_EXCLAMATION)
    Exit Function
  Else
    FormPage = FormDoc.Item(2)
    GetForm=True
  End If
End Function 'GetForm




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetSheet(SheetDoc As Object,SheetPage As Object,lp() As Integer,tp() As Integer,wp() As Integer,hp() As Integer,NLPage As Integer,NLStart As Integer, TemplFile As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get info on label page layout                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Form, doc,obj As Object, namedoc,ans As String, LabNum,i,k,nd,nn,nrect,nrrect As Integer
  GetSheet=False

  namedoc=TemplFile
  namedoc=UCASE(namedoc)
  doc=Documents.AddFromFile(namedoc,FT_SKETCH)
  If doc=NULL Then
    ButtonPressed=MessageBox("File "+namedoc+" not found. Please check the name and path.", "Label Printer", MBB_OK + MBI_EXCLAMATION)
    Exit Function
  End If
  SheetPage = doc.Item(1)
  If SheetPage=NULL Then
    ButtonPressed=MessageBox(EMPTYPAGE, "Label Printer", MBB_OK + MBI_EXCLAMATION)
    Exit Function
  End If
  call doc.SetActivePage(SheetPage)

  'Count rectangles on the sheet (note that round rectangles are now allowed!)
  nrect=CountObjects(SheetPage,CS_RECTANGLE)
  nrrect=CountObjects(SheetPage,CS_RNDRECT)
  If (nrect+nrrect)<1 Then
    ButtonPressed=MessageBox(NOFORMS, "Label Printer", MBB_OK + MBI_EXCLAMATION)
    Exit Function
  End If

  SheetDoc=doc
  NLPage=nrect+nrrect

  'Fill in array of positional parameters for the label forms on the sheet
  ReDim lp(NLPage)
  ReDim tp(NLPage)
  ReDim wp(NLPage)
  ReDim hp(NLPage)
  With SheetPage.Drawings
      nd=.Count
      nn=0
      For i=1 To nd
        obj=.Item(i)
        k=obj.GetType
        If k=CS_RECTANGLE Or k=CS_RNDRECT Then
          nn=nn+1
          obj.GetBound(lp(nn),tp(nn),wp(nn),hp(nn))
        End If
     Next i
  End With

  'Ask for start label number
  'Form executing
  Do
      Form = ReadFormFromLib("Lprinter.frl","Label Printer - Label Option")
      Form.SetStrValue("Remark","Your label sheet contains "+Str(NLPage)+" labels.")
      If Form.ExecForm Then
           LabNum=Form.GetIntValue("Label")
           ans=Str(LabNum)
      Else 
           Exit Function
      End If
  Loop While LabNum>NLPage
  NLStart=Fix(Val(ans))
  If NLStart<1 Or NLStart>NLPage Then NLStart=1

  GetSheet=True
End Function 'GetSheet




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function InitForm(FormPage As Object,NTextBoxes As Integer,TBKind() As Integer, TBContent() As String,TBFrameL() As Integer,TBFrameT() As Integer,TBFrameH() As Integer,TBFrameW() As Integer,FrameL  As Integer,FrameT As Integer,FrameW As Integer,FrameH As Integer) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get info on label form                                              '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TB,obj As Object, CurTBContent, Bracketed, LayoutDel As String
Dim i, beg, tail,nd,nn,l,t,w,h,k As Integer,s,sform As Double

  InitForm=True
  LayoutDel = "N"
  NTextBoxes=CountObjects(FormPage,CS_TEXTBOX)
  ReDim TBKind(1 To NTextBoxes)      As Integer
  ReDim TBContent(1 To NTextBoxes)   As String
  ReDim TBFrameL(1 To NTextBoxes)    As Integer
  ReDim TBFrameT(1 To NTextBoxes)    As Integer
  ReDim TBFrameH(1 To NTextBoxes)    As Integer
  ReDim TBFrameW(1 To NTextBoxes)    As Integer

  For i=1 To NTextBoxes
    TB=GetObject(FormPage,CS_TEXTBOX,i)
    With TB
      CurTBContent=.GetContent
      CurTBContent=LTrim(CurTBContent) : CurTBContent=RTrim(CurTBContent)
      beg = SubstrPos(0,CurTBContent, "[") : tail = SubstrPos(0,CurTBContent, "]")
      If (beg > 0 And tail > 0) Then
        Bracketed = Mid(CurTBContent, beg, tail - beg+1)
        Bracketed=LTrim(Bracketed):Bracketed=RTrim(Bracketed)
        Bracketed = UCase(Bracketed)
      Else
        Bracketed = ""
      End If
      Select Case Bracketed
        Case "[.EACH]"
          TBKind(i)=SOME_STRING
        Case "[MW.AUTO]"
          TBKind(i)=MOLWT
          CurTBContent=Left(CurTBContent, beg-1) 'hold user-defd tag for MW
        Case "[BRUTTO.AUTO]"
          TBKind(i)=BRUTTOFORMULA
          CurTBContent=Left(CurTBContent, beg-1) 'hold user-defd tag
        Case "[IUPACNAME.AUTO]"
          TBKind(i)=IUPACMOLNAME
          CurTBContent=Left(CurTBContent, beg-1) 'hold user-defd tag
        Case "[STRUCTURE.AUTO]"
          TBKind(i)=MOLSTRUCTURE
          CurTBContent=Left(CurTBContent, beg-1) 'hold user-defd tag
        Case Else
          TBKind(i)=SOME_STRING
      End Select
      If (TBKind(i)=MOLSTRUCTURE) Then
        .GetBound(TBFrameL(i),TBFrameT(i),TBFrameW(i),TBFrameH(i))
      Else
        TBFrameL(i)=0 :TBFrameT(i)=0 :TBFrameH(i)=0 :TBFrameW(i)=0
      End If
    End With
    TBContent(i)=CurTBContent
  Next i

  'Find the largest [rnd] rectangle
  sform=0.0
  With FormPage.Drawings
      nd=.Count
      For i=1 To nd
        obj=.Item(i)
        k=obj.GetType
        If k=CS_RECTANGLE OR k=CS_RNDRECT Then
          obj.GetBound(l,t,w,h)
          s=Dbl(w*h)
          If s>sform Then
            sform=s
            nn=i
          End If
        End If
     Next i
  End With

  obj=FormPage.Drawings.Item(nn)
  obj.GetBound(FrameL,FrameT ,FrameW,FrameH)
End Function 'InitForm



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function InitSheet(SheetDoc As Object,SheetPage As Object,NLPage As Integer,lp() As Integer,tp() As Integer,wp() As Integer,hp() As Integer,nlsorted() As Integer) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i,j,si,sj,l,t,lj,tj,tmp,epsl,epst,eps,dl,dt,absdl,absdt As Integer
Dim less,lefter, toper As Boolean
Dim sss As String
  InitSheet=False
  epsl=Fix(wp(1)*0.5)
  epst=Fix(hp(1)*0.5)
  eps=100
  ReDim nlsorted(NLPage)
  For i=1 To NLPage
    nlsorted(i)=i
  Next i
  ' Sort
  For i=1 To NLPage-1
    For j=i+1 To NLPage
      l=lp(nlsorted(i))
      t=tp(nlsorted(i))
      lj=lp(nlsorted(j))
      tj=tp(nlsorted(j))
      less=False
      dl=lj-l : absdl=Fix(Abs(dl))
      dt=tj-t : absdt=Fix(Abs(dt))
      If (dt<-epst) Then
        less=True : GoTo nexts
      End If
      If (dl<-epsl) Then
        If absdt<eps Then
          less=True : GoTo nexts
        End If
      End If
nexts:
      If less Then
        tmp=nlsorted(i):nlsorted(i)=nlsorted(j):nlsorted(j)=tmp
      End If
    Next j
  Next i
  For i=1 to NLPage
  print "No ",nlsorted(i)," LEFT=",lp(nlsorted(i))," TOP=",tp(nlsorted(i))
  Next i
  InitSheet=True
End Function 'InitSheet



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub MakeLabel(NLabel As Integer,LabelPage As Object,MolPage As Object,FormPage As Object,ByVal NTextBoxes As Integer,TBKind() As Integer, TBContent() As String,TBFrameL() As Integer,TBFrameT() As Integer,TBFrameH() As Integer,TBFrameW() As Integer,FrameL As Integer,FrameT As Integer,FrameW As Integer,FrameH As Integer,ll  As Integer,tt As Integer,ww  As Integer,hh  As Integer)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim Diagram,NewDiagram,TB,NewTB,NewDraw,ob As Object
Dim i,l,t,w,h,l1,t1,w1,h1,SkH,SkW,SkL,SkT As Integer
Dim ScalingFactor As Double,NewTBContent As String

  Diagram=GetObject(MolPage,CS_DIAGRAM,NLabel)

  ' For all drawings in the source form
  For i=1 to  FormPage.Drawings.Count
    ob=FormPage.Drawings.Item(i)
    If ob.GetType<>CS_TEXTBOX Then
      NewDraw=ob.LoadOnto(LabelPage)
      Call AdjustFrame(NewDraw,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)
    End If
  Next i

  ' For all textboxes in the source form
  For i=1 To NTextBoxes
  ' [i indexes both old and new textboxes]
    ' copy textbox to label
    TB=GetObject(FormPage,CS_TEXTBOX,i)
    ' settle its content
    Select Case TBKind(i)
      Case USERDEFD_STRING
          NewTB = TB.LoadOnto(LabelPage)
          Call AdjustFrame(NewTB,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)
          NewTB.SetContent(TBContent(i))

      Case MOLWT
        NewTB = TB.LoadOnto(LabelPage)
        Call AdjustFrame(NewTB,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)
        NewTB.SetContent(TBContent(i)+FStr(Diagram.GetMolWeight,8,2))

      Case BRUTTOFORMULA
        NewTB = TB.LoadOnto(LabelPage)
        NewTB.SetContent(TBContent(i)+ Diagram.GetBrutto)
        Call AdjustFrame(NewTB,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)

      Case IUPACMOLNAME
        NewTB = TB.LoadOnto(LabelPage)
        NewTB.SetContent(TBContent(i)+ Diagram.GetIUPACName)
        Call AdjustFrame(NewTB,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)

      Case MOLSTRUCTURE
        'very special case - structure replaces text within text frame
        NewDiagram=Diagram.LoadOnTo(LabelPage)
        NewDiagram.SetBound(TBFrameL(i),TBFrameT(i),Fix(TBFrameW(i)),Fix(TBFrameH(i)))
        Call AdjustFrame(NewDiagram,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)

      Case Else
        NewTB = TB.LoadOnto(LabelPage)
        NewTB.SetContent(TBContent(i))
        Call AdjustFrame(NewTB,FrameL,FrameT,FrameW,FrameH,ll,tt,ww,hh)
    End Select
  Next i 'NTextBoxes

End Sub 'MakeLabel




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub AdjustFrame(obj As Object,FrameL As Integer,FrameT As Integer,FrameW As Integer,FrameH As Integer,ll As Integer,tt As Integer,ww As Integer,hh As Integer)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Adjusts the Obj's frame size and position to that given             '
' by Framek and kk  , k=[l,t,w,h]                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim l,t,w,h,l1,t1,w1,h1 As Integer, sw,sh As Double
    obj.GetBound(l,t,w,h)
    sw=Dbl(ww)/Dbl(FRameW)
    sh=Dbl(hh)/Dbl(FRameH)
    l1=ll+Fix( Dbl(l-FrameL)* sw)
    t1=tt+Fix( Dbl(t-FrameT)* sh )
    w1=Fix( Dbl(w)* sw)
    h1=Fix( Dbl(h)* sh)
    obj.SetBound(l1,t1,w1,h1)
End Sub 'AdjustFrame




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function CountObjects(Page As Object, ByVal TypeVal As Integer) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Counts objects of type TypeVal on a page Page                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim k As Integer, Drw,Obj As Object
  If TypeVal=CS_TEXTBOX Then
    CountObjects=Page.TextBoxes.Count
    Exit Function
  EndIf
  If TypeVal=CS_DIAGRAM Then
    CountObjects=Page.Diagrams.Count
    Exit Function
  EndIf
  Drw=Page.Drawings
  k=0
  For Each Obj In Drw
    If Obj.GetType=TypeVal Then k=k+1
  Next Obj
  CountObjects=k
End Function 'CountObjects




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetObject(Page As Object, ByVal TypeVal As Integer,Byval index As Integer) As Object
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Gets the index-th object of type TypeVal from a page Page           '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim k As Integer, Drw, Obj As Object
  GetObject=NULL
  If TypeVal=CS_TEXTBOX Then
    GetObject=Page.TextBoxes.Item(index) : Exit Function
  EndIf
  If TypeVal=CS_DIAGRAM Then
    GetObject=Page.Diagrams.Item(index)  : Exit Function
  EndIf
  Drw=Page.Drawings
  k=0
  For Each Obj In Drw
    If Obj.GetType=TypeVal Then
      k=k+1
      If index=k Then
        GetObject=Obj : Exit Function
      End If
    End If
  Next Obj
End Function 'GetObject


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ImportSDF(ByVal FileMask As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Invokes import from MDL's SDF into ChemSk                           '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s, fnames(3) As String
Dim nf, i As Integer
Dim Done As Boolean
Const promptdpp=" files found. Press <CR> for this one or <Space> for the next"

  ImportSDF=False
  nf = GetFileNames(FileMask, fnames)
  If nf<1 Then
    Exit Function
  Else
    If nf=1 Then     'have 1 file
      s=fnames(1)
    Else              'have many files, must select one
      for i=1 to nf
        s = UCase(UserIOBox(Str(nf)+promptdpp, "Label Printer // Import SDF file data" , fnames(i)))
        If s="" Then
          exit function
        End If
        If s=fnames(i) Then goto proceed
      next i
      exit function
    End If
  End If

proceed:
  Done = ImportFromSDF(s)
  ImportSDF = Done
  If Not Done Then
    MessageBox("Failed @ reading/converting the file "+fnames(i), "Label Printer // Import SDF file data" , MBB_OK + MBI_EXCLAMATION)
    Exit Function
  End If

End Function 'ImportSDF



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function ImportFromSDF(byval fname As String) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Imports MDL's SDF file  fname  into ACD's ChemSketch                '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s,atname,filename,cont As String, x,y,z As double
Dim natoms,nbonds,natom1,natom2,elnum,bord As Integer
Dim nn,i,ii,flag,read_flag,dummy,l,t,w,h,pw,ph As Integer
Dim atom,atom1,atom2,bond,workpage,tbox, diag,assm,mol,conf,struct As object
Const bucks4="$$$$"

  ImportFromSDF=True
  Open fname Access Read As #2
  s=bucks4
  workpage=ActiveDocument.ActivePage
  If Not SketchPageIsEmpty(workpage) Then workpage=ActiveDocument.AddEmpty
  ActiveDocument.SetActivePage(workpage)
  pw=workpage.GetWidth
  ph=workpage.GetHeight
  w=Fix (Dbl(pw)/4.0)
  h=Fix (Dbl(pw)/6.0)
  l=Fix (Dbl(pw)/10.0)
  t=Fix (Dbl(pw)/20.0)

  nn=0
  While DelSpace(s)=bucks4
    ' Go through SDF file records
    read_flag=0
    assm=Assemblies.AddEmpty : mol=assm.Molecules.AddEmpty : conf=assm.Conformations.AddEmpty
    struct=assm.structures.Derive(mol,conf)

    read #2,s,80
    read #2,s,80
    If s="" Then
        Close #2
        Exit function      ' EOF
    EndIf
    read #2,s,80
    read #2,s,80
    If s="" Then
        close #2
        exit function      ' EOF
    EndIf

    natoms=IVMid(s,1,3)
    nbonds=IVMid(s,4,3)

    If (natoms>0) And (nbonds>0) Then

    nn=nn+1

' Read atoms
    For i=1 To natoms
      read #2,s,80
      x=VMid(s,1,10) : y=VMid(s,11,10) : z=VMid(s,21,10)
      atname=DelSpace(Mid(s,32,3))
      elnum=GetElNumBySym(atname)
      atom=NewAtom(elnum)
      struct.Assembly.Add(atom)
      struct.SetAtomXYZ(atom,x,y,z)
    Next i
    ' Read bonds
    For i=1 To nbonds
      Read #2,s,80
      natom1=IVMid(s,1,3) : natom2=IVMid(s,4,3)
      bord=IVMid(s,7,3)
      atom1=struct.Assembly.Item(natom1)
      atom2=struct.Assembly.Item(natom2)
      If bord<1 Or bord>3 Then bord=1
      If atom1<>NULL and atom2<>NULL Then
        bond=NewBond(atom1,atom2,bord)
        struct.Molecule.Add(bond)
      End If
    next i


' Show
    diag=ActiveDocument.ActivePage.Diagrams.AddEmpty
    diag.Depict(struct)
    If ( (nn Mod 2) = 0) Then
      l=Fix (Dbl(pw)/10.0)+Fix(1.5*w)
    Else
      l=Fix (Dbl(pw)/10.0)
      t=t+Fix(h*1.1)
    End If
    diag.SetBound(l,t,w,h) '100,300,700,800)

    read #2,s,80

    If s<>"M End" Then
      print "Structure field error" : read_flag=1
    End If

    End If

    ii=300
    flag=0

    While s<>bucks4
' Go through text fields
      cont=""
      If read_flag<>1 Then s="z"

      While Len(s)<>0 and DelSpace(s)<>"$$$$"
        If read_flag=0 Then Read #2,s,80
        read_flag=0
        If DelSpace(s)<>"$$$$" Then cont=cont+s
        flag=1
      WEnd
      If Len(s)=0 or DelSpace(s)="$$$$" and flag=1 Then
        ii=ii+100
      End If
    WEnd ' go through text fields

  WEnd ' go through SDF records
  ImportFromSDF=True
  close #2
End function ' ImportFromSDF




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetElNumBySym(ByVal ElSymb As String) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Return element number by its chem symbol                            '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim s As String, n As Integer
  n=0
  s=UCase(ElSymb)
  Select Case s
        Case "H"
          n=1
        Case "HE"
          n=2
        Case "LI"
          n=3
        Case "BE"
          n=4
        Case "B"
          n=5
        Case "C"
          n=6
        Case "N"
          n=7
        Case "O"
          n=8
        Case "F"
          n=9
        Case "NE"
          n=10
        Case "NA"
          n=11
        Case "MG"
          n=12
        Case "AL"
          n=13
        Case "Si"
          n=14
        Case "P"
          n=15
        Case "S"
          n=16
        Case "CL"
          n=17
        Case "AR"
          n=18
        Case "K"
          n=19
        Case "CA"
          n=20
        Case "SC"
          n=21
        Case "TI"
            n=22
        Case "V"
            n=23
        Case "CR"
            n=24
        Case "MN"
            n=25
        Case "FE"
            n=26
        Case "CO"
            n=27
        Case "NI"
            n=28
        Case "CU"
            n=29
        Case "ZN"
            n=30
        Case "GA"
            n=31
        Case "GE"
            n=32
        Case "AS"
            n=33
        Case "SE"
            n=34
        Case "BR"
            n=35
        Case "KR"
            n=36
        Case "RB"
            n=37
        Case "SR"
            n=38
        Case "Y"
            n=39
        Case "ZR"
            n=40
        Case "NB"
            n=41
        Case "MO"
            n=42
        Case "TC"
            n=43
        Case "RU"
            n=44
        Case "RO"
            n=45
        Case "PD"
            n=46
        Case "AG"
            n=47
        Case "CD"
            n=48
        Case "IN"
            n=49
        Case "SN"
            n=50
        Case "SB"
            n=51
        Case "TE"
            n=52
        Case "I"
            n=53
        Case "XE"
            n=54
        Case "CS"
            n=55
        Case "BA"
            n=56
        Case "LA"
            n=57
        Case "CE"
            n=58
        Case "PR"
            n=59
        Case "ND"
            n=60
        Case "PM"
            n=61
        Case "SM"
            n=62
        Case "EU"
            n=63
        Case "GD"
            n=64
        Case "TB"
            n=65
        Case "DY"
            n=66
        Case "HO"
            n=67
        Case "ER"
            n=68
        Case "TM"
            n=69
        Case "YB"
            n=70
        Case "LU"
            n=71
        Case "HF"
            n=72
        Case "TA"
            n=73
        Case "W"
            n=74
        Case "RE"
            n=75
        Case "OS"
            n=76
        Case "IR"
            n=77
        Case "PT"
            n=78
        Case "AU"
            n=79
        Case "HG"
            n=80
        Case "TL"
            n=81
        Case "PB"
            n=82
        Case "BI"
            n=83
        Case "PO"
            n=84
        Case "AT"
            n=85
        Case "RN"
            n=86
        Case "FR"
            n=87
        Case "RA"
            n=88
        Case "AC"
            n=89
        Case "TH"
            n=90
        Case "PA"
            n=91
        Case "U"
            n=92
        Case "NP"
            n=93
        Case "PU"
            n=94
        Case "AM"
            n=95
        Case "CM"
            n=96
        Case "BK"
            n=97
        Case "CF"
            n=98
        Case "ES"
            n=99
        Case "FM"
            n=100
        Case "MD"
            n=101
        Case "NO"
            n=102
        Case "LR"
            n=103
        Case "RF"
            n=104
  End Select
  GetElNumBySym=n
End Function 'GetElNumBySym



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function StrErrorMess(byval errcode As Integer) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Select Case errcode
    Case OK
      StrErrorMess="Label Printer finished."
    Case INVALID_PAGES_QTY
      StrErrorMess="Document contains less than 2 pages."
    Case Else
      StrErrorMess="Unresolved error"
  End Select
End Function 'StrErrorMess




'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SubstrPos(ByVal start As Integer,ByVal s1 As String,ByVal s2 As String) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  Returns the position of the first occurrence                       '
'  of one string within another                                       '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i As Integer, ls1 As Integer, ls2 As Integer, z As String
  SubstrPos=0
  ls1=Len(s1) : If (ls1=0) Then Goto Ends
  ls2=Len(s2) : If (start>ls2) Then  Goto Ends
  If (ls2=0) Then
    SubstrPos=start : Goto Ends
  End If
  If (start<1) Then start=1
  For i=1 To ls1-ls2+1
    z=Mid(s1,i,ls2)
    If z=s2 Then
      SubstrPos=i : GoTo Ends
    End If
  Next i
Ends:
End Function 'SubstrPos



'***LIBRARY PROCEDURES BEGIN



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function SketchPageIsEmpty(p As Object) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Checks if the sketch page is empty                                  '
'                                                                     '
' ENTER                                                               '
'     p               object of type CS_PAGE                          '
' EXIT                                                                '
'     returns TRUE if the page is empty otherwise FALSE               '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  If p.Drawings.Count>0 Then
    SketchPageIsEmpty=False
  Else
    SketchPageIsEmpty=True
  End If
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function AddDefaultExtension(ByVal FileName As String, ByVal DefExt As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' If FileName doesn't have extension then add defext extension to it  '
'                                                                     '
' ENTER                                                               '
'     FileName     suppiled file name                                 '
'     DefExt       default file extension                             '
' EXIT                                                                '
'     returns file name appended with extension, if necessary         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Dim PointPos, BackslashPos As Integer
  PointPos = RInStr(FileName, ".")
  If PointPos = 0 Then
    AddDefaultExtension = FileName + "." + DefExt
  Else
    BackslashPos = RInStr(FileName, "\")
    If BackslashPos > PointPos Then 
      AddDefaultExtension = FileName + "." + DefExt
    Else
      AddDefaultExtension = FileName
    End If
  End If
End Function

' Returns the rightmost position of substring SubStr inside string S, 0 if S doesn't contain SubStr
Function RInStr(ByVal S As String, ByVal SubStr As String) As Integer
Dim I As Integer

  I = 0
  Do 
    RInStr = I
    I = InStr(I + 1, S, SubStr)
  Loop While I <> 0

End Function


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetFileNames(ByVal mask As String, ByRef fnames() As String) As Integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Get filenames adhering the mask                                     '
' and stores them into a string array                                 '
'                                                                     '
' ENTER                                                               '
'     mask         source filename mask (wildcards are accepted)      '
' EXIT                                                                '
'     returns number of files or 0                                    '
'     fnames() is properly dimensioned array of the names             '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim found As Boolean, fname, dirname As String, nf As Integer
  ' First count
  nf = 0
  found = FindFirst(mask,fname)
  If found Then
    While found
      nf = nf + 1
      found = FindNext(fname)
    WEnd
  Else
    GetFileNames = 0
    Exit Function
  End if

  ' Now get them
  Redim fnames(nf + 1)

  dirname = JustPathName(mask)
  nf = 0
  found = FindFirst(mask, fname)
  While found
    nf = nf + 1
    fnames(nf) = dirname + fname
    found = FindNext(fname)
  WEnd
  GetFileNames = nf
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function DelSpace(ByVal strn As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Deletes all spaces in the string                                    '
'                                                                     '
' ENTER                                                               '
'     strn            source string                                   '
' EXIT                                                                '
'     returns processed string                                        '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim i,lt As Integer, c,s As String
  s=""
  lt=Len(strn)
  For i=1 To lt
    c=Mid(strn,i,1)
    If c<>" " Then s=s+c
  Next i
  DelSpace=s
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function IVMid(s as string,byval start as integer,byval leng as integer) as integer
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Take Int(Val(Mid()))                                                '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  IVMid=Int(Val(Mid(s,start,leng)))
End Function
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function VMid(s as string,byval start as integer,byval leng as integer) as double
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Take Val(Mid())                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  VMid=Val(Mid(s,start,leng))
End Function

'***LIBRARY PROCEDURES END