IFIX中一些常用功能的VBA代码

1、根据现场实际需要做适当修改后即可使用:1,退出工作台OptionExplicitPrivateDeclareFunctionFindWindowLibuser32AliasFindWindowA(ByValIpCIassNameAsString,ByValIpWindowNameAsString)AsLongPrivateDeclareFunctionSendMessage&Libuser32AliasSendMessageA(ByValhwndAsLong,ByValwMsgAsLong,ByValwParamAsLong,ByVallParamAsAny)PrivateSubbmp

2、Exit_Click()DimlResultAsLongDimiResultDimhw&,cnt&hw&=FindWindow(iFixStartup,vbNullString)Ifhw&=0ThenMsgBox(无法关闭演示系统。请使用 Windows 任务管理器将工作台关闭。)EndIfIfhw&0Thencnt&=SendMessage(hw&,&H10,0,0&)EndSub1.1 E 浏览器打开网页PrivateSubbmpGEFanucWebSite_Click()DimlVarAsLongDimResultl

3、Var=GetFocus()Thisshellfunctionaccessestheinternet,andopensdirectlytotheGEFanucWebsiteResult=ShellExecute(lVar,Open,http:,vbNullString,vbNullString,5)errorcheck;Ifthelocalnodeisnotconnectedtotheinternet,displayanerrormessageIfResult32ThenMsgBox您需要连接服务器且具有互联网浏览器来显示 GEFanuc 网站。EndIfEndSub.打开帮助文档Privat

4、eDeclareFunctionWinHelpLibuser32AliasWinHelpA(ByValhwndAsLong,ByVAsString,ByValwCommandAsLong,ByValdwDataAsLong)AsLongPrivateSubtxtHelpHelp_Click()DimlngValueAsLongDimhwndAsLongOpenHelpfortheOpenPictureCommandformhwnd=GetFocuslngValue=WinHelp(hwnd,System.HelpPath&SampleSystem.hlp,&H1&,1)

5、EndSub.关闭虚拟键盘(需要 copy 文件)PrivateSubbmpStopKey_Click()Dimhw&,cnt&hw&=FindWindow(My-T-Mouse,vbNullString)Ifhw&0Thencnt&=SendMessage(hw&,&H10,0,0&)EndSub.打开虚拟键盘(需要 copy 文件)PrivateSubbmpStartKey_Click()Dimhw&DimdAsDoublehw&=FindWindow(My-T-Mouse,vbNullString)Ifhw&

6、amp;=0Thend=Shell(System.BasePath&MYTSOFT.EXE,vbMinimizedFocus)allpHelpFileEndIfEndSub.检测机器分辨率PublicFunctionCheckScreenResIsAtLeast1024x768()AsBooleanFunction:ReturnaTrueiftheNTscreenresolutionis1024x768_Onlydisplaythemessageboxonetime.DimsngWidthAsSingle,sngHeightAsSingle,sMessageAsStringDimsTi

7、tleAsStringStaticboolRunOnceAsBooleanOnErrorGoToHandleErrorCheckScreenResIsAtLeast1024x768=FalsesngWidth=clsSreenInfo.WidthInPixelssngHeight=clsSreenInfo.HeightInPixelsIfsngWidth=1024AndsngHeight=768Thenifatleast1024x768resolutionCheckScreenResIsAtLeast1024x768=TrueEndIfIfNotCheckScreenResIsAtLeast1

8、024x768AndNotboolRunOnceThensTitle=YourScreenResolutionis:&CStr(sngWidth)&x&CStr(sngHeight)sMessage=Thesamplesystemisbestviewedatascreenresolutionofatleast_&1024x768.&vbCrLf_&Tochange,gototheWindowsControlPanelandmodifytheDisplay-Settings_&property.Weonlywanttoshowthisdia

9、logonetimeMsgBoxsMessage,vbInformation,sTitleboolRunOnce=TrueEndIfHandleError:ExithereonerrorEndFunction.改变字体大小PublicSubChangeFontsIfBelow1024x768(objPicAsObject)OnErrorResumeNextDimsngWidthAsSingle,sngHeightAsSingleDimclsSreenInfoAsNewScreenInfoDimDummyStringAsStringDimobjChildAsObjectsngWidth=clsS

