国产精品久久久久久久久软件,国产成人久久久精品二区三区,国产成人无码一区二区三区在线 ,大又大粗又爽又黄少妇毛片,国产精品成人aaaaa网站

首頁 新聞 工控搜 論壇 廠商論壇 產(chǎn)品 方案 廠商 人才 文摘 下載 展覽
中華工控網(wǎng)首頁
  P L C | 變頻器與傳動 | 傳感器 | 現(xiàn)場檢測儀表 | 工控軟件 | 人機(jī)界面 | 運動控制
  D C S | 工業(yè)以太網(wǎng) | 現(xiàn)場總線 | 顯示調(diào)節(jié)儀表 | 數(shù)據(jù)采集 | 數(shù)傳測控 | 工業(yè)安全
  電 源 | 嵌入式系統(tǒng) | PC based | 機(jī)柜箱體殼體 | 低壓電器 | 機(jī)器視覺
IFIX的VBA編程應(yīng)用!
航達(dá)星科技(北京)科技有限責(zé)任公司
收藏本文     查看收藏
 
根據(jù)現(xiàn)場實際需要做適當(dāng)修改后即可使用:
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任務(wù)管理器將工作臺關(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 "您需要連接服務(wù)器且具有互聯(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.檢測機(jī)器分辨率
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.檢測機(jī)器顏色是不是32真彩
(由于字?jǐn)?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.切換當(dāng)前頁面的提示信息
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.確認(rèn)報警控件中的所有報警
Private Sub cmdAcknowledgeAll_Click()
'   Acknowledge all filtered alarms
    AlarmSummaryOCX1.AckAlarmPageEx
End Sub

15.確認(rèn)所選報警
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
 
聲音報警原代碼
2007-09-04 20:54
在USER里添加一個模塊,將下面代碼放到模塊里
Private Declare Function sndPlaySound& Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long)
Const SND_ASYNC = &H1
Const SND_LOOP = &H8
Public Sub playalarm()
   On Error Resume Next
   If User.playalarm.CurrentValue = True Then
   sndPlaySound "C:\windows\Media\ringin.wav", SND_ASYNC Or SND_LOOP   '循環(huán)播放
   End If
End Sub
Public Sub StopAlarm()
   On Error Resume Next
   sndPlaySound vbNullString, SND_ASYNC '停止播放
   User.playalarm.CurrentValue = False
End Sub
Public Sub StartAlarm()
User.playalarm.CurrentValue = True
End Sub
 
 
登陸腳本
Private Sub cmdlogin_Click()

If user.userid.CurrentValue = "admin" Then
   If frmlogin.islogin() = True Then
      cmdlogin.Caption = "注銷"
   End If
    Else
       System.FixLogout
       MsgBox "用戶注銷成功!", vbOKOnly + vbInformation, "提示……"
       System.FixLogin "admin", "123"
       Call getuserinfo
       cmdlogin.Caption = "登陸"
     End If
End Sub
 
 
iFIX運行模式時預(yù)裝入畫面
工作臺以運行模式運行時,可以把經(jīng)常使用的畫面直接預(yù)載入到畫面緩存中。為 
實現(xiàn)這步操作,需要修改位于C:\Program Files\GE Fanuc\Proficy iFIX\LOCAL目錄中的 
FixUserPreferences.ini文件 可使用任何文本編輯器修改該文件。下面兩個配置參數(shù)位 
于FixUserPreferences.ini文件中[AppPreloadPicturePreferences]一節(jié)。這兩個參數(shù)用 
來預(yù)載入畫面。 

            TotalPreloadPicturePath=<nn> 
            PicturePath#0=Firstpicture.grf 

      TotalPreloadPicturePath表示預(yù)載入到緩存中的畫面數(shù)。PicturePath#N表示想載 
入的每幅畫面的名稱。如想預(yù)載入兩幅畫面,則在FixUserPreferences.ini文件中輸入下 
列行:  

            [AppPreloadPicturePreferences] 
            TotalPreloadPicturePath=2 
            PicturePath#0=Firstpicturename.grf 
            PicturePath#1=Secondpicturename.grf 

      注意:工作臺只有在啟用“畫面緩存”及選擇“運行模式”復(fù)選框時,才預(yù)載入畫面。在 
工作臺從“編輯模式”切換到“運行模式”時,并不預(yù)載入畫面。確保在FixUserPreferences.ini 
中定義的預(yù)裝入畫面的數(shù)量不要超過工作臺用戶首選項定義畫面緩存數(shù)。 

      修改完畢后保存并關(guān)閉FixUserPreferences文件。重新啟動“工作臺”,加載新的參數(shù)設(shè) 
置。一旦定義了預(yù)載入的畫面,則這些畫面一直被保存在內(nèi)存中。不會在運行模式中從緩 
存中被刪除。畫面只有在工作臺初始啟動為“運行模式”時才被預(yù)載入
 

 

狀 態(tài): 離線

會員簡介

會員代號: 18611337354
聯(lián) 系 人: 張雷
電  話: 010-52409679
傳  真: 010-64778487
地  址: 朝陽區(qū)啟陽路4號中輕大廈B座1803
郵  編: 100102
主  頁:
 
該廠商相關(guān)技術(shù)文摘:
IFIX的WEBSPACE使用總結(jié)
更多文摘...
立即發(fā)送詢問信息在線聯(lián)系該技術(shù)文摘廠商:
用戶名: 密碼: 免費注冊為中華工控網(wǎng)會員
請留下您的有效聯(lián)系方式,以方便我們及時與您聯(lián)絡(luò)

關(guān)于我們 | 聯(lián)系我們 | 廣告服務(wù) | 本站動態(tài) | 友情鏈接 | 法律聲明 | 不良信息舉報
工控網(wǎng)客服熱線:0755-86369299
版權(quán)所有 中華工控網(wǎng) Copyright©2022 Gkong.com, All Rights Reserved