'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ACD CHEMBASIC DEMO PROGRAM                                          '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' Molecular 3D Editor// MOL2SK.BAS                                    '
'                                                                     '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'                                                                     '
' The utility imports MDL's .MOL files                                '
'                                                                     '
' NOTE: in contrast with ChemBasic built-in AddFromFile importing     '
'        and ChemSketch own Import (File|Import)                      '
'       the utility accepts wildcards and treats multiple (<100)files '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''


CONST TITLE="ChemBasic Molecular Editor // Import MOL"
CONST NOSUCHFILE="File not found. Please check the name and path."
CONST DEFAULT_LEFT=200
CONST DEFAULT_TOP=200
CONST DEFAULT_TEXT_LEFT=1000
CONST DEFAULT_TEXTBOX_WID=800
CONST DEFAULT_TEXTBOX_HEI=100


'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Main As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' MOL2SK.BAS                                                          '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim nf,nb,na,i,nimp,ndpp,ans  As Integer, mask,bf,s,fname,fnames()  As String, OK As Boolean
Dim diag,struc As Object
Const defext="MOL"
Const promptdpp=" files found. Place each structure on a separate page?"

  Main="Failed or nothing to do!"

  'Get names
  mask = AskForfile(defext)
  If (mask="") Then
    Main="Import cancelled"
    Exit Function
  End If

  nf=GetFileNames(mask,fnames)

  'Get data
  If nf<1 Then
    Main=NOSUCHFILE
    Exit Function
  Else
    ndpp=1
    If  nf>1 Then
      ans=MessageBox(Str(nf)+promptdpp, TITLE, MBB_YESNOCANCEL + MBI_QUESTION)
      If ans=MBR_CANCEL Then Exit Function
      If ans=MBR_NO Then ndpp=9999
    End If
  End if

  ' Cycle through files
  nimp=0
  For i=1 To nf
    If (nimp>=100) Then
      MessageBox("Could not import more than 100 structures, aborting", TITLE, MBB_OK + MBI_EXCLAMATION)
      Goto ends
    End If
    OK = ImportAndShow(fnames(i),struc,diag,ndpp,nimp)
    If Not OK Then
      MessageBox("Failed @  "+fnames(i), TITLE , MBB_OK + MBI_EXCLAMATION)
    Else
      nimp=nimp+1
    End if
  Next i

  ' Bye
ends:
  If (nf>1) Then
    Main="Imported: "+Str(nimp)+" of "+Str(nf)+" files"
  Else
    If nimp>0 Then
      na=Struc.Assembly.Count
      nb=Struc.Molecule.Count
      bf=Diag.GetBrutto
    Else
      na=0
      nb=0
      bf="***"
    End if
    Main="Imported: "+Str(na)+" [heavy] atoms, "+Str(nb)+ " bonds, " + bf + "."
  End If
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
function ImportAndShow(byval fname as string,Struc as object,Diag as object,ndpp as integer,nimp as integer) as boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Catch the mol from a file                                           '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim ob As object, OK As boolean, idpp As Integer
  ob=Assemblies.AddFromFile(fname,1)
  If ob<>NULL Then
    Struc= ob.Structures.Item(1)
    idpp=(nimp-ndpp*(nimp\ndpp))
    AddAndShowDiagram(Struc,Diag,idpp,fname)     'same page
    ImportAndShow=TRUE
  Else
    ImportAndShow=FALSE
  End If
End Function



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub AddAndShowDiagram(Struc As Object,Diag As Object,byval idpp as integer,byval fname as string)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Add diagram to those already in ChemSketch                          '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim l,t,w,h,maxl,maxt,wmax,hmax,prev_bottom as integer,pg,dg as object
  With ActiveDocument
    pg=.ActivePage
    If idpp<>0 Then
      prev_bottom=-1
      For each dg in pg.Diagrams      'find a place
        dg.GetBound(l,t,w,h) : if t+h>prev_bottom then prev_bottom = t+h
      Next dg
      l=DEFAULT_LEFT : t=prev_bottom : w=0 : h=0
    Else
      If ( (.Count<>1) Or (pg.Drawings.Count>0) ) Then pg=.AddEmpty
      l=DEFAULT_LEFT : t=DEFAULT_TOP : w=0 : h=0
    End If
    Diag=pg.Diagrams.AddEmpty
    ShowMolDiagram(Struc,Diag,l,t,w,h,fname)
  End with
End Sub



'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ShowMolDiagram(struc As Object,diag As Object,ByVal l As Integer,ByVal t As Integer,ByVal w As Integer,ByVal h As Integer,byval fname as string)
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Depict structure as ChemSketch's diagram                            '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim tb As object,l1,t1,w1,h1 As Integer
  With diag
    .Depict(Struc)
    .GetBound(l1,t1,w1,h1)
    If w>0 Then w1=w
    If h>0 Then h1=h
    If l>0 Then l1=l
    If t>0 Then t1=t
    .SetBound(l1,t1,w1,h1)
    If fname<>"" Then
      tb=ActiveDocument.ActivePage.TextBoxes.AddEmpty
      tb.SetContent(fname)
      tb.SetBound(l1+w1+2,t1+h1+2,DEFAULT_TEXTBOX_WID,DEFAULT_TEXTBOX_HEI)
    End If
  End With
End Sub



'***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 AskForFile(ByVal defext As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' LIB0.BAS PROCEDURE                                                  '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Ask user for filenames (wildcards are accepted)                     '
'                                                                     '
' ENTER                                                               '
'     defext       default file extension                             '
' EXIT                                                                '
'     returns file name appended with extension, if necessary         '
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Const prompt="Please supply file name or QUIT, then press OK."
Dim s As String
  s = UCase(UserIOBox(prompt, " // Enter "+defext+" file name" , "*.MOL"))
  If "QUIT"=s Then
    s=""
  Else
    If InStr(2,s,".")<1 Then s=s+"."+defext
  End If
  AskForFile = s
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 in a string aray                                    '
'                                                                     '
' 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 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
  Redim fnames(nf+1)
  nf=0
  found=FindFirst(mask,fname)
  While found
    nf=nf+1
    fnames(nf)=fname
    found=FindNext(fname)
  WEnd
  GetFileNames=nf
End Function

'***LIBRARY PROCEDURES END

'@@@@@@