⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main.frm

📁 labwindows 源码 CVI的 DDE数据交换源代码 这是CVI和VB2种平台之间的数据交互
💻 FRM
📖 第 1 页 / 共 2 页
字号:
Dim TopicChangeFlag As Integer, appChangeFlag As Integer, Connected As Integer
Dim NotifyFlag As Integer
Const DEST_TEXT = 0, DEST_PIC = 1
Const MNU_COPY = 0, MNU_PASTE = 1, MNU_PASTELINK = 2

Private Sub cboAppName_Click()
    If Connected Then cmdConnect.Value = True
    FillTopicList
End Sub

Private Sub cboAppName_LostFocus()
    If appChangeFlag Then
        appChangeFlag = False
        If Connected Then cmdConnect.Value = True
        FillTopicList
    End If
End Sub

Private Sub cboItem_Change()
On Error Resume Next
    txtData.LinkItem = cboItem.Text
End Sub

Private Sub cboItem_Click()
    picData.LinkItem = cboItem.Text
    txtData.LinkItem = cboItem.Text
End Sub

Private Sub cboTopic_Change()
    TopicChangeFlag = True
    CheckForSystemTopic
End Sub

Private Sub cboTopic_Click()
    If Connected Then cmdConnect.Value = True
    CheckForSystemTopic
End Sub

Private Sub cboTopic_LostFocus()
    If TopicChangeFlag Then
        TopicChangeFlag = False
        If Connected Then cmdConnect.Value = True
        CheckForSystemTopic
    End If
End Sub

Private Sub ChangeLinkTopic()

End Sub

Private Sub CheckForSystemTopic()
Dim i
    If cboTopic.Text = "SYSTEM" Or cboTopic.Text = "PROGMAN" Then
        FillSysItems
        optLinkMode(1).Enabled = False
        optLinkMode(3).Enabled = False
        optLinkMode(2).Value = True
    Else
        For i = 1 To 3
            optLinkMode(i).Enabled = True
        Next
        cboItem.Clear
        cboItem.Text = ""
    End If
End Sub

Private Sub chkSourceMode_Click()
    LinkMode = Abs(chkSourceMode.Value)
    txtSourceTopic.Enabled = chkSourceMode.Value
End Sub

Private Sub cmdConnect_Click()
Dim clientLinkMode As Integer
    If Not Connected Then
        For clientLinkMode = 1 To 3
            If optLinkMode(clientLinkMode).Value Then Exit For
        Next
        txtData.Text = ""
        Select Case MakeConnection(clientLinkMode)
            Case 0
                ConnectState True
            Case NO_APP_RESPONDED
                If MsgBox("Hey! " & cboAppName.Text & " doesn't seem to be running. Should I start it?", MB_YESNO + MB_ICONQUESTION) = IDYES Then
                    If StartApp((cboAppName.Text)) Then
                        Select Case MakeConnection(clientLinkMode)
                            Case 0
                                ConnectState True
                            Case NO_APP_RESPONDED
                                MsgBox "Sorry, still can't connect."
                        End Select
                    End If
                End If
        End Select
    Else
        Disconnect txtData
        ConnectState False
    End If
End Sub

Private Sub CmdExecute_Click()
    ' Empty combo box on Execute form
    ' (This also implictly loads the form if it was unloaded).
    frmExecute.cboExecuteString.Clear

    ' Load sample execute strings appropriate to the source application
    Select Case cboAppName.Text
        Case "Test Server"
            frmExecute.cboExecuteString.AddItem "ToggleAuto"
            frmExecute.cboExecuteString.Text = "ToggleAuto"
    End Select

    frmExecute.Show MODAL
End Sub

Private Sub cmdExit_Click()
    Unload frmMain
    End
End Sub

Private Sub cmdPoke_Click()
On Error Resume Next
    txtData.LinkPoke
    If Err Then MsgBox Error
End Sub

Private Sub cmdRequest_Click()
On Error Resume Next
    txtData.Text = ""
    txtData.LinkRequest
    NotifyFlag = False
End Sub

Private Sub ConnectState(State As Integer)
Dim i As Integer

    If State Then
        cmdConnect.Caption = "Disconnect"
    Else
        cmdConnect.Caption = "Connect"
    End If
        
    Connected = State
    cmdRequest.Enabled = State
    cmdPoke.Enabled = (optLinkMode(LINK_MANUAL).Value And State)
    cmdExecute.Enabled = State

    'cboAppName.Enabled = Not State
    'cboTopic.Enabled = Not State
End Sub

