We will now extend the Visual Basic staffing example by introducing a callback function. The callback function in this example will post a small dialog box each time the solver finds a better integer solution. The dialog box will display the solver’s iteration count, the objective value for the new solution, and the bound on the objective. You can find the complete project for this sample in the directory \LINGO17\Programming Samples\VBasic\STAFF2.

First, we need to construct a callback function and place it in a separate Module file (.bas file). Here are the contents of our callback function file Module1.bas:

Public Function MySolverCallback(ByVal pModel As Long, _

ByVal nReserved As Long, ByRef dBestIP As Double) As Long

 

' Callback function called by the LINGO DLL

' during model solution.

'

' Return value: >= 0 if solver is to continue,

'  else < 0 to interrupt the solver

  Dim nReturnVal As Long

  nReturnVal = 0

' Get current best IP

  Dim dObj As Double

  Dim nError As Long

  nError = LSgetCallbackInfoDoubleLng(pModel, _

   LS_DINFO_MIP_BEST_OBJECTIVE_LNG, dObj)

' Check for any error

  If (nError = LSERR_NO_ERROR_LNG) Then

' Is it better than the best one displayed so far?

     If (dObj < dBestIP) Then

' Yes ... display this solution

' Save the new best objective value

       dBestIP = dObj

' Get the iteration count from LINGO

        Dim nIterations As Long

        nResult = LSgetCallbackInfoLongLng(pModel, _

         LS_IINFO_ITERATIONS_LNG, nIterations)

' Get the objective bound from LINGO

        Dim dBound As Double

        nResult = LSgetCallbackInfoDoubleLng(pModel, _

         LS_DINFO_MIP_BOUND_LNG, dBound)

' Display the information in a dialog box

        Dim nButtonPressed

        Dim cMessage As String

        cMessage = "Objective:" + Str(dBestIP) _

         + Chr(10) + "Bound:" + Str(dBound) _

         + Chr(10) + "Iterations:" + Str(nIterations)

        nButtonPressed = MsgBox(cMessage, vbOKCancel)

        If (nButtonPressed = vbCancel) Then

           nReturnVal = -1

        End If

    End If

  End If

  MySolverCallback = nReturnVal

End Function

VB Callback Module (Module1.bas)

You will recall from the section Specifying a Callback Function that the callback routine must use the following calling sequence:

int __stdcall MySolverCallback( pLSenvLINGO pL, int nReserved, void* pUserData)

An equivalent function definition using VB code is:

Public Function MySolverCallback(ByVal pModel As Long, _

ByVal nReserved As Long, ByRef dBestIP As Double) As Long

VB uses the standard call (__stdcall) convention by default, so we need not specify this explicitly.

We will make use of the user data pointer to pass the value of the best objective displayed so far in the dBestIP argument. This variable will hold the objective value of the best integer solution found so far.  We compare each new objective value to the best one found so far.  If the latest is an improvement over the incumbent, then we display a dialog box summarizing the new solution.

The following code uses the LSgetCallbackInfo routine to get the value of the current best integer solution:

' Get current best IP

  Dim dObj As Double

  Dim nError As Long

  nError = LSgetCallbackInfoDoubleLng(pModel, _

   LS_DINFO_MIP_BEST_OBJECTIVE_LNG, dObj)

In the VB header file for LINGO (LINGD17.BAS), we created two aliases for the LSgetCallbackInfoLng() function: LSgetCallbackInfoDoubleLng() and LSgetCallbackInfoLongLng(). These were for retrieving, respectively, double and long data from LINGO.  This is required due to VB not supporting the void data type found in C.  We use LSgetCallbackInfoDoubleLng() to retrieve the objective value given that it is a double precision quantity.

Next, we check for any errors in retrieving the objective value. If none occurred, we check to see if the latest objective is better than the incumbent:

' Check for any error

  If (nError = LSERR_NO_ERROR_LNG) Then

 

' Is it better than the best one displayed so far?

     If (dObj < dBestIP) Then

If the new objective is better than the incumbent, then we save the new objective value, and retrieve the iteration count and objective bound:

' Save the new best objective value

        dBestIP = dObj

' Get the iteration count from LINGO

        Dim nIterations As Long

        nResult = LSgetCallbackInfoLongLng(pModel, _

         LS_IINFO_ITERATIONS_LNG, nIterations)

' Get the objective bound from LINGO

        Dim dBound As Double

        nResult = LSgetCallbackInfoDoubleLng(pModel, _

         LS_DINFO_MIP_BOUND_LNG, dBound)

We post a summary of the new solution in a dialog box:

' Display the information in a dialog box

        Dim nButtonPressed

        Dim cMessage As String

        cMessage = "Objective:" + Str(dBestIP) _

         + Chr(10) + "Bound:" + Str(dBound) _

         + Chr(10) + "Iterations:" + Str(nIterations)

        nButtonPressed = MsgBox(cMessage, vbOKCancel)

If the user pressed the Cancel button, as opposed to the OK button, then we set the return value to –1 before returning, which will cause the LINGO solver to interrupt:

        If (nButtonPressed = vbCancel) Then

           nReturnVal = -1

        End If

 

     End If

  End If

  MySolverCallback = nReturnVal

End Function

At this point, there is one more piece of code to add.  We must make a call to the LssetCallbackSolverLng() routine to pass LINGO a pointer to our callback routine.  This is accomplished at the start of the Solve button handler routine with the call:

' Pass LINGO a pointer to the callback routine

  Dim nError As Long

  Dim dBestObj As Double

  dBestObj = 1E+30

  nError = LSsetCallbackSolverLng(pLINGO, _

    AddressOf MySolverCallback, dBestObj)

Note the use of the VB AddressOf operator in the call to LSsetCallbackSolverLng().  This operator may be used only in function calls to pass the address of routines contained in module files.