根据现场实际需要做适当修改后即可使用：
1.退出工作台
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SendMessage& Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any)
Private Sub bmpExit_Click()
Dim lResult As Long
Dim iResult
Dim hw&, cnt&
hw& = FindWindow("iFix Startup", vbNullString)
If hw& = 0 Then
MsgBox ("无法关闭演示系统。请使用 Windows任务管理器将工作台关闭。")
End If
If hw& <> 0 Then cnt& = SendMessage(hw&, &H10, 0, 0&)
End Sub
2.IE浏览器打开网页
Private Sub bmpGEFanucWebSite_Click()
Dim lVar As Long
Dim Result
lVar = GetFocus()
'This shell function accesses the internet, and opens directly to the GE Fanuc Website
Result = ShellExecute(lVar, "Open", "http:\\
www.gefanuc.com.cn", vbNullString, vbNullString, 5)
'error check; If the local node is not connected to the internet, display an error message
If Result < 32 Then
MsgBox "您需要连接服务器且具有互联网浏览器来显示GE Fanuc网站。"
End If
End Sub
3.打开帮助文档
Private Declare Function WinHelp Lib "user32" Alias "WinHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, ByVal dwData As Long) As Long
Private Sub txtHelpHelp_Click()
Dim lngValue As Long
Dim hwnd As Long
'Open Help for the Open Picture Command form
hwnd = GetFocus
lngValue = WinHelp(hwnd, System.HelpPath & "\SampleSystem.hlp", &H1&, 1)
End Sub
4.关闭虚拟键盘（需要copy文件）
Private Sub bmpStopKey_Click()
Dim hw&, cnt&
hw& = FindWindow("My-T-Mouse", vbNullString)
If hw& <> 0 Then cnt& = SendMessage(hw&, &H10, 0, 0&)
End Sub
5.打开虚拟键盘（需要copy文件）
Private Sub bmpStartKey_Click()
Dim hw&
Dim d As Double
hw& = FindWindow("My-T-Mouse", vbNullString)
If hw& = 0 Then
d = Shell(System.BasePath & "\MYTSOFT.EXE", vbMinimizedFocus)
End If
End Sub
6.检测机器分辨率
Public Function CheckScreenResIsAtLeast1024x768() As Boolean
'Function: Return a True if the NT screen resolution is 1024 x 768 _
Only display the message box one time.
Dim sngWidth As Single, sngHeight As Single, sMessage As String
Dim sTitle As String
Static boolRunOnce As Boolean
On Error GoTo HandleError
CheckScreenResIsAtLeast1024x768 = False
sngWidth = clsSreenInfo.WidthInPixels
sngHeight = clsSreenInfo.HeightInPixels
If sngWidth >= 1024 And sngHeight >= 768 Then 'if at least 1024 x 768 resolution
CheckScreenResIsAtLeast1024x768 = True
End If
If Not CheckScreenResIsAtLeast1024x768 And Not boolRunOnce Then
sTitle = "Your Screen Resolution is: " & CStr(sngWidth) & " x " & CStr(sngHeight)
sMessage = "The sample system is best viewed at a screen resolution of at least " _
& "1024 x 768." & vbCrLf _
& "To change, go to the Windows Control Panel and modify the Display -> Settings" _
& " property."
'We only want to show this dialog one time
MsgBox sMessage, vbInformation, sTitle
boolRunOnce = True
End If
HandleError:
'Exit here on error
End Function
7.改变字体大小
Public Sub ChangeFontsIfBelow1024x768(objPic As Object)
On Error Resume Next
Dim sngWidth As Single, sngHeight As Single
Dim clsSreenInfo As New ScreenInfo
Dim DummyString As String
Dim objChild As Object
sngWidth = clsSreenInfo.WidthInPixels
sngHeight = clsSreenInfo.HeightInPixels
If Not (sngWidth >= 1024 And sngHeight >= 768) Then 'if not at least 1024 x 768 resolution
For Each objChild In objPic.ContainedObjects
If objChild.ClassName = "OleObject" Then
DummyString = objChild.Font.Size
If Err.Number = 0 Then
objChild.Font.Size = objChild.Font.Size - 2
End If
Err.Clear
End If
If objChild.ContainedObjects.Count > 0 Then
ChangeFontsIfBelow1024x768 objChild
End If
Next
End If
Set clsSreenInfo = Nothing
End Sub
8.检测机器颜色是不是32真彩
（由于字数太多，代码已删除）
9.打开chm帮助指定页
Public Declare Function HTMLHelp Lib "hhctrl.ocx" Alias "HtmlHelpA" (ByVal hwnd As Long, ByVal lpHelpFile As String, ByVal wCommand As Long, dwData As Any) As Long
Private Sub txtLearnAboutIt_Click()
'Bring them to the specific Help docs page
Dim aHelpFile As String
Dim sSecondary As String
aHelpFile = System.HelpPath & "\DRW.chm>secondary"
sSecondary = "DRW_Using_Tag_Status_and_Quick_Trend_Pictures.htm"
Call HTMLHelp(0, aHelpFile, HH_DISPLAY_TOPIC, ByVal sSecondary)
End Sub
10.切换当前页面的提示信息
Private Sub cmdToggleToolTips_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
On Error Resume Next
'Function: Enable/Disable tool tips. _
Note that this function does not recurse through grouped objects -- it _
only looks at 'main' objects in the picture
Dim obj As Object
boolToolTipsControl.CurrentValue = Not boolToolTipsControl.CurrentValue
For Each obj In Me.ContainedObjects
obj.EnableTooltips = boolToolTipsControl.CurrentValue
Next
End Sub
11.弹出滑块调节（模拟量）
Private Sub TankBatchC3_Click()
'The Comments below have been added automatically.
'Any changes could cause adverse effects to the functionality
'of the Script Authoring Experts.
'WizardName=DataEntry
On Error GoTo ErrorHandler
If blnDataEntryFrmFlag <> True Then
GetFormSlider
Dim dblLow As Double
Dim dblHigh As Double
Dim blnFetch As Boolean
dblLow = ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_elo")
dblHigh = ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_ehi")
If (dblHigh > 32767) Then
MsgBox " The high limit cannot be greater than 32,767 for this type of Data Entry, Please choose another."
Exit Sub
End If
blnFetch = True
Slider.Slider1.min = CInt(dblLow)
Slider.Slider1.max = CInt(dblHigh)
Slider.GetTheVars a:=1, b:="Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.F_CV"
Slider.lblLow.Caption = dblLow
Slider.lblHigh.Caption = dblHigh
Slider.Show
End If
Exit Sub
ErrorHandler:
HandleError
End Sub
12.弹出按钮控制（数字量）
Private Sub MixerGroup1_Click()
'The Comments below have been added automatically.
'Any changes could cause adverse effects to the functionality
'of the Script Authoring Experts.
'WizardName=DataEntry
On Error GoTo ErrorHandler
If blnDataEntryFrmFlag = True Then
Exit Sub
End If
GetFormPushbutton
Dim strOpenButton As String
Dim strCloseButton As String
Dim dblLow As Double
Dim dblHigh As Double
dblLow = 0
dblHigh = 1
strOpenButton = "关闭"
strCloseButton = "打开"
Pushbutton.GetTheVars a:=1, b:="Fix32.THISNODE.IFIX1_BATCH_TANK3AGITATE.F_CV"
Pushbutton.cmdOpen.Caption = strOpenButton
Pushbutton.cmdClose.Caption = strCloseButton
Pushbutton.Show
Exit Sub
ErrorHandler:
HandleError
End Sub
13.弹出梯度调节框
Private Sub TempGroupTank1_Click()
'The Comments below have been added automatically.
'Any changes could cause adverse effects to the functionality
'of the Script Authoring Experts.
'WizardName=DataEntry
On Error GoTo ErrorHandler
If blnDataEntryFrmFlag = True Then
Exit Sub
End If
GetFormRamp
Dim strFast As String
Dim strSlow As String
Dim blnFetch As Boolean
Ramp.GetTheLimits High:=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_ehi"), Low:=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_elo")
blnFetch = True
Ramp.GetTheVars a:=1, b:="Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.F_CV"
Ramp.FastSlow F:=10, s:=5
strFast = 10
strSlow = 5
Ramp.lblSlow = strSlow & "%"
Ramp.lblFast = strFast & "%"
Ramp.Show
Exit Sub
ErrorHandler:
HandleError
End Sub
14.确认报警控件中的所有报警
Private Sub cmdAcknowledgeAll_Click()
' Acknowledge all filtered alarms
AlarmSummaryOCX1.AckAlarmPageEx
End Sub
15.确认所选报警
Private Sub cmdAcknowledgeSelected_Click()
' Acknowledge the alarm currently selected
Dim sNode As String, sTag As String, boolTagSelected As Boolean
boolTagSelected = AlarmSummaryOCX1.GetSelectedNodeTag(sNode, sTag)
If boolTagSelected Then AcknowledgeAnAlarm sTag
End Sub
16.启用报警音效
Private Sub cmdToggleAlarmHorn_Click()
'The Comments below have been added automatically.
'Any changes could cause adverse effects to the functionality
'of the Script Authoring Experts.
'WizardName=AlarmHorn
'Property1=optExpertTypeToggle
AlarmHornEnabledToggle
End Sub
17.取消报警音效（静音）
Private Sub cmdSilenceHorn_Click()
'The Comments below have been added automatically.
'Any changes could cause adverse effects to the functionality
'of the Script Authoring Experts.
'WizardName=AlarmHorn
'Property1=optExpertTypeSilence
AlarmHornSilence
End Sub
18.在下拉菜单中选择排序列（画面加载时用additem加选报警列名）
Private Sub cmbSortList_Change()
'Resort the list
If cmbSortList.Text <> "" Then
AlarmSummaryOCX1.SortColumnName = cmbSortList.Text
End If
End Sub
19.报警控件中的升序
Private Sub optSortAscending_Click()
AlarmSummaryOCX1.SortOrderAscending = True
optSortDescending.Value = False