Private Function CreateLink(Ctl As Control, appname As String, topic As String, item As String, LinkType As Integer) As Integer
On Error Resume Next
    Ctl.LinkMode = NONE
    Ctl.LinkTopic = appname & "|" & topic
    Ctl.LinkItem = item
    Ctl.LinkMode = LinkType
    CreateLink = Err
    If Err = 0 And LinkType <> LINK_AUTOMATIC Then
        Ctl.LinkRequest
    End If
End Function

Private Sub Disconnect(Ctl As Control)
Dim tempTimeOutVal
On Error Resume Next    ' Disconnecting with ProgMan causes timeout error: just eat it and go on.
    If (gToggleAuto) Then
        frmMain.txtData.LinkExecute "ToggleAuto"
    End If
    tempTimeOutVal = Ctl.LinkTimeout
    Ctl.LinkTimeout = 1
    Ctl.LinkMode = NONE
    Ctl.LinkTimeout = tempTimeOutVal
End Sub

Private Sub FillList(cbo As Control, lbl As Control)
Dim i As Integer, lasti As Integer
    Do
        i = i + 1
        lasti = i
        i = InStr(lasti, lbl.Caption, Chr(9))
        If i = 0 Then
            cbo.AddItem Mid(lbl.Caption, lasti)
            Exit Do
        Else
            cbo.AddItem Mid(lbl.Caption, lasti, i - lasti)
        End If
    Loop
End Sub

Private Sub FillSysItems()
    cboItem.Clear
    Screen.MousePointer = HOURGLASS
    lblSysLink.LinkMode = NONE
    lblSysLink.LinkTopic = cboAppName.Text & "|" & "System"
    lblSysLink.LinkItem = "SysItems"
    On Error Resume Next
    lblSysLink.LinkMode = LINK_MANUAL
    If Err = 0 Then
        lblSysLink.LinkRequest
        FillList cboItem, lblSysLink
        cboItem.Text = "SysItems"
    End If
    cboItem.Refresh
    Screen.MousePointer = Default
End Sub

Private Sub FillTopicList()
    cboTopic.Clear
    cboTopic.Text = ""
    If cboAppName.Text = "Test Server" Then
        cboTopic.Text = "DDE Test"
        cboTopic.AddItem "DDE Test"
        cboItem.Text = "Knob"
        cboItem.AddItem "Knob"
    End If

    cboTopic.Refresh
End Sub

Private Sub Form_LinkClose()
    Dim Msg
    Msg = "CVI DDE Client closed connection"
    MsgBox Msg
End Sub

Private Sub Form_LinkExecute(CmdStr As String, Cancel As Integer)
    Dim Msg
    Msg = "CVI DDE Client requested command: "
    Msg = Msg + CmdStr
    MsgBox Msg
    Cancel = 0
End Sub

Private Sub Form_LinkOpen(Cancel As Integer)
    Dim Msg
    Msg = "CVI DDE Client initiated connection"
    MsgBox Msg
End Sub

Private Sub Form_Load()
    cboAppName.AddItem "Test Server"

    LinkTopic = txtSourceTopic.Text
    Topics.Caption = "Topics" & Chr(9) & "picData" & Chr(9) & "txtData" & Chr(13) & Chr(10)

    'initialize global variable
    gToggleAuto = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Disconnect txtData
End Sub

Private Function MakeConnection(clientLinkMode As Integer) As Integer
Dim ConnectTxt As Integer
    ConnectTxt = CreateLink(txtData, (cboAppName.Text), (cboTopic.Text), (cboItem.Text), clientLinkMode)
    
    If ConnectTxt = NO_APP_RESPONDED Then
        MakeConnection = NO_APP_RESPONDED
    ElseIf ConnectTxt = 0 Then
        MakeConnection = 0
        optDataType(DEST_TEXT).Value = True
    End If
End Function

Private Sub optDataType_Click(Index As Integer)
    If Index = DEST_TEXT Then
        txtData.Visible = True
    ElseIf Index = DEST_PIC Then
        txtData.Visible = False
    End If
End Sub

Private Sub optLinkMode_Click(Index As Integer)
    If Connected Then
        cmdConnect.Value = True
    End If
End Sub

Private Function StartApp(appname As String) As Integer
On Error Resume Next
    StartApp = (Shell(appname) > 31)
    If Err Then MsgBox "Couldn't start " & appname
    StartApp = 0
End Function

Private Sub txtData_LinkClose()
    ConnectState False
End Sub

Private Sub txtData_LinkNotify()
    If Not NotifyFlag Then
        MsgBox "New data is available from the DDE Source.  Choose Request to update."
        NotifyFlag = True
    End If
End Sub

Private Sub txtSourceTopic_Change()
    LinkTopic = txtSourceTopic.Text
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -