Sample program location: (GP-Pro EX CD-ROM)\WinGP\SDK\Pro-SDK\VB\RtCtrlSmpl
The sample program executable file operates properly on Japanese and English operating systems only. To run the executable file in other operating system environments, re-create the executable file in that operating system environment.
VB6 sample program will not run on Windows Vista.
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