IFIX中一些常用功能的VBA代码.docx
- 文档编号:29379176
- 上传时间:2023-07-22
- 格式:DOCX
- 页数:11
- 大小:18.84KB
IFIX中一些常用功能的VBA代码.docx
《IFIX中一些常用功能的VBA代码.docx》由会员分享,可在线阅读,更多相关《IFIX中一些常用功能的VBA代码.docx(11页珍藏版)》请在冰豆网上搜索。
IFIX中一些常用功能的VBA代码
根据现场实际需要做适当修改后即可使用:
1.退出工作台
OptionExplicit
PrivateDeclareFunctionFindWindowLib"user32"Alias"FindWindowA"(ByVallpClassNameAsString,ByVallpWindowNameAsString)AsLong
PrivateDeclareFunctionSendMessage&Lib"user32"Alias"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,ByVallParamAsAny)
PrivateSubbmpExit_Click()
DimlResultAsLong
DimiResult
Dimhw&,cnt&
hw&=FindWindow("iFixStartup",vbNullString)
Ifhw&=0Then
MsgBox("无法关闭演示系统。
请使用Windows任务管理器将工作台关闭。
")
EndIf
Ifhw&<>0Thencnt&=SendMessage(hw&,&H10,0,0&)
EndSub
2.IE浏览器打开网页
PrivateSubbmpGEFanucWebSite_Click()
DimlVarAsLong
DimResult
lVar=GetFocus()
'Thisshellfunctionaccessestheinternet,andopensdirectlytotheGEFanucWebsite
Result=ShellExecute(lVar,"Open","http:
\\",vbNullString,vbNullString,5)
'errorcheck;Ifthelocalnodeisnotconnectedtotheinternet,displayanerrormessage
IfResult<32Then
MsgBox"您需要连接服务器且具有互联网浏览器来显示GEFanuc网站。
"
EndIf
EndSub
3.打开帮助文档
PrivateDeclareFunctionWinHelpLib"user32"Alias"WinHelpA"(ByValhwndAsLong,ByVallpHelpFileAsString,ByValwCommandAsLong,ByValdwDataAsLong)AsLong
PrivateSubtxtHelpHelp_Click()
DimlngValueAsLong
DimhwndAsLong
'OpenHelpfortheOpenPictureCommandform
hwnd=GetFocus
lngValue=WinHelp(hwnd,System.HelpPath&"\SampleSystem.hlp",&H1&,1)
EndSub
4.关闭虚拟键盘(需要copy文件)
PrivateSubbmpStopKey_Click()
Dimhw&,cnt&
hw&=FindWindow("My-T-Mouse",vbNullString)
Ifhw&<>0Thencnt&=SendMessage(hw&,&H10,0,0&)
EndSub
5.打开虚拟键盘(需要copy文件)
PrivateSubbmpStartKey_Click()
Dimhw&
DimdAsDouble
hw&=FindWindow("My-T-Mouse",vbNullString)
Ifhw&=0Then
d=Shell(System.BasePath&"\MYTSOFT.EXE",vbMinimizedFocus)
EndIf
EndSub
6.检测机器分辨率
PublicFunctionCheckScreenResIsAtLeast1024x768()AsBoolean
'Function:
ReturnaTrueiftheNTscreenresolutionis 1024x768_
Onlydisplaythemessageboxonetime.
DimsngWidthAsSingle,sngHeightAsSingle,sMessageAsString
DimsTitleAsString
StaticboolRunOnceAsBoolean
OnErrorGoToHandleError
CheckScreenResIsAtLeast1024x768=False
sngWidth=clsSreenInfo.WidthInPixels
sngHeight=clsSreenInfo.HeightInPixels
IfsngWidth>=1024AndsngHeight>=768Then 'ifatleast1024x768resolution
CheckScreenResIsAtLeast1024x768=True
EndIf
IfNotCheckScreenResIsAtLeast1024x768AndNotboolRunOnceThen
sTitle="YourScreenResolutionis:
"&CStr(sngWidth)&"x"&CStr(sngHeight)
sMessage="Thesamplesystemisbestviewedatascreenresolutionofatleast"_
&"1024x768."&vbCrLf_
&"Tochange,gototheWindowsControlPanelandmodifytheDisplay->Settings"_
&"property."
'Weonlywanttoshowthisdialogonetime
MsgBoxsMessage,vbInformation,sTitle
boolRunOnce=True
EndIf
HandleError:
'Exithereonerror
EndFunction
7.改变字体大小
PublicSubChangeFontsIfBelow1024x768(objPicAsObject)
OnErrorResumeNext
DimsngWidthAsSingle,sngHeightAsSingle
DimclsSreenInfoAsNewScreenInfo
DimDummyStringAsString
DimobjChildAsObject
sngWidth=clsSreenInfo.WidthInPixels
sngHeight=clsSreenInfo.HeightInPixels
IfNot(sngWidth>=1024AndsngHeight>=768)Then 'ifnotatleast1024x768resolution
ForEachobjChildInobjPic.ContainedObjects
IfobjChild.ClassName="OleObject"Then
DummyString=objChild.Font.Size
IfErr.Number=0Then
objChild.Font.Size=objChild.Font.Size-2
EndIf
Err.Clear
EndIf
IfobjChild.ContainedObjects.Count>0Then
ChangeFontsIfBelow1024x768objChild
EndIf
Next
EndIf
SetclsSreenInfo=Nothing
EndSub
8.检测机器颜色是不是32真彩
(由于字数太多,代码已删除)
9.打开chm帮助指定页
PublicDeclareFunctionHTMLHelpLib"hhctrl.ocx"Alias"HtmlHelpA"(ByValhwndAsLong,ByVallpHelpFileAsString,ByValwCommandAsLong,dwDataAsAny)AsLong
PrivateSubtxtLearnAboutIt_Click()
'BringthemtothespecificHelpdocspage
DimaHelpFileAsString
DimsSecondaryAsString
aHelpFile=System.HelpPath&"\DRW.chm>secondary"
sSecondary="DRW_Using_Tag_Status_and_Quick_Trend_Pictures.htm"
CallHTMLHelp(0,aHelpFile,HH_DISPLAY_TOPIC,ByValsSecondary)
EndSub
10.切换当前页面的提示信息
PrivateSubcmdToggleToolTips_MouseUp(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)
OnErrorResumeNext
'Function:
Enable/Disabletooltips._
Notethatthisfunctiondoesnotrecursethroughgroupedobjects--it_
onlylooksat'main'objectsinthepicture
DimobjAsObject
boolToolTipsControl.CurrentValue=NotboolToolTipsControl.CurrentValue
ForEachobjInMe.ContainedObjects
obj.EnableTooltips=boolToolTipsControl.CurrentValue
Next
EndSub
11.弹出滑块调节(模拟量)
PrivateSubTankBatchC3_Click()
'TheCommentsbelowhavebeenaddedautomatically.
'Anychangescouldcauseadverseeffectstothefunctionality
'oftheScriptAuthoringExperts.
'WizardName=DataEntry
OnErrorGoToErrorHandler
IfblnDataEntryFrmFlag<>TrueThen
GetFormSlider
DimdblLowAsDouble
DimdblHighAsDouble
DimblnFetchAsBoolean
dblLow=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_elo")
dblHigh=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_ehi")
If(dblHigh>32767)Then
MsgBox"Thehighlimitcannotbegreaterthan32,767forthistypeofDataEntry,Pleasechooseanother."
ExitSub
EndIf
blnFetch=True
Slider.Slider1.min=CInt(dblLow)
Slider.Slider1.max=CInt(dblHigh)
Slider.GetTheVarsa:
=1,b:
="Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.F_CV"
Slider.lblLow.Caption=dblLow
Slider.lblHigh.Caption=dblHigh
Slider.Show
EndIf
ExitSub
ErrorHandler:
HandleError
EndSub
12.弹出按钮控制(数字量)
PrivateSubMixerGroup1_Click()
'TheCommentsbelowhavebeenaddedautomatically.
'Anychangescouldcauseadverseeffectstothefunctionality
'oftheScriptAuthoringExperts.
'WizardName=DataEntry
OnErrorGoToErrorHandler
IfblnDataEntryFrmFlag=TrueThen
ExitSub
EndIf
GetFormPushbutton
DimstrOpenButtonAsString
DimstrCloseButtonAsString
DimdblLowAsDouble
DimdblHighAsDouble
dblLow=0
dblHigh=1
strOpenButton="关闭"
strCloseButton="打开"
Pushbutton.GetTheVarsa:
=1,b:
="Fix32.THISNODE.IFIX1_BATCH_TANK3AGITATE.F_CV"
Pushbutton.cmdOpen.Caption=strOpenButton
Pushbutton.cmdClose.Caption=strCloseButton
Pushbutton.Show
ExitSub
ErrorHandler:
HandleError
EndSub
13.弹出梯度调节框
PrivateSubTempGroupTank1_Click()
'TheCommentsbelowhavebeenaddedautomatically.
'Anychangescouldcauseadverseeffectstothefunctionality
'oftheScriptAuthoringExperts.
'WizardName=DataEntry
OnErrorGoToErrorHandler
IfblnDataEntryFrmFlag=TrueThen
ExitSub
EndIf
GetFormRamp
DimstrFastAsString
DimstrSlowAsString
DimblnFetchAsBoolean
Ramp.GetTheLimitsHigh:
=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_ehi"),Low:
=ReadValue("Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_elo")
blnFetch=True
Ramp.GetTheVarsa:
=1,b:
="Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.F_CV"
Ramp.FastSlowF:
=10,s:
=5
strFast=10
strSlow=5
Ramp.lblSlow=strSlow&"%"
Ramp.lblFast=strFast&"%"
Ramp.Show
ExitSub
ErrorHandler:
HandleError
EndSub
14.确认报警控件中的所有报警
PrivateSubcmdAcknowledgeAll_Click()
' Acknowledgeallfilteredalarms
AlarmSummaryOCX1.AckAlarmPageEx
EndSub
15.确认所选报警
PrivateSubcmdAcknowledgeSelected_Click()
' Acknowledgethealarmcurrentlyselected
DimsNodeAsString,sTagAsString,boolTagSelectedAsBoolean
boolTagSelected=AlarmSummaryOCX1.GetSelectedNodeTag(sNode,sTag)
IfboolTagSelectedThenAcknowledgeAnAlarmsTag
EndSub
16.启用报警音效
PrivateSubcmdToggleAlarmHorn_Click()
'TheCommentsbelowhavebeenaddedautomatically.
'Anychangescouldcauseadverseeffectstothefunctionality
'oftheScriptAuthoringExperts.
'WizardName=AlarmHorn
'Property1=optExpertTypeToggle
AlarmHornEnabledToggle
EndSub
17.取消报警音效(静音)
PrivateSubcmdSilenceHorn_Click()
'TheCommentsbelowhavebeenaddedautomatically.
'Anychangescouldcauseadverseeffectstothefunctionality
'oftheScriptAuthoringExperts.
'WizardName=AlarmHorn
'Property1=optExpertTypeSilence
AlarmHornSilence
EndSub
18.在下拉菜单中选择排序列(画面加载时用additem加选报警列名)
PrivateSubcmbSortList_Change()
'Resortthelist
IfcmbSortList.Text<>""Then
AlarmSummaryOCX1.SortColumnName=cmbSortList.Text
EndIf
EndSub
19.报警控件中的升序
PrivateSuboptSortAscending_Click()
AlarmSummaryOCX1.SortOrderAscending=True
optSortDescending.Value=False
声音报警原代码
2007-09-0420:
54
在USER里添加一个模块,将下面代码放到模块里
PrivateDeclareFunctionsndPlaySound&Lib"winmm.dll"Alias"sndPlaySoundA"(ByVallpszSoundNameAsString,ByValuFlagsAsLong)
ConstSND_ASYNC=&H1
ConstSND_LOOP=&H8
PublicSubplayalarm()
OnErrorResumeNext
IfUser.playalarm.CurrentValue=TrueThen
sndPlaySound"C:
\windows\Media\ringin.wav",SND_ASYNCOrSND_LOOP '循环播放
EndIf
EndSub
PublicSubStopAlarm()
OnErrorResumeNext
sndPlaySou
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- IFIX 一些 常用 功能 VBA 代码