home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch25code / frmdde.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-27  |  13.7 KB  |  387 lines
  1. VERSION 4.00
  2. Begin VB.Form frmDDE 
  3.    Caption         =   "DDE with Access 2.0"
  4.    ClientHeight    =   4770
  5.    ClientLeft      =   60
  6.    ClientTop       =   1380
  7.    ClientWidth     =   7365
  8.    Height          =   5175
  9.    Icon            =   "frmdde.frx":0000
  10.    Left            =   0
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   4770
  13.    ScaleWidth      =   7365
  14.    Top             =   1035
  15.    Width           =   7485
  16.    Begin VB.CommandButton cmd 
  17.       Caption         =   "E&xecute"
  18.       Height          =   375
  19.       Index           =   1
  20.       Left            =   5940
  21.       TabIndex        =   12
  22.       Top             =   540
  23.       Width           =   1230
  24.    End
  25.    Begin VB.CommandButton cmd 
  26.       Caption         =   "&Request"
  27.       Height          =   375
  28.       Index           =   0
  29.       Left            =   5940
  30.       TabIndex        =   10
  31.       Top             =   90
  32.       Width           =   1230
  33.    End
  34.    Begin VB.ComboBox cbo 
  35.       Height          =   315
  36.       Index           =   2
  37.       Left            =   135
  38.       TabIndex        =   7
  39.       Text            =   "cbo"
  40.       Top             =   2205
  41.       Width           =   7000
  42.    End
  43.    Begin VB.ComboBox cbo 
  44.       Height          =   315
  45.       Index           =   1
  46.       Left            =   135
  47.       TabIndex        =   5
  48.       Text            =   "cbo"
  49.       Top             =   1620
  50.       Width           =   7000
  51.    End
  52.    Begin VB.ComboBox cbo 
  53.       Height          =   315
  54.       Index           =   0
  55.       Left            =   135
  56.       TabIndex        =   3
  57.       Text            =   "cbo"
  58.       Top             =   1035
  59.       Width           =   7000
  60.    End
  61.    Begin VB.TextBox txtResult 
  62.       Height          =   1860
  63.       Left            =   135
  64.       MultiLine       =   -1  'True
  65.       ScrollBars      =   3  'Both
  66.       TabIndex        =   9
  67.       Top             =   2790
  68.       Width           =   7005
  69.    End
  70.    Begin VB.TextBox txtDatabase 
  71.       Height          =   285
  72.       Left            =   135
  73.       TabIndex        =   1
  74.       Text            =   "c:\vb\biblio.mdb"
  75.       Top             =   405
  76.       Width           =   5685
  77.    End
  78.    Begin VB.Label DDESource 
  79.       Caption         =   "DDESource"
  80.       Height          =   330
  81.       Left            =   4725
  82.       TabIndex        =   11
  83.       Top             =   45
  84.       Visible         =   0   'False
  85.       Width           =   1050
  86.    End
  87.    Begin VB.Label lbl 
  88.       BackStyle       =   0  'Transparent
  89.       Caption         =   "Res&ult:"
  90.       BeginProperty Font 
  91.          name            =   "MS Sans Serif"
  92.          charset         =   0
  93.          weight          =   700
  94.          size            =   8.25
  95.          underline       =   0   'False
  96.          italic          =   0   'False
  97.          strikethrough   =   0   'False
  98.       EndProperty
  99.       Height          =   195
  100.       Index           =   4
  101.       Left            =   135
  102.       TabIndex        =   8
  103.       Top             =   2565
  104.       Width           =   2400
  105.    End
  106.    Begin VB.Label lbl 
  107.       BackStyle       =   0  'Transparent
  108.       Caption         =   "&Execute:"
  109.       BeginProperty Font 
  110.          name            =   "MS Sans Serif"
  111.          charset         =   0
  112.          weight          =   700
  113.          size            =   8.25
  114.          underline       =   0   'False
  115.          italic          =   0   'False
  116.          strikethrough   =   0   'False
  117.       EndProperty
  118.       Height          =   195
  119.       Index           =   3
  120.       Left            =   135
  121.       TabIndex        =   6
  122.       Top             =   1980
  123.       Width           =   2400
  124.    End
  125.    Begin VB.Label lbl 
  126.       BackStyle       =   0  'Transparent
  127.       Caption         =   "&Item:"
  128.       BeginProperty Font 
  129.          name            =   "MS Sans Serif"
  130.          charset         =   0
  131.          weight          =   700
  132.          size            =   8.25
  133.          underline       =   0   'False
  134.          italic          =   0   'False
  135.          strikethrough   =   0   'False
  136.       EndProperty
  137.       Height          =   195
  138.       Index           =   2
  139.       Left            =   135
  140.       TabIndex        =   4
  141.       Top             =   1395
  142.       Width           =   2400
  143.    End
  144.    Begin VB.Label lbl 
  145.       BackStyle       =   0  'Transparent
  146.       Caption         =   "&Topic:"
  147.       BeginProperty Font 
  148.          name            =   "MS Sans Serif"
  149.          charset         =   0
  150.          weight          =   700
  151.          size            =   8.25
  152.          underline       =   0   'False
  153.          italic          =   0   'False
  154.          strikethrough   =   0   'False
  155.       EndProperty
  156.       Height          =   195
  157.       Index           =   1
  158.       Left            =   135
  159.       TabIndex        =   2
  160.       Top             =   810
  161.       Width           =   2400
  162.    End
  163.    Begin VB.Label lbl 
  164.       BackStyle       =   0  'Transparent
  165.       Caption         =   "&Database Location:"
  166.       BeginProperty Font 
  167.          name            =   "MS Sans Serif"
  168.          charset         =   0
  169.          weight          =   700
  170.          size            =   8.25
  171.          underline       =   0   'False
  172.          italic          =   0   'False
  173.          strikethrough   =   0   'False
  174.       EndProperty
  175.       Height          =   195
  176.       Index           =   0
  177.       Left            =   135
  178.       TabIndex        =   0
  179.       Top             =   180
  180.       Width           =   2400
  181.    End
  182. Attribute VB_Name = "frmDDE"
  183. Attribute VB_Creatable = False
  184. Attribute VB_Exposed = False
  185. '*************************************************************
  186. ' FRMDDE.FRM: User interface for DDE with Access 2.0.
  187. '*************************************************************
  188. Option Explicit
  189. '*************************************************************
  190. ' This is the DDE topic name that is used by all DDE connects
  191. ' in this demonstration program.
  192. '*************************************************************
  193. Const DDE_APPLICATION = "MSAccess"
  194. '*************************************************************
  195. ' These are the indexes of the cbo control array.
  196. '*************************************************************
  197. Const DDE_TOPIC = 0     'cbo(0)
  198. Const DDE_ITEM = 1      'cbo(1)
  199. Const DDE_EXECUTE = 2   'cbo(2)
  200. '*************************************************************
  201. ' Arbitrary constants which are used to populate the cbo(1)
  202. ' list with valid commands.
  203. '*************************************************************
  204. Const ITEMS_SYSTEM = 0
  205. Const ITEMS_LISTS = 1
  206. Const ITEMS_DATA = 2
  207. '*************************************************************
  208. ' This variable stores the path to BIBLIO.MDB file.
  209. '*************************************************************
  210. Private DatabaseName As String
  211. '*************************************************************
  212. ' When cbo(0) loses its focus, cbo(1) needs to be updated
  213. ' with valid DDE commands.
  214. '*************************************************************
  215. Private Sub cbo_LostFocus(Index As Integer)
  216.     Select Case Index
  217.         Case DDE_TOPIC
  218.             If InStr(cbo(DDE_TOPIC), "System") Then
  219.                 LoadItems ITEMS_SYSTEM
  220.             ElseIf InStr(cbo(DDE_TOPIC), ";TABLE") Then
  221.                 LoadItems ITEMS_DATA
  222.             ElseIf InStr(cbo(DDE_TOPIC), ";QUERY") Then
  223.                 LoadItems ITEMS_DATA
  224.             ElseIf InStr(cbo(DDE_TOPIC), ";SQL") Then
  225.                 LoadItems ITEMS_DATA
  226.             Else
  227.                 LoadItems ITEMS_LISTS
  228.             End If
  229.         Case DDE_ITEM
  230.         Case DDE_EXECUTE
  231.     End Select
  232. End Sub
  233. '*************************************************************
  234. ' Either request data, or execute a command.
  235. '*************************************************************
  236. Private Sub cmd_Click(Index As Integer)
  237.     Select Case Index
  238.         '*****************************************************
  239.         ' Request Data.
  240.         '*****************************************************
  241.         Case 0
  242.             '*************************************************
  243.             ' Get the data from Access and close the link.
  244.             '*************************************************
  245.             DDERequest DDESource, DDE_APPLICATION, _
  246.                     (cbo(DDE_TOPIC).Text), (cbo(DDE_ITEM).Text)
  247.             '*************************************************
  248.             ' If the data returned doesn't contain a line
  249.             ' feed, then replace tabs with carriage returns.
  250.             '*************************************************
  251.             If InStr(DDESource, Chr$(10)) = 0 Then
  252.                 txtResult = Replace(DDESource, Chr$(9), _
  253.                                     Chr$(13) & Chr$(10))
  254.             '*************************************************
  255.             ' Otherwise display the data as is was received.
  256.             '*************************************************
  257.             Else
  258.                 txtResult = DDESource
  259.             End If
  260.         '*****************************************************
  261.         ' Execute a Command.
  262.         '*****************************************************
  263.         Case 1
  264.             txtResult = ""
  265.             DDEExecute DDESource, DDE_APPLICATION, _
  266.                                     (cbo(DDE_EXECUTE).Text)
  267.     End Select
  268. End Sub
  269. '*************************************************************
  270. ' Load cbo(0) with some valid topics for Access.
  271. '*************************************************************
  272. Private Sub LoadTopics()
  273.     With cbo(DDE_TOPIC)
  274.         .Clear
  275.         .AddItem "System"
  276.         .AddItem DatabaseName
  277.         .AddItem DatabaseName & ";TABLE Authors"
  278.         .AddItem DatabaseName & ";QUERY [By State]"
  279.         .AddItem DatabaseName & ";SQL Select * From Authors"
  280.         .ListIndex = 0
  281.     End With
  282. End Sub
  283. '*************************************************************
  284. ' Load cbo(1) with some valid items for Access, based on a
  285. ' specific type of topic.
  286. '*************************************************************
  287. Private Sub LoadItems(TypeOfTopic As Integer)
  288.     With cbo(DDE_ITEM)
  289.         .Clear
  290.         Select Case TypeOfTopic
  291.             Case ITEMS_SYSTEM
  292.                 .AddItem "Status"
  293.                 .AddItem "Topics"
  294.                 .AddItem "SysItems"
  295.                 .AddItem "Formats"
  296.             Case ITEMS_LISTS
  297.                 .AddItem "TableList"
  298.                 .AddItem "QueryList"
  299.                 .AddItem "FormList"
  300.                 .AddItem "ReportList"
  301.                 .AddItem "MacroList"
  302.                 .AddItem "ModuleList"
  303.             Case ITEMS_DATA
  304.                 .AddItem "All"
  305.                 .AddItem "Data"
  306.                 .AddItem "FieldNames"
  307.                 .AddItem "FieldNames;T"
  308.                 .AddItem "FieldCount"
  309.                 .AddItem "NextRow"
  310.                 .AddItem "PrevRow"
  311.                 .AddItem "LastRow"
  312.                 .AddItem "FirstRow"
  313.                 .AddItem "SQLText"
  314.                 .AddItem "SQLText;5"
  315.             Case Else
  316.                 LoadItems ITEMS_SYSTEM
  317.         End Select
  318.         .ListIndex = 0
  319.     End With
  320. End Sub
  321. '*************************************************************
  322. ' Loads cbo(2) with some valid Access LinkExecute commands.
  323. '*************************************************************
  324. Private Sub LoadExecutes()
  325.     With cbo(DDE_EXECUTE)
  326.         .Clear
  327.         .AddItem "[OpenDatabase " & DatabaseName & "]"
  328.         .AddItem "[CloseDatabase]"
  329.         .ListIndex = 0
  330.     End With
  331. End Sub
  332. '*************************************************************
  333. ' Prepares the form for use.  This function is also called
  334. ' by txtDatabase_LostFocus to refresh the form.
  335. '*************************************************************
  336. Private Sub Form_Load()
  337.     #If Win32 Then
  338.         MsgBox "This sample is for Win16 only!", vbCritical
  339.         End
  340.     #End If
  341.     DatabaseName = txtDatabase
  342.     LoadTopics
  343.     LoadItems ITEMS_SYSTEM
  344.     LoadExecutes
  345.     txtResult = ""
  346.     DDESource = ""
  347. End Sub
  348. '*************************************************************
  349. ' Resizes the controls to the size of the form. This function
  350. ' is not foolproof, so don't try to break it.
  351. '*************************************************************
  352. Private Sub Form_Resize()
  353. Static Border%
  354. Dim i%
  355.     '*********************************************************
  356.     ' If the form is minimized, then break out.
  357.     '*********************************************************
  358.     If WindowState = 1 Then Exit Sub
  359.     '*********************************************************
  360.     ' Load the border variable, once.
  361.     '*********************************************************
  362.     If Not Border Then Border = txtDatabase.Left * 2
  363.     '*********************************************************
  364.     ' Adjust the combo boxes and command buttons.
  365.     '*********************************************************
  366.     For i = 0 To 2
  367.         cbo(i).Width = ScaleWidth - Border
  368.         If i < 2 Then cmd(i).Left = cbo(i).Width + _
  369.                       cbo(i).Left - cmd(i).Width
  370.     Next
  371.     '*********************************************************
  372.     ' Adjust the text boxes.
  373.     '*********************************************************
  374.     txtDatabase.Width = cmd(0).Left - (txtDatabase.Left * 2)
  375.     txtResult.Move txtResult.Left, _
  376.         txtResult.Top, ScaleWidth - Border, _
  377.         ScaleHeight - txtResult.Top - (Border / 2)
  378. End Sub
  379. '*************************************************************
  380. ' Updates the database variable and reloads the combo boxes
  381. ' to reflect any changes.
  382. '*************************************************************
  383. Private Sub txtDatabase_LostFocus()
  384.     DatabaseName = txtDatabase
  385.     Form_Load
  386. End Sub
  387.