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
-
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
|