10、reenInfo.WidthInPixelssngHeight=clsSreenInfo.HeightInPixelsIfNot(sngWidth=1024AndsngHeight=768)ThenForEachobjChildInobjPic.ContainedObjectsIfobjChild.ClassName=OleObjectThenDummyString=objChild.Font.SizeIfErr.Number=0ThenobjChild.Font.Size=objChild.Font.Size-2EndIfErr.ClearEndIfIfobjChild.ContainedO

11、bjects.Count0ThenChangeFontsIfBelow1024x768objChildifnotatleast1024x768resolutionNextEndIfSetclsSreenlnfo=NothingEndSub.检测机器颜色是不是 32 真彩(由于字数太多，代码已删除).打开 chm 帮助指定页PublicDeclareFunctionHTMLHelpLibhhctrl.ocxAliasHtmlHelpA(ByValhwndAsLong,ByVallpHelpFileAsString,ByValwCommandAsLong,dwDataAsAny)AsLongPri

12、vateSubtxtLearnAboutIt_Click()BringthemtothespecificHelpdocspageDimaHelpFileAsStringDimsSecondaryAsStringaHelpFile=System.HelpPath&DRW.chmsecondarysSecondary=DRW_Using_Tag_Status_and_Quick_Trend_Pictures.htmCallHTMLHelp(0,aHelpFile,HH_DISPLAY_TOPIC,ByValsSecondary)EndSub.切换当前页面的提示信息PrivateSubcmd

13、ToggleToolTips_MouseUp(ByValButtonAsInteger,ByValShiftAsInteger,ByValXAsSingle,ByValYAsSingle)OnErrorResumeNextFunction:Enable/Disabletooltips._Notethatthisfunctiondoesnotrecursethroughgroupedobjects-it_onlylooksatmainobjectsinthepictureDimobjAsObjectboolToolTipsControl.CurrentValue=NotboolToolTipsC

14、ontrol.CurrentValueForEachobjInMe.ContainedObjectsobj.EnableTooltips=boolToolTipsControl.CurrentValueNextEndSub.弹出滑块调节(模拟量)PrivateSubTankBatchC3_Click()TheCommentsbelowhavebeenaddedautomatically.AnychangescouldcauseadverseeffectstothefunctionalityoftheScriptAuthoringExperts.WizardName=DataEntryOnErr

15、orGoToErrorHandlerIfblnDataEntryFrmFlagTrueThenGetFormSliderDimdblLowAsDoubleDimdblHighAsDoubleDimblnFetchAsBooleandblLow=ReadValue(Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_elo)dblHigh=ReadValue(Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.a_ehi)If(dblHigh32767)ThenMsgBoxThehighlimitcannotbegreaterthan32,76

16、7forthistypeofDataEntry,Pleasechooseanother.ExitSubEndIfblnFetch=TrueSlider.Slider1.min=Clnt(dblLow)Slider.Slider1.max=Clnt(dblHigh)Slider.GetTheVarsa:=1,b:=Fix32.THISNODE.IFIX1_BATCH_TANK3LEVEL.F_CVSlider.lblLow.Caption=dblLowSlider.lblHigh.Caption=dblHighEndIfExitSubErrorHandler:HandleErrorEndSub.

17、弹出按钮控制(数字量)PrivateSubMixerGroup1_Click()TheCommentsbelowhavebeenaddedautomatically.AnychangescouldcauseadverseeffectstothefunctionalityoftheScriptAuthoringExperts.WizardName=DataEntryOnErrorGoToErrorHandlerIfblnDataEntryFrmFlag=TrueThenExitSubEndIfGetFormPushbuttonDimstrOpenButtonAsStringDimstrClose

