38.5.3.3 VB6 Program Example - Sample to retrieve the WinGP status and change its settings (Handling API)

Sample program location: (GP-Pro EX CD-ROM)\WinGP\SDK\Pro-SDK\VB\RtCtrlSmpl

Option Explicit
 
Private Sub Form_Load()

 
 ' Initialize API (API).
 Dim nResult As Long
 nResult = InitRuntimeAPI
 
 ' Gets the handle at this stage (API).
 ghWinGP = GetRuntimeHandle(9800)
 If ghWinGP = 0 Then
  MsgBox ("(API) Failed to get handle")
 End If
 
End Sub

 
Private Sub Bt_GetStartState_Click()

 
 Screen.MousePointer = vbHourglass
 
 ' Get status (API).
 Dim Status As Long
 Dim RetVal As Long
 RetVal = GetRuntimeStartState(ghWinGP, Status)
 
 ' Any problems?
 If RetVal <> CLng(API_ERROR.E_SUCCESS) Then
  MsgBox ("Err(" + Str(RetVal) + "):GetRuntimeStartState()")
 End If
 
 ' Display state.
 Select Case Status
  Case 0
   Me.StartState.Text = "Starting"
  Case 1
   Me.StartState.Text = "Online"
  Case 2
   Me.StartState.Text = "Offline mode"
  Case 3
   Me.StartState.Text = "Transfer Mode"
  Case 4
   Me.StartState.Text = "Exiting"
  Case 5
   Me.StartState.Text = "Not executing"
 End Select
 
 Screen.MousePointer = vbDefault
 
End Sub

 
Private Sub BT_GetScreenState_Click()

 
 Screen.MousePointer = vbHourglass
 
 ' Get state.
 Dim Status As Long
 Dim RetVal As Long
 RetVal = GetScreenState(ghWinGP, Status)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):GetScreenState()")
 End If
 
 ' Display state.
 Select Case Status
  Case 0, 1, 2
   Me.ScreenState.ListIndex = Status
 End Select
 
 Screen.MousePointer = vbDefault
 
End Sub

 
Private Sub BT_SetScreenState_Click()

 
 Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
 
 ' Get setup value.
 Dim State As Long
 Dim PosX As Long
 Dim PosY As Long
 Dim Width As Long
 Dim Height As Long
 
 State = Me.ScreenState.ListIndex
 PosX = Val(Me.PosX.Text)
 PosY = Val(Me.PosY.Text)
 Width = Val(Me.TX_Width.Text)
 Height = Val(Me.TX_Height.Text)
 
 ' Setup screen state.
 Dim RetVal As Long
 RetVal = SetScreenState(ghWinGP, State, PosX, PosY, Width, Height)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):SetScreenState()")
 End If
 
 Screen.MousePointer = vbDefault
 
End Sub

 
Private Sub GetDispScreen_Click()

 
 Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
 
 Dim CurScrNo As Long ' Current screen number.
 
 ' Get state.
 Dim RetVal As Long
 RetVal = GetDisplayScreenNumber(ghWinGP, CurScrNo)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):GetDisplayScreenNumber()")
 End If
 
 ' Get number of screens.
 Dim ScreenCount As Long
 RetVal = GetEnumScreenNumberCount(ghWinGP, ScreenCount)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):GetEnumScreenNumberCount()")
 End If
 
 ' Get screen number.
 If ScreenCount > 0 Then
 
  ' Get screen number.
  Dim ScreenNumber() As Long
  ReDim ScreenNumber(ScreenCount - 1) As Long
  RetVal = EnumScreenNumber(ghWinGP, ScreenCount, ScreenNumber(0))
 
  ' Any problems?
  If RetVal <> API_ERROR.E_SUCCESS Then
   MsgBox ("Err(" + Str(RetVal) + "):EnumScreenNumber()")
  End If
 
  ' ----- Display Status -----
 
  ' Set up screen number you got.
  Me.CB_DispScreen.Clear
  Dim idx As Long
  For idx = 0 To ScreenCount - 1
   Me.CB_DispScreen.AddItem (ScreenNumber(idx))
  Next
 
  ' Display current screen number.
  For idx = 0 To ScreenCount - 1
   If CurScrNo = Val(Me.CB_DispScreen.List(idx)) Then
    Me.CB_DispScreen.ListIndex = idx
    Exit For
   End If
  Next
 
 End If
 
 Screen.MousePointer = vbDefault ' Return cursor to original.
 
End Sub

 
Private Sub SetDispScreen_Click()

 
 Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
 
 ' Get screen number.
 Dim ScrNo As Long
 ScrNo = Val(Me.CB_DispScreen.Text)
 
 ' Change screen number.
 Dim RetVal As Long
 RetVal = SetDisplayScreenNumber(ghWinGP, ScrNo)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):SetDisplayScreenNumber()")
 End If
 
 ' Gets the screen number again and compares it with the set value to see whether the screen number has been changed successfully.
 Dim NowScrNo As Long
 RetVal = GetDisplayScreenNumber(ghWinGP, NowScrNo)
 If RetVal = API_ERROR.E_SUCCESS Then
  If NowScrNo = ScrNo Then
  ' MsgBox ("Screen Change Successful No=" + Str(NowScrNo))
  End If
 End If
 
 Screen.MousePointer = vbDefault ' Return cursor to original.
 
End Sub

 
Private Sub GetProjectInfo_Click()

 
 Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
 
 ' Parameter range to get.
 Dim ProjectFileName As String * 256
 Dim ProjectComment As String * 256
 Dim ProjectFastTime As String * 256
 Dim ProjectLastTime As String * 256
 Dim ProjectIDownload As String * 256
 Dim HMIEditorVersion As String * 256
 Dim ControlEditorVersion As String * 256
 Dim MakingPerson As String * 256
 
 ' Get project information.
 Dim RetVal As Long
 RetVal = GetProjctInformation(ghWinGP, _
  ProjectFileName, _
  ProjectComment, _
  ProjectFastTime, _
  ProjectLastTime, _
  ProjectIDownload, _
  HMIEditorVersion, _
  ControlEditorVersion, _
  MakingPerson)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):GetProjctInformation()")
 End If
 
 ' Display information you got.
 Me.Prj_File.Text = StrConv(ProjectFileName, vbFromUnicode)
 Me.Prj_Comment.Text = StrConv(ProjectComment, vbFromUnicode)
 Me.Prj_Date.Text = StrConv(ProjectFastTime, vbFromUnicode)
 Me.Prj_LastDate.Text = StrConv(ProjectLastTime, vbFromUnicode)
 Me.Prj_HMI.Text = StrConv(HMIEditorVersion, vbFromUnicode)
 Me.Prj_Person.Text = StrConv(MakingPerson, vbFromUnicode)
 
 Screen.MousePointer = vbDefault ' Return cursor to original.
 
End Sub

 
' 13 Exit operation.
' Exit with confirm dialog box.
' WinGP does not end if you select "Do not exit" in the dialog box.
' Even then the return value is API_ERROR.E_SUCCESS.
 
Private Sub StopWinGP_Q_Click()

 Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
 
 ' Exit operation (API).
 Dim RetVal As Long
 RetVal = StopRuntime(ghWinGP, 1)
 
 ' Any problems?
 If RetVal <> API_ERROR.E_SUCCESS Then
  MsgBox ("Err(" + Str(RetVal) + "):StopRuntime()")
 End If
 
 Screen.MousePointer = vbDefault ' Return cursor to original.
 
End Sub