📄 main.frm
字号:
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 + -