サンプルプログラムの場所 : (GP-Pro EXのDVD-ROM内)\WinGP\SDK\Pro-SDK\VB\RtCtrlSmpl
このサンプルプログラムの実行ファイルは、日本語、英語以外のOS環境では正しく動作しません。日本語、英語以外のOS環境で実行ファイルを動作させるには、それぞれのOS環境で実行ファイルを作成し直してください。
Visual Basic 6.0のサンプルプログラムはWindows Vista以降のOSには対応していません。
Option Explicit
Private Sub Form_Load()
' API を初期化します(API).
Dim nResult As Long
nResult = InitRuntimeAPI
' この段階でハンドルを取得しておきます(API).
ghWinGP = GetRuntimeHandle(9800)
If ghWinGP = 0 Then
MsgBox ("(API)ハンドルを取得できませんでした")
End If
End Sub
Private Sub Bt_GetStartState_Click()
Screen.MousePointer = vbHourglass
' 状態の取得(API).
Dim Status As Long
Dim RetVal As Long
RetVal = GetRuntimeStartState(ghWinGP,
Status)
' 異常あり?
If RetVal <> CLng(API_ERROR.E_SUCCESS)
Then
MsgBox ("Err("
+ Str(RetVal) + "):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
Screen.MousePointer = vbDefault
End Sub
Private Sub BT_GetScreenState_Click()
Screen.MousePointer = vbHourglass
' 状態の取得.
Dim Status As Long
Dim RetVal As Long
RetVal = GetScreenState(ghWinGP,
Status)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):GetScreenState()")
End If
' 状態の表示
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
' カーソルを砂時計に変更.
' 設定値の取得.
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)
' 画面状態の設定.
Dim RetVal As Long
RetVal = SetScreenState(ghWinGP,
State, PosX, PosY, Width, Height)
' 異常あり?
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
' カーソルを砂時計に変更.
Dim CurScrNo As Long
' 表示中の画面番号.
' 状態の取得.
Dim RetVal As Long
RetVal = GetDisplayScreenNumber(ghWinGP,
CurScrNo)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):GetDisplayScreenNumber()")
End If
' 画面数を取得する.
Dim ScreenCount As Long
RetVal = GetEnumScreenNumberCount(ghWinGP,
ScreenCount)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):GetEnumScreenNumberCount()")
End If
' 画面番号の取得.
If ScreenCount > 0 Then
' 画面番号を取得する.
Dim ScreenNumber() As
Long
ReDim ScreenNumber(ScreenCount
- 1) As Long
RetVal = EnumScreenNumber(ghWinGP,
ScreenCount, ScreenNumber(0))
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):EnumScreenNumber()")
End If
' ----- 状態の表示-----
' 取得した画面番号を設定.
Me.CB_DispScreen.Clear
Dim idx As Long
For idx = 0 To ScreenCount
- 1
Me.CB_DispScreen.AddItem
(ScreenNumber(idx))
Next
' 表示中画面番号を表示.
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
' カーソルを元に戻す.
End Sub
Private Sub SetDispScreen_Click()
Screen.MousePointer = vbHourglass
' カーソルを砂時計に変更.
' 画面番号の取得.
Dim ScrNo As Long
ScrNo = Val(Me.CB_DispScreen.Text)
' 画面番号の変更.
Dim RetVal As Long
RetVal = SetDisplayScreenNumber(ghWinGP,
ScrNo)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):SetDisplayScreenNumber()")
End If
' 正常に変わったかは画面番号を再取得して、設定した値と比較します。
Dim NowScrNo As Long
RetVal = GetDisplayScreenNumber(ghWinGP,
NowScrNo)
If RetVal = API_ERROR.E_SUCCESS
Then
If NowScrNo = ScrNo Then
' MsgBox ("画面は正常に変わりましたNo="
+ Str(NowScrNo))
End If
End If
Screen.MousePointer = vbDefault
' カーソルを元に戻す.
End Sub
Private Sub GetProjectInfo_Click()
Screen.MousePointer = vbHourglass
' カーソルを砂時計に変更.
' 取得するパラメータの領域.
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
' プロジェクト情報取得.
Dim RetVal As Long
RetVal = GetProjctInformation(ghWinGP,
_
ProjectFileName, _
ProjectComment, _
ProjectFastTime, _
ProjectLastTime, _
ProjectIDownload, _
HMIEditorVersion, _
ControlEditorVersion,
_
MakingPerson)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):GetProjctInformation()")
End If
' 取得した情報の表示
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
' カーソルを元に戻す.
End Sub
' 13 終了操作.
' 確認ダイアログ付き終了.
' 当然のことですが、WinGP の終了ダイアログで「終了しません」を選ぶと終了しません。
' その時でも戻り値はAPI_ERROR.E_SUCCESS で返ります。
Private Sub StopWinGP_Q_Click()
Screen.MousePointer = vbHourglass
' カーソルを砂時計に変更.
' 終了操作(API).
Dim RetVal As Long
RetVal = StopRuntime(ghWinGP,
1)
' 異常あり?
If RetVal <> API_ERROR.E_SUCCESS
Then
MsgBox ("Err("
+ Str(RetVal) + "):StopRuntime()")
End If
Screen.MousePointer = vbDefault
' カーソルを元に戻す.
End Sub