18、ButtonAsStringDimdblLowAsDoubleDimdblHighAsDoubledblLow=0dblHigh=1strOpenButton=关闭strCloseButton=打开Pushbutton.GetTheVarsa:=1,b:=Fix32.THISNODE.IFIX1_BATCH_TANK3AGITATE.F_CVPushbutton.cmdOpen.Caption=strOpenButtonPushbutton.cmdClose.Caption=strCloseButtonErrorHandler:HandleErrorEndSub.弹出梯度调节框PrivateS

19、ubTempGroupTank1_Click()TheCommentsbelowhavebeenaddedautomatically.AnychangescouldcauseadverseeffectstothefunctionalityoftheScriptAuthoringExperts.WizardName=DataEntryOnErrorGoToErrorHandlerIfblnDataEntryFrmFlag=TrueThenExitSubEndIfGetFormRampDimstrFastAsStringDimstrSlowAsStringDimblnFetchAsBooleanR

20、amp.GetTheLimitsHigh:=ReadValue(Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_ehi),Low:=ReadValue(Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.a_elo)blnFetch=TrueRamp.GetTheVarsa:=1,b:=Fix32.THISNODE.IFIX1_BATCH_TANK1TEMP.F_CVRamp.FastSlowF:=10,s:=5strFast=10strSlow=5Ramp.lblSlow=strSlow&%Ramp.lblFast=strFast&

21、amp;%ErrorHandler:HandleErrorEndSub.确认报警控件中的所有报警PrivateSubcmdAcknowledgeAll_Click()AcknowledgeallfilteredalarmsAlarmSummaryOCX1.AckAlarmPageExEndSub.确认所选报警PrivateSubcmdAcknowledgeSelected_Click()AcknowledgethealarmcurrentlyselectedDimsNodeAsString,sTagAsString,boolTagSelectedAsBooleanboolTagSelected

22、=AlarmSummaryOCX1.GetSelectedNodeTag(sNode,sTag)IfboolTagSelectedThenAcknowledgeAnAlarmsTagEndSub.启用报警音效PrivateSubcmdToggleAlarmHorn_Click()TheCommentsbelowhavebeenaddedautomaticallyAnychangescouldcauseadverseeffectstothefunctionalityoftheScriptAuthoringExperts.WizardName=AlarmHornProperty1=optExper

23、tTypeToggleAlarmHornEnabledToggle.取消报警音效(静音)PrivateSubcmdSilenceHorn_Click()TheCommentsbelowhavebeenaddedautomatically.AnychangescouldcauseadverseeffectstothefunctionalityoftheScriptAuthoringExperts.WizardName=AlarmHornProperty1=optExpertTypeSilenceAlarmHornSilenceEndSub.在下拉菜单中选择排序列(画面加载时用 additem 加

24、选报警列名)PrivateSubcmbSortList_Change()ResortthelistIfcmbSortList.TextThenAlarmSummaryOCX1.SortColumnName=cmbSortList.TextEndIfEndSub.报警控件中的升序PrivateSuboptSortAscending_Click()AlarmSummaryOCX1.SortOrderAscending=TrueoptSortDescending.Value=False声音报警原代码2007-09-0420:54在USER1添加一个模块，将下面代码放到模块里PrivateDeclar

25、eFunctionsndPlaySound&Libwinmm.dllAliassndPlaySoundA(ByVallpszSoundNameAsString,ByValuFlagsAsLong)ConstSND_ASYNC=&H1ConstSND_LOOP=&H8PublicSubplayalarm()OnErrorResumeNextIfUser.playalarm.CurrentValue=TrueThensndPlaySoundC:windowsMediaringin.wav,SND_ASYNCOrSND_LOOP循环播放EndIfEndSubPublicSubStopAlarm()OnErrorResumeNextsndPlaySoundvbNullString,SND_ASYNC停止播放User.playalarm.CurrentValue=FalseEndSubPublicSubStartAlarm()User.playalarm.CurrentValue=TrueEndSub登陆脚本PrivateSubcmdlogin_Click()Ifuser.userid.CurrentValue=adminThenIffrmlogin.islogin()=TrueThencmdlogin.Caption=注销EndIfElseSystem.