根據(jù)現(xiàn)場實際需要做適當修改后即可使用：
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 ("無法關(guān)閉演示系統(tǒng)。請使用 Windows任務管理器將工作臺關(guān)閉。")
End If
If hw& <> 0 Then cnt& = SendMessage(hw&, &H10, 0, 0&)
End Sub
2.IE瀏覽器打開網(wǎng)頁
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 "您需要連接服務器且具有互聯(lián)網(wǎng)瀏覽器來顯示GE Fanuc網(wǎng)站。"
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.關(guān)閉虛擬鍵盤（需要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真彩
（由于字數(shù)太多，代碼已刪除）
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.彈出滑塊調(diào)節(jié)（模擬量）
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.彈出按鈕控制（數(shù)字量）
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 = "關(guān)閉"
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.彈出梯度調(diào)節(jié)框
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
