Attribute VB_Name = "modProg"
' PALEOMAGNETIC MAGNETOMETER CONTROL SYSTEM
' by Robert E. Kopp / rkopp@caltech.edu

' Copyright (C) 2007 by the California Institute of Technology
' Licensed under the GNU General Public License


' -------------------------------------------------





' This module stores settings and procedures that handle program-specific
' details.  These, for the most part are general data and functions that
' cannot be categorized into the other modules



' ------ Global Variables ------

Public lastHelpFile As String

Public Prog_INIFile          As String
Public DEBUG_MODE           As Boolean
Public NOCOMM_MODE          As Boolean

Public LoginName           As String      ' Name of current user
Public LoginEmail          As String

Public currentPosInitialized As Boolean

Public SampleHolder       As Sample
Public SusceptibilityStandard As Sample

Public MainChanger         As frmChanger
Public fChangerSampOrder   As frmChangerSampOrder

Public MeasurementsSinceHolder As Long

Public SampleIndexRegistry As SampleIndexRegistrations
Public SampQueue As SampleCommands

Global FLAG_MagnetInit     As Boolean     ' Whether we've finished initializing the magnetometer
Global FLAG_MagnetUse      As Boolean     ' Whether we've finished using the magnetometer

Global Const DEMAGLEN As Integer = 6     ' Maximum length of "demag" string

' ------ Types            ------


Type SamFileDat
    ' This data type stores all the data fields
    ' that describe the current sample begin measured
    
    locality As String
    siteLat  As Double
    sitelon  As Double
    magDec   As Double
    NumSamples As Integer
End Type

Type AF_Status
    Status As Integer
    delay As Integer
    Coil As String
    Amplitude As Integer
End Type


Type AF
    axis As String
    Max As Double
    ypoint As Double
    xpoint As Double
    loslope As Double
    hislope As Double
End Type

Public Type QueueEntry
    CmdId   As String
    hole    As Double
    fileid  As Integer
End Type

Public Type Measure_Specimen
    ' Read in from the first records of a specimen file:
    '   Core, bedding, and fold orientation data
        
    Name            As String  ' The unique name of this sample
    holeNum         As Long    ' The hole that the sample is in
    sampleid        As Integer
    fileid          As Integer
    
    CorePlateStrike As Double
    CorePlateDip    As Double
    BeddingStrike   As Double
    BeddingDip      As Double
    
    Vol             As Double  ' Sample volume
    
    FoldRotation    As Boolean
    FoldAxis        As Double
    FoldPlunge      As Double
End Type

Type SampleIdentifier
    Filename As String
    Samplename As String
End Type

Sub Main()
    Prog_INIFile = GetSetting(App.EXEName, "Settings", "INIFile", "C:\Paleomag\Paleomag.ini")
    SaveSetting App.EXEName, "Settings", "INIFile", Prog_INIFile
    
    Config_ReadINISettings
    
    FLAG_MagnetInit = False     ' Magnetometer uninitialized
    FLAG_MagnetUse = False      ' Magnetometer not in use
    
    SetCodeLevel CodeGrey
    
    Load frmProgram
    frmProgram.ZOrder
    frmProgram.Show
    
    ' Show splash screen while everything is loading
    Load frmSplash
    
    On Error GoTo Oops
    If FileExists(Prog_LogoFile) And LenB(Prog_LogoFile) > 0 Then frmSplash.imgLogo.Picture = LoadPicture(Prog_LogoFile)
Oops:
    On Error GoTo 0
    frmSplash.ZOrder
    frmSplash.Show
    frmSplash.Refresh
      
    ' Load all forms into memory
    
    frmSplash.SplashStatus "Loading tip..."
    frmSplash.progress 1 / 9
    Load frmTip
    
    Load frmProgram
    Load frmDebug
    
    frmSplash.SplashStatus "Loading login..."
    frmSplash.progress 2 / 9
    Load frmLogin
    frmLogin.Hide
    
    frmSplash.SplashStatus "Loading main program..."
    frmSplash.progress 3 / 9
    Load frmMagnetometerControl
    frmMagnetometerControl.Hide
    
    frmSplash.SplashStatus "Loading DC motors controller..."
    frmSplash.progress 4 / 9
    Load frmDCMotors
    
    frmSplash.SplashStatus "Loading sample changer management..."
    frmSplash.progress 5 / 9
    
    Set SampQueue = New SampleCommands
    Set SampleIndexRegistry = New SampleIndexRegistrations
    
    Set SampleHolder = SampleIndexRegistry("!Holder").sampleSet("Holder")
