38.5.3.2
VB .NET 2003 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\DotNet\RtCtrlSmpl
' Imports
System.Runtime.InteropServices.
Imports System.Runtime.InteropServices
Public Class Form1
Inherits
System.Windows.Forms.Form
Dim ghWinGP As Int32 =
0 ' API handle.
#Region " Code generated with Windows form designer"
Public Sub
New()
MyBase.New()
' This call is necessary for Windows form
designer.
InitializeComponent()
' Initialize API.
' After calling InitializeComponent(), runs initialization.
Dim nResult
As Integer = 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
' Form overwrites the dispose to execute post
processing on the component list.
Protected
Overloads Overrides Sub Dispose(ByVal disposing As
Boolean)
If disposing
Then
If Not
(components Is Nothing) Then
components.Dispose()
End
If
End
If
CleanupRuntimeAPI()
MyBase.Dispose(disposing)
End Sub
-Snip (Codes designed by Windows form designer are
omitted hereafter)-
#End Region
' 5 Gets the startup state.
Private Sub
Bt_GetStartState_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles Bt_GetStartState.Click
Me.Cursor =
Cursors.WaitCursor ' Changes the cursor to an hourglass.
Try
' Get the state (API).
Dim Status
As Int32
Dim RetVal
As Int32 = GetRuntimeStartState(ghWinGP, Status)
' Any errors?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):GetRuntimeStartState()")
End
If
' Display status.
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
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
Private Sub
GetScreenState_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles BT_GetScreenState.Click
Me.Cursor =
Cursors.WaitCursor ' Changes the cursor to an hourglass.
Try
' Get status.
Dim Status
As Int32
Dim RetVal
As Int32 = GetScreenState(ghWinGP, Status)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):GetScreenState()")
End
If
' Display status.
Select Case
Status
Case
0, 1, 2
Me.ScreenState.SelectedIndex =
Status
End
Select
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
Private Sub
SetScreenState_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles BT_SetScreenState.Click
Me.Cursor =
Cursors.WaitCursor ' Change cursor to hourglass.
Try
' Get the value.
Dim State As
Int32 = Me.ScreenState.SelectedIndex
Dim PosX As
Int32 = Val(Me.PosX.Text)
Dim PosY As
Int32 = Val(Me.PosY.Text)
Dim Width As
Int32 = Val(Me.TX_Width.Text)
Dim Height
As Int32 = Val(Me.TX_Height.Text)
' Setup screen state.
Dim RetVal
As Int32 = SetScreenState(ghWinGP, State, PosX, PosY, Width,
Height)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):SetScreenState()")
End
If
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
Private Sub
GetDispScreen_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles GetDispScreen.Click
Me.Cursor =
Cursors.WaitCursor ' Change cursor to hourglass.
Dim CurScrNo As
Int32 ' Current screen number.
Try
' Get status.
Dim RetVal
As Int32 = GetDisplayScreenNumber(ghWinGP, CurScrNo)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):GetDisplayScreenNumber()")
End
If
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Try
' Get number of screens.
Dim
ScreenCount As Int32 = 0
Dim RetVal
As Int32 = GetEnumScreenNumberCount(ghWinGP,
ScreenCount)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):GetEnumScreenNumberCount()")
End
If
' Get screen number.
If
ScreenCount > 0 Then
' Get screen number.
Dim
ScreenNumber(ScreenCount - 1) As Int32
RetVal
= EnumScreenNumber(ghWinGP, ScreenCount,
ScreenNumber(0))
' Any problems?
If
RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):EnumScreenNumber()")
End
If
' ----- Display Status -----
' Delete all.
Me.CB_DispScreen.Items.Clear()
' Set the screen number you got.
Dim
idx As Int32
For
idx = 0 to ScreenNumber.Length - 1
Me.CB_DispScreen.Items.Add(ScreenNumber(idx))
Next
' Display current screen number.
For
idx = 0 to ScreenNumber.Length - 1
If CurScrNo =
Val(Me.CB_DispScreen.Items(idx)) Then
Me.CB_DispScreen.SelectedIndex =
idx
Exit For
End If
Next
End
If
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
Private Sub
SetDispScreen_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles SetDispScreen.Click
Me.Cursor =
Cursors.WaitCursor ' Change cursor to hourglass.
Try
' Get screen number.
Dim Screen
As Int32
Screen =
Val(Me.CB_DispScreen.Text)
' Change screen number.
Dim RetVal
As Int32 = SetDisplayScreenNumber(ghWinGP, Screen)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):SetDisplayScreenNumber()")
End
If
' Gets the screen number again and compare 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 = Screen Then
'MsgBox("Screen Change Successful
No=" +
Str(NowScrNo))
End
If
End
If
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
Private Sub
GetProjectInfo_Click(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles GetProjectInfo.Click
Me.Cursor =
Cursors.WaitCursor ' Change cursor to hourglass.
Try
' Parameter range to get.
Dim
ProjectFileName As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_FileName)
Dim
ProjectComment As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_Comment)
Dim
ProjectFastTime As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_FastTime)
Dim
ProjectLastTime As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_LastTime)
Dim
ProjectIDownload As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_IDownload)
Dim
HMIEditorVersion As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_HMIEditorVersion)
Dim
ControlEditorVersion As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_ControlEditorVersion)
Dim
MakingPerson As New
System.Text.StringBuilder(PROJECTINFO_SIZE.e_MakingPerson)
' Get project information.
Dim RetVal
As Int32
RetVal =
GetProjctInformation(ghWinGP, _
ProjectFileName, _
ProjectComment, _
ProjectFastTime, _
ProjectLastTime, _
ProjectIDownload, _
HMIEditorVersion, _
ControlEditorVersion, _
MakingPerson)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):GetProjctInformation()")
End
If
' Display the information you got.
Me.Prj_File.Text =
ProjectFileName.ToString()
Me.Prj_Comment.Text =
ProjectComment.ToString()
Me.Prj_Date.Text =
ProjectFastTime.ToString()
Me.Prj_LastDate.Text =
ProjectLastTime.ToString()
Me.Prj_HMI.Text =
HMIEditorVersion.ToString()
Me.Prj_Person.Text =
MakingPerson.ToString
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
' 13 End operation.
' Exit using 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(ByVal sender As System.Object, ByVal e As
System.EventArgs)
Handles StopWinGP_Q.Click
Me.Cursor =
Cursors.WaitCursor ' Change cursor to hourglass
Try
' Exit operation (API).
Dim RetVal
As Int32 = StopRuntime(ghWinGP, 1)
' Any problems?
If RetVal
<> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() +
"):StopRuntime()")
End
If
Catch ex As
Exception
MsgBox(ex.Message)
End Try
Me.Cursor =
Cursors.Default ' Return cursor to original.
End Sub
End Class
|
