サンプルプログラムの場所 : (GP-Pro EXのDVD-ROM内)\WinGP\SDK\Pro-SDK\DotNet\RtCtrlSmpl
' System.Runtime.InteropServicesをインポートします。
Imports System.Runtime.InteropServices
Public Class Form1
Inherits System.Windows.Forms.Form
Dim ghWinGP As Int32 = 0 ' APIハンドル.
#Region " Windows フォームデザイナで生成されたコード"
Public Sub New()
MyBase.New()
' この呼び出しはWindows フォームデザイナで必要です。
InitializeComponent()
' APIを初期化します(API).
' InitializeComponent() 呼び出しの後に初期化を追加します。
Dim nResult As Integer = InitRuntimeAPI()
' この段階でハンドルを取得しておきます(API).
ghWinGP = GetRuntimeHandle(9800)
If ghWinGP = 0 Then
MsgBox("(API)ハンドルを取得できませんでした")
End If
End Sub
' Form は、コンポーネント一覧に後処理を実行するためにdispose をオーバーライドします。
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
～中略(以下、Windows フォームデザイナで生成されたコードは省略します)～
#End Region
' 5 起動状態取得.
Private Sub Bt_GetStartState_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles Bt_GetStartState.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Try
' 状態の取得(API).
Dim Status As Int32
Dim RetVal As Int32 = GetRuntimeStartState(ghWinGP, Status)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):GetRuntimeStartState()")
End If
' 状態の表示
Select Case Status
Case 0
Me.StartState.Text = "起動中"
Case 1
Me.StartState.Text = "オンライン"
Case 2
Me.StartState.Text = "オフライン"
Case 3
Me.StartState.Text = "転送モード"
Case 4
Me.StartState.Text = "終了中"
Case 5
Me.StartState.Text = "未動作"
End Select
Catch ex As Exception
MsgBox(ex.Message)
End Try
Me.Cursor = Cursors.Default ' カーソルを元に戻す.
End Sub
Private Sub GetScreenState_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles BT_GetScreenState.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Try
' 状態の取得.
Dim Status As Int32
Dim RetVal As Int32 = GetScreenState(ghWinGP, Status)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):GetScreenState()")
End If
' 状態の表示
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 ' カーソルを元に戻す.
End Sub
Private Sub SetScreenState_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles BT_SetScreenState.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Try
' 設定値の取得.
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)
' 画面状態の設定.
Dim RetVal As Int32 = SetScreenState(ghWinGP, State, PosX, PosY, Width, Height)
' 異常あり?
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 ' カーソルを元に戻す.
End Sub
Private Sub GetDispScreen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles GetDispScreen.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Dim CurScrNo As Int32 ' 表示中の画面番号.
Try
' 状態の取得.
Dim RetVal As Int32 = GetDisplayScreenNumber(ghWinGP, CurScrNo)
' 異常あり?
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
' 画面数を取得する.
Dim ScreenCount As Int32 = 0
Dim RetVal As Int32 = GetEnumScreenNumberCount(ghWinGP, ScreenCount)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):GetEnumScreenNumberCount()")
End If
' 画面番号の取得.
If ScreenCount > 0 Then
' 画面番号を取得する.
Dim ScreenNumber(ScreenCount - 1) As Int32
RetVal = EnumScreenNumber(ghWinGP, ScreenCount, ScreenNumber(0))
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):EnumScreenNumber()")
End If
' ----- 状態の表示-----
' 一旦すべて削除.
Me.CB_DispScreen.Items.Clear()
' 取得した画面番号を設定.
Dim idx As Int32
For idx = 0 To ScreenNumber.Length - 1
Me.CB_DispScreen.Items.Add(ScreenNumber(idx))
Next
' 表示中画面番号を表示.
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 ' カーソルを元に戻す.
End Sub
Private Sub SetDispScreen_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles SetDispScreen.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Try
' 画面番号の取得.
Dim Screen As Int32
Screen = Val(Me.CB_DispScreen.Text)
' 画面番号の変更.
Dim RetVal As Int32 = SetDisplayScreenNumber(ghWinGP, Screen)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):SetDisplayScreenNumber()")
End If
' 正常に変わったかは画面番号を再取得して、設定した値と比較します。
Dim NowScrNo As Long
RetVal = GetDisplayScreenNumber(ghWinGP, NowScrNo)
If RetVal = API_ERROR.E_SUCCESS Then
If NowScrNo = Screen Then
'MsgBox("画面は正常に変わりましたNo=" + Str(NowScrNo))
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
Me.Cursor = Cursors.Default ' カーソルを元に戻す.
End Sub
Private Sub GetProjectInfo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
Handles GetProjectInfo.Click
Me.Cursor = Cursors.WaitCursor ' カーソルを砂時計に変更.
Try
' 取得するパラメータの領域.
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)
' プロジェクト情報取得.
Dim RetVal As Int32
RetVal = GetProjctInformation(ghWinGP, _
ProjectFileName, _
ProjectComment, _
ProjectFastTime, _
ProjectLastTime, _
ProjectIDownload, _
HMIEditorVersion, _
ControlEditorVersion, _
MakingPerson)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS Then
MsgBox("Err(" + Str(RetVal).Trim() + "):GetProjctInformation()")
End If
' 取得した情報の表示
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 ' カーソルを元に戻す.
End Sub
' 13 終了操作.
' 確認ダイアログ付き終了.
' 当然のことですが、WinGPの終了ダイアログで「終了しません」を選ぶと終了しません。
' その時でも戻り値は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 ' カーソルを砂時計に変更.
Try
' 終了操作(API).
Dim RetVal As Int32 = StopRuntime(ghWinGP, 1)
' 異常あり?
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 ' カーソルを元に戻す.
End Sub
End Class