Sample program location: (in GP-Pro EX DVD-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.
Visual Basic 6.0 program sample does not support operating systems Windows Vista or later.
Option Explicit
Private Sub Form_Load()
' Initialize API.
Dim nResult As Long
nResult = InitRuntimeAPI
' Get handle.
ghWinGP = GetRuntimeHandle(9800)
If ghWinGP = 0 Then
MsgBox ("Unable to get handle")
End If
End Sub
Private Sub Bt_GetStartState_Click()
Screen.MousePointer = vbHourglass
' Status of get.
Dim Status As Long
Dim RetVal As Long
RetVal = GetRuntimeStartState(ghWinGP, Status)
' Problem?
If RetVal <> CLng(API_ERROR.E_SUCCESS) Then
MsgBox ("Err(" + Str(RetVal) + "):GetRuntimeStartState()")
End If
' Display status
Select Case Status
Case 0
Me.StartState.Text = "Running"
Case 1
Me.StartState.Text = "Online"
Case 2
Me.StartState.Text = "Offline"
Case 3
Me.StartState.Text = "RUN mode"
Case 4
Me.StartState.Text = "Exiting"
Case 5
Me.StartState.Text = "Inactive"
End Select
Screen.MousePointer = vbDefault
End Sub
Private Sub BT_GetScreenState_Click()
Screen.MousePointer = vbHourglass
' Get status.
Dim Status As Long
Dim RetVal As Long
RetVal = GetScreenState(ghWinGP, Status)
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):GetScreenState()")
End If
' Display status
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 set up 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)
' Screen status setting.
Dim RetVal As Long
RetVal = SetScreenState(ghWinGP, State, PosX, PosY, Width, Height)
' Problem?
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 ' Screen number of display screen.
' Get status.
Dim RetVal As Long
RetVal = GetDisplayScreenNumber(ghWinGP, CurScrNo)
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):GetDisplayScreenNumber()")
End If
' Get screen number.
Dim ScreenCount As Long
RetVal = GetEnumScreenNumberCount(ghWinGP, ScreenCount)
' Problem?
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))
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):EnumScreenNumber()")
End If
' ----- STATUS -----
' Set up retrieved screen number.
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 to default cursor.
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)
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):SetDisplayScreenNumber()")
End If
' To check if operation worked, get screen number again and compare with set up value.
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 to default cursor.
End Sub
Private Sub GetProjectInfo_Click()
Screen.MousePointer = vbHourglass ' Change cursor to hourglass.
' Area for retrieved parameter.
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)
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):GetProjctInformation()")
End If
' Display retrieved information
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 to default cursor.
End Sub
' 13 End operation.
' Exit confirmation dialog box.
' In the WinGP dialog box, if you select Do not end, application will not exit.
' Even then the return value is API_ERROR.E_SUCCESS.
Private Sub StopWinGP_Q_Click()
Screen.MousePointer = vbHourglass ' Change to hourglass cursor.
' Exit operation.
Dim RetVal As Long
RetVal = StopRuntime(ghWinGP, 1)
' Problem?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox ("Err(" + Str(RetVal) + "):StopRuntime()")
End If
Screen.MousePointer = vbDefault ' Return to default cursor.
End Sub