'    Set SusceptibilityStandard = SampleIndexRegistry("!Holder").sampleSet("SusStd")
    
    Set MainChanger = New frmChanger
    MainChanger.IsMasterList = True
    Load MainChanger
    
    frmSplash.SplashStatus "Loading SQUID controller..."
    frmSplash.progress 6 / 9
    Load frmSQUID
    
    If EnableIRM Or EnableARM Then frmSplash.SplashStatus "Loading IRM and ARM controller..."
    Load frmIRMARM
    
    frmSplash.SplashStatus "Loading vacuum controller..."
    frmSplash.progress 7 / 9
    Load frmVacuum
    
    frmSplash.SplashStatus "Loading sendmail..."
    frmSplash.progress 8 / 9
    Load frmSendMail
    
    frmSplash.SplashStatus "Ready."
    frmSplash.progress 1
    frmTip.ZOrder
    frmLogin.ZOrder
    frmTip.Show
    frmLogin.Show
    Unload frmSplash
    
    SetCodeLevel CodeBlue
    
End Sub

Sub AppendLog(aline As String)
    ' This sub opens the usage log and appends to it the
    ' string "aline".  It's simple.
    Dim F As Integer
    
    F = FreeFile
    If Not FileExists(Prog_UsageFile) Then
        Open Prog_UsageFile For Output As #F
    Else
        Open Prog_UsageFile For Append As #F
    End If
    Print #F, aline
    Close #F
End Sub

Sub LoadResStrings(frm As Form)
    On Error Resume Next


    Dim ctl As Control
    Dim obj As Object
    Dim fnt As Object
    Dim sCtlType As String
    Dim nVal As Integer


    'set the form's caption
    frm.Caption = LoadResString(CInt(frm.Tag))
    

    'set the font
    Set fnt = frm.Font
    fnt.Name = LoadResString(20)
    fnt.Size = CInt(LoadResString(21))
    

    'set the controls' captions using the caption
    'property for menu items and the Tag property
    'for all other controls
    For Each ctl In frm.Controls
        Set ctl.Font = fnt
        sCtlType = TypeName(ctl)
        If sCtlType = "Label" Then
            ctl.Caption = LoadResString(CInt(ctl.Tag))
        ElseIf sCtlType = "Menu" Then
            ctl.Caption = LoadResString(CInt(ctl.Caption))
        ElseIf sCtlType = "TabStrip" Then
            For Each obj In ctl.Tabs
                obj.Caption = LoadResString(CInt(obj.Tag))
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "Toolbar" Then
            For Each obj In ctl.Buttons
                obj.ToolTipText = LoadResString(CInt(obj.ToolTipText))
            Next
        ElseIf sCtlType = "ListView" Then
            For Each obj In ctl.ColumnHeaders
                obj.Text = LoadResString(CInt(obj.Tag))
            Next
        Else
            nVal = 0
            nVal = val(ctl.Tag)
            If nVal > 0 Then ctl.Caption = LoadResString(nVal)
            nVal = 0
            nVal = val(ctl.ToolTipText)
            If nVal > 0 Then ctl.ToolTipText = LoadResString(nVal)
        End If
    Next


End Sub

Sub DelayTime(PauseTime As Double)
    ' This procedure pauses the program for some time allowing other
    ' to continue.  PauseTime is in seconds.
    ' CHANGELOG: 8-30-99  Added check for Timer reset at midnight
    Dim Start, Finish, TotalTime, CurTimer
    CurTimer = Timer
    Start = CurTimer   ' Set start time.
    Do While CurTimer < Start + PauseTime
        DoEvents    ' Yield to other processes.
        CurTimer = Timer
        If CurTimer < Start Then Start = Start - 86400
    Loop
    Finish = Timer  ' Set end time.
    TotalTime = Finish - Start  ' Calculate total time.
End Sub

Function FormatNumber(ByVal val As Double) As String
    ' Now select the proper format for printing out this range
    ' information based on the TESTIT variable
    
    Dim frmt As String
    Dim testit As Double
    testit = val
    
    If (testit >= 1000000) Or (testit <= -100000) Then
        frmt = "00000000"
    ElseIf (testit >= 100000) Or (testit <= -10000) Then
        frmt = "000000.0"
    ElseIf (testit >= 10000) Or (testit <= -1000) Then
        frmt = "00000.00"
    ElseIf (testit >= 1000) Or (testit <= -100) Then
        frmt = "0000.000"
    ElseIf (testit >= 100) Or (testit <= -10) Then
        frmt = "000.0000"
    ElseIf (testit >= 10) Or (testit <= -1) Then
        frmt = "00.00000"
    Else
        frmt = "0.000000"
    End If
    FormatNumber = Format$(val, frmt)
End Function

Public Function FileExists(p As String) As Boolean
    ' This function determines whether a file exists.
    ' It returns the corresponding boolean value
    
    FileExists = False
    On Error GoTo fin:
    If LenB(dir$(p, vbNormal + vbDirectory)) <> 0 Then
        FileExists = True
    End If
    On Error GoTo 0
fin:
End Function
