' Illustrates calling the Lingo DLL from VB.NET to
' solve the simple product mix model:
'    Max 100 Standard + 150 Turbo;
'    S.T.
'       Standard <= 100
'       Turbo <= 120
'       Standard + 2 * Turbo < 160;
'      
'  Note: The model template file, \lingo8\samples\simple.lng,
'  must be present in order to run this example.
'       

Option Explicit On 

Imports System.Runtime.InteropServices

<StructLayout(LayoutKind.Sequential)> _
Public Class clsProduce
    <MarshalAs(UnmanagedType.ByValArray, SizeConst:=2)> _
    Public dProduce As Double()
End Class

Public Class clsCallback
    Public Function MySolverCallback(ByVal pModel As Integer, _
     ByVal nReserved As Integer, ByRef dBestIP As Double) As Integer
        'Console.WriteLine("In callback")
    End Function
End Class

Public Class Form1
    Public Function RunLingo()

        Dim lingo As Lingo

        Dim pLingoEnv As Integer
        Dim nIterations As Integer = -1
        Dim nError As Integer
        Dim nPointersNow As Integer = -1
        Dim dObjective As Double = -1
        Dim dStatus As Double = -1

        'Model data that gets referenced by the
        'template model, simple.lng
        Dim dProfit(2) As Double
        dProfit(1) = 100
        dProfit(2) = 150

        Dim dLimit(2) As Double
        dLimit(1) = 100
        dLimit(2) = 120

        Dim dLabor(2) As Double
        dLabor(1) = 1
        dLabor(2) = 2

        Dim dProduce(2) As Double
        dProduce(1) = -1
        dProduce(2) = -1

        ' Get a pointer to a Lingo environment
        pLingoEnv = lingo.LScreateEnvLng()
        If (pLingoEnv = 0) Then
            Console.WriteLine("Unable to create Lingo environment.")
            GoTo FinalExit
        End If

        ' Open LINGO's log file  
        nError = lingo.LSopenLogFileLng(pLingoEnv, "lingo.log")
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Pass Lingo the pointer to the objective coefficients (refer
        ' to the template model, simple.lng)
        nError = lingo.LSsetPointerLng(pLingoEnv, dProfit(1), nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Pass a pointer to the production limits
        nError = lingo.LSsetPointerLng(pLingoEnv, dLimit(1), nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Pass a pointer to the labor utilization coefficients
        nError = lingo.LSsetPointerLng(pLingoEnv, dLabor(1), nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Point to dObjective, where Lingo will return the objective value
        nError = lingo.LSsetPointerLng(pLingoEnv, dObjective, nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Pointer to the solution status code
        nError = lingo.LSsetPointerLng(pLingoEnv, dStatus, nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Pass a pointer to the variable value array
        Dim pdProduce As New IntPtr()
        Dim Produce As New clsProduce()
        Produce.dProduce = dProduce
        ' Allocate space for production array on the unmanaged heap
        pdProduce = Marshal.AllocHGlobal(Marshal.SizeOf(Produce))
        ' Marshal production array to the unmanaged address
        Marshal.StructureToPtr(Produce, pdProduce, False)
        ' Pass Lingo the unmanaged pointer to the production array
        nError = lingo.LSsetPointerLng2(pLingoEnv, pdProduce, nPointersNow)
        If (nError <> 0) Then
            GoTo ErrorExit
        End If

        ' Let Lingo know we have a callback function (note: this step 
        ' is optional)
        Dim cb As Lingo.typCallbackSolver
        Dim clscb As New clsCallback()
        cb = AddressOf clscb.MySolverCallback
        Dim dData As Double
        nError = lingo.LSsetCallbackSolverLng(pLingoEnv, cb, dData)

        ' Here is the script we want LINGO to run. 
        Dim cScript As String
        cScript = "take \lingo10\samples\simple.lng" & Chr(10)
        cScript = cScript & "gen" & Chr(10) & "go" & Chr(10) & "quit" & Chr(10) & Chr(0)

        ' Run the script
        nError = lingo.LSexecuteScriptLng(pLingoEnv, cScript)

        ' Marshal the production quantities back to the managed structure
        Marshal.PtrToStructure(pdProduce, Produce)
        ' Free memory in global heap
        Marshal.FreeHGlobal(pdProduce)
        ' Copy to original array
        dProduce(1) = Produce.dProduce(0)
        dProduce(2) = Produce.dProduce(1)

        ' Close the log file
        lingo.LScloseLogFileLng(pLingoEnv)
        '
        ' Any problems?
        If (nError <> 0 Or _
         dStatus <> lingo.LSstatusCodeLng.LS_STATUS_GLOBAL_LNG) Then

            ' Had a problem   
            Console.WriteLine("Unable to solve!")

        Else

            ' Everything went OK ... print results
            Console.WriteLine("Standards: " & dProduce(1))
            Console.WriteLine("   Turbos: " & dProduce(2))
            Console.WriteLine("   Profit: " & dObjective)

        End If

        GoTo NormalExit

ErrorExit:
        Console.WriteLine("LINGO Error Code: " & nError)

NormalExit:
        ' Free Lingo's environment to avoid a memory leak
        lingo.LSdeleteEnvLng(pLingoEnv)

FinalExit:
        Console.WriteLine("press enter...")
        Dim sTemp As String
        sTemp = Console.ReadLine()

    End Function
End Class

Module Module1
    Sub Main()

        Dim f1 As New Form1()
        Call f1.RunLingo()

    End Sub
End Module