home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
On Hand
/
On_Hand_From_Softbank_1994_Release_2_Disc_2_1994.iso
/
00202
/
s
/
disk1
/
main.fr_
/
main.bin
Wrap
Text File
|
1993-04-28
|
17KB
|
597 lines
VERSION 2.00
Begin Form frmMain
BorderStyle = 1 'Fixed Single
Caption = "DDE Experimenter"
FontTransparent = 0 'False
Height = 5745
Left = 930
LinkMode = 1 'Source
LinkTopic = "System"
ScaleHeight = 5340
ScaleWidth = 6210
Top = 1125
Width = 6330
Begin Frame Frames
Caption = "Destination Data"
Height = 3015
Index = 2
Left = 120
TabIndex = 21
Top = 2280
Width = 6015
Begin TextBox txtData
Height = 2160
Left = 120
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 22
Text = "Text1"
Top = 720
Width = 5760
End
Begin OptionButton optDataType
Caption = "Graphics"
Height = 255
Index = 1
Left = 1440
TabIndex = 14
Top = 360
Width = 1815
End
Begin OptionButton optDataType
Caption = "Text"
Height = 255
Index = 0
Left = 120
TabIndex = 13
Top = 360
Value = -1 'True
Width = 1095
End
Begin PictureBox picData
AutoRedraw = -1 'True
DrawWidth = 2
Height = 2160
Left = 120
ScaleHeight = 2130
ScaleWidth = 5730
TabIndex = 23
Top = 720
Visible = 0 'False
Width = 5760
End
End
Begin Frame Frames
Caption = "Source Properties"
Height = 1440
Index = 1
Left = 4200
TabIndex = 20
Top = 720
Width = 1920
Begin TextBox txtSourceTopic
Height = 285
Left = 120
TabIndex = 17
Text = "System"
Top = 960
Width = 1695
End
Begin CheckBox chkSourceMode
Caption = "&Source Enabled"
Height = 240
Left = 120
TabIndex = 15
Top = 360
Value = 1 'Checked
Width = 1680
End
Begin Label Labels
Caption = "Source &Link Topic"
Height = 240
Index = 3
Left = 120
TabIndex = 16
Top = 720
Width = 1680
End
End
Begin CommandButton cmdExit
Caption = "E&xit"
Height = 480
Left = 4200
TabIndex = 18
Top = 120
Width = 1920
End
Begin Frame Frames
Caption = "Destination Properties"
Height = 2160
Index = 0
Left = 120
TabIndex = 19
Top = 0
Width = 3960
Begin ComboBox cboAppName
Height = 300
Left = 1200
TabIndex = 1
Text = "ProgMan"
Top = 360
Width = 1215
End
Begin ComboBox cboTopic
Height = 300
Left = 720
TabIndex = 3
Text = "ProgMan"
Top = 720
Width = 1695
End
Begin ComboBox cboItem
Height = 300
Left = 720
TabIndex = 5
Top = 1080
Width = 1695
End
Begin OptionButton optLinkMode
Caption = "&Notify"
Height = 240
Index = 3
Left = 2640
TabIndex = 8
Top = 1200
Width = 960
End
Begin CommandButton cmdExecute
Caption = "&Execute"
Enabled = 0 'False
Height = 480
Left = 2640
TabIndex = 12
Top = 1560
Width = 1080
End
Begin CommandButton cmdPoke
Caption = "&Poke"
Enabled = 0 'False
Height = 480
Left = 1440
TabIndex = 11
Top = 1560
Width = 1080
End
Begin CommandButton cmdRequest
Caption = "&Request"
Enabled = 0 'False
Height = 480
Left = 240
TabIndex = 10
Top = 1560
Width = 1080
End
Begin OptionButton optLinkMode
Caption = "&Manual"
Height = 240
Index = 2
Left = 2640
TabIndex = 7
Top = 960
Width = 960
End
Begin OptionButton optLinkMode
Caption = "A&utomatic"
Height = 240
Index = 1
Left = 2640
TabIndex = 6
Top = 720
Width = 1200
End
Begin CommandButton cmdConnect
Caption = "&Connect"
Height = 480
Left = 2520
TabIndex = 9
Top = 240
Width = 1320
End
Begin Label Labels
Caption = "Item"
Height = 255
Index = 2
Left = 120
TabIndex = 4
Top = 1080
Width = 615
End
Begin Label Labels
Caption = "&Topic"
Height = 255
Index = 1
Left = 120
TabIndex = 2
Top = 720
Width = 615
End
Begin Label Labels
Caption = "&Application"
Height = 255
Index = 0
Left = 120
TabIndex = 0
Top = 360
Width = 975
End
End
Begin Label lblSysLink
Height = 375
Left = 4440
TabIndex = 25
Top = 5400
Visible = 0 'False
Width = 1455
End
Begin Label Topics
Height = 375
Left = 120
TabIndex = 24
Top = 5400
Visible = 0 'False
Width = 2175
End
End
Option Explicit
Option Compare Text ' Perform case-insensitive string comparisons
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
Sub cboAppName_Click ()
If Connected Then cmdConnect.Value = True
FillTopicList
End Sub
Sub cboAppName_LostFocus ()
If appChangeFlag Then
appChangeFlag = False
If Connected Then cmdConnect.Value = True
FillTopicList
End If
End Sub
Sub cboItem_Change ()
On Error Resume Next
picData.LinkItem = cboItem.Text
txtData.LinkItem = cboItem.Text
End Sub
Sub cboItem_Click ()
picData.LinkItem = cboItem.Text
txtData.LinkItem = cboItem.Text
End Sub
Sub cboTopic_Change ()
TopicChangeFlag = True
CheckForSystemTopic
End Sub
Sub cboTopic_Click ()
If Connected Then cmdConnect.Value = True
CheckForSystemTopic
End Sub
Sub cboTopic_LostFocus ()
If TopicChangeFlag Then
TopicChangeFlag = False
If Connected Then cmdConnect.Value = True
CheckForSystemTopic
End If
End Sub
Sub ChangeLinkTopic ()
End Sub
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 = ""
If cboAppName.Text = "WINWORD" Then
cboItem.AddItem "\Doc"
cboItem.Text = "\Doc"
cboItem.Refresh
End If
End If
End Sub
Sub chkSourceMode_Click ()
LinkMode = Abs(chkSourceMode.Value)
txtSourceTopic.Enabled = chkSourceMode.Value
End Sub
Sub cmdConnect_Click ()
Dim clientLinkMode As Integer
If Not Connected Then
For clientLinkMode = 1 To 3
If optLinkMode(clientLinkMode).Value Then Exit For
Next
picData.Picture = LoadPicture()
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
Disconnect picData
ConnectState False
End If
End Sub
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 "ProgMan"
frmExecute.cboExecuteString.AddItem "[CreateGroup(DDE Group)]"
frmExecute.cboExecuteString.AddItem "[AddItem(C:\VB\SAMPLES\DDE.EXE, Visual Basic DDE App)]"
frmExecute.cboExecuteString.AddItem "[ShowGroup(DDE Group, 7)]"
Case "Excel"
frmExecute.cboExecuteString.AddItem "[SELECT(" & Chr(34) & "R1:R16384" & Chr(34) & ")]"
frmExecute.cboExecuteString.AddItem "[NEW(2,2)]"
frmExecute.cboExecuteString.AddItem "[GALLERY.3D.PIE(4)]"
frmExecute.cboExecuteString.AddItem "[CLOSE()]"
Case "WinWord"
frmExecute.cboExecuteString.AddItem "[StartOfLine][EndOfLine 1]"
frmExecute.cboExecuteString.AddItem "[InsertBookmark .Name = " & Chr(34) & "DDE1" & Chr(34) & "]"
frmExecute.cboExecuteString.AddItem "[LineDown 1]"
End Select
frmExecute.Show MODAL
End Sub
Sub cmdExit_Click ()
Unload frmMain
End
End Sub
Sub cmdPoke_Click ()
On Error Resume Next
txtData.LinkPoke
If Err Then MsgBox Error
End Sub
Sub cmdRequest_Click ()
On Error Resume Next
txtData.LinkRequest
picData.LinkRequest
NotifyFlag = False
End Sub
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
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
Sub Disconnect (Ctl As Control)
Dim tempTimeOutVal
On Error Resume Next ' Disconnecting with ProgMan causes timeout error: just eat it and go on.
tempTimeOutVal = Ctl.LinkTimeout
Ctl.LinkTimeout = 1
Ctl.LinkMode = NONE
Ctl.LinkTimeout = tempTimeOutVal
End Sub
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
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
Sub FillTopicList ()
cboTopic.Clear
cboTopic.Text = ""
If cboAppName.Text = "ProgMan" Then
cboTopic.Text = "ProgMan"
Else
Screen.MousePointer = HOURGLASS
lblSysLink.LinkMode = NONE
lblSysLink.LinkTopic = cboAppName.Text & "|" & "System"
lblSysLink.LinkItem = "Topics"
On Error Resume Next
lblSysLink.LinkMode = LINK_MANUAL
If Err Then
cboTopic.AddItem "System"
Else
lblSysLink.LinkRequest
FillList cboTopic, lblSysLink
cboTopic.Text = "System"
End If
Screen.MousePointer = DEFAULT
End If
cboTopic.Refresh
End Sub
Sub Form_Load ()
cboAppName.AddItem "ProgMan"
cboAppName.AddItem "DDE"
cboAppName.AddItem "Excel"
cboAppName.AddItem "WinWord"
cboAppName.AddItem "FoxPro"
cboAppName.AddItem "Access"
cboAppName.AddItem "Project"
LinkTopic = txtSourceTopic.Text
Topics.Caption = "Topics" & Chr(9) & "picData" & Chr(9) & "txtData" & Chr(13) & Chr(10)
End Sub
Sub Form_Unload (Cancel As Integer)
Disconnect txtData
Disconnect picData
End Sub
Function MakeConnection (clientLinkMode As Integer) As Integer
Dim ConnectTxt As Integer, ConnectPic As Integer
ConnectPic = CreateLink(picData, (cboAppName.Text), (cboTopic.Text), (cboItem.Text), clientLinkMode)
ConnectTxt = CreateLink(txtData, (cboAppName.Text), (cboTopic.Text), (cboItem.Text), clientLinkMode)
If ConnectPic = NO_APP_RESPONDED And ConnectTxt = NO_APP_RESPONDED Then
MakeConnection = NO_APP_RESPONDED
ElseIf ConnectTxt = 0 Then
MakeConnection = 0
optDataType(DEST_TEXT).Value = True
ElseIf ConnectPic = 0 Then
MakeConnection = 0
optDataType(DEST_PIC).Value = True
Else
MakeConnection = ConnectPic
End If
End Function
Sub optDataType_Click (Index As Integer)
If Index = DEST_TEXT Then
txtData.Visible = True
picData.Visible = False
ElseIf Index = DEST_PIC Then
txtData.Visible = False
picData.Visible = True
End If
End Sub
Sub optLinkMode_Click (Index As Integer)
If Connected Then
cmdConnect.Value = True
cmdConnect.Value = True
End If
End Sub
Sub picData_LinkClose ()
ConnectState False
End Sub
Sub picData_LinkNotify ()
If Not NotifyFlag Then
MsgBox "New data is available from the DDE Source. Choose Request to update."
NotifyFlag = True
End If
End Sub
Sub picData_MouseDown (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 Then
PSet (X, Y)
Else
picData.ForeColor = QBColor(Rnd * 16)
End If
End Sub
Sub picData_MouseMove (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 Then picData.Line -(X, Y)
End Sub
Sub picData_MouseUp (Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button And 1 Then
picData.LinkSend
End If
End Sub
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
Sub txtData_LinkClose ()
ConnectState False
End Sub
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
Sub txtSourceTopic_Change ()
LinkTopic = txtSourceTopic.Text
End Sub