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 / ch27code / frmtalk.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-30  |  9.9 KB  |  211 lines
  1. VERSION 4.00
  2. Begin VB.Form frmTalk 
  3.    Caption         =   "OLE Automation Talker"
  4.    ClientHeight    =   3570
  5.    ClientLeft      =   1095
  6.    ClientTop       =   1500
  7.    ClientWidth     =   7395
  8.    Height          =   3975
  9.    Icon            =   "frmtalk.frx":0000
  10.    Left            =   1035
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    ScaleHeight     =   3570
  14.    ScaleWidth      =   7395
  15.    Top             =   1155
  16.    Width           =   7515
  17.    Begin VB.CommandButton cmd 
  18.       Caption         =   "Replace Every Occurrence of a Word in Text Server with a New Word"
  19.       Height          =   375
  20.       Index           =   2
  21.       Left            =   135
  22.       TabIndex        =   3
  23.       Top             =   3105
  24.       Width           =   7125
  25.    End
  26.    Begin VB.CommandButton cmd 
  27.       Caption         =   "Get Text from Text Server"
  28.       Height          =   375
  29.       Index           =   1
  30.       Left            =   135
  31.       TabIndex        =   2
  32.       Top             =   2655
  33.       Width           =   7125
  34.    End
  35.    Begin VB.TextBox Text1 
  36.       BeginProperty Font 
  37.          name            =   "Courier New"
  38.          charset         =   0
  39.          weight          =   400
  40.          size            =   8.25
  41.          underline       =   0   'False
  42.          italic          =   0   'False
  43.          strikethrough   =   0   'False
  44.       EndProperty
  45.       Height          =   1995
  46.       Left            =   135
  47.       MultiLine       =   -1  'True
  48.       ScrollBars      =   2  'Vertical
  49.       TabIndex        =   0
  50.       Text            =   "frmtalk.frx":030A
  51.       Top             =   135
  52.       Width           =   7125
  53.    End
  54.    Begin VB.CommandButton cmd 
  55.       Caption         =   "Send Text to Text Server"
  56.       Height          =   375
  57.       Index           =   0
  58.       Left            =   135
  59.       TabIndex        =   1
  60.       Top             =   2205
  61.       Width           =   7125
  62.    End
  63. Attribute VB_Name = "frmTalk"
  64. Attribute VB_Creatable = False
  65. Attribute VB_Exposed = False
  66. '*********************************************************************
  67. ' Create a object that won't go out of scope too early.
  68. '*********************************************************************
  69. Option Explicit
  70. Private TextServer As Object
  71. '*********************************************************************
  72. ' Process command button clicks.
  73. '*********************************************************************
  74. Private Sub cmd_Click(Index As Integer)
  75. Dim FindText$, ReplaceWith$
  76.     Select Case Index
  77.         Case 0 'Send Text to Text Server
  78.             '*********************************************************
  79.             ' SetEditText takes 1 argument (a string). TextServer
  80.             ' uses this string to populate its text box.
  81.             '*********************************************************
  82.             TextServer.SetEditText Text1
  83.             TextServer.Show
  84.         Case 1 'Get Text from Text Server
  85.             '*********************************************************
  86.             ' GetEditText returns a string that contains the contents
  87.             ' of TextServer's text box.
  88.             '*********************************************************
  89.             Text1 = TextServer.GetEditText()
  90.         Case 2 'Get Text from Text Server
  91.             '*********************************************************
  92.             ' ReplaceAll finds every occurance of a word, and replaces
  93.             ' it with a new word. After the replace is complete, the
  94.             ' TextServer text box is updated to reflect the changes.
  95.             '*********************************************************
  96.             FindText = InputBox("Find What?")
  97.             If FindText = "" Then Exit Sub
  98.             ReplaceWith = InputBox("Replace With?")
  99.             If FindText = "" Then Exit Sub
  100.             TextServer.ReplaceAll FindText, ReplaceWith
  101.             TextServer.Show
  102.     End Select
  103.         
  104. End Sub
  105. '*********************************************************************
  106. ' Loads the form and establishes a connection with TextServer.
  107. '*********************************************************************
  108. Private Sub Form_Load()
  109.     On Error Resume Next
  110.     Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
  111.     '*****************************************************************
  112.     ' As a precaution, it useful to always register your server first.
  113.     '*****************************************************************
  114.     RegisterTextServer
  115.     '*****************************************************************
  116.     ' As this line demonstrates, all objects are created the same way.
  117.     '*****************************************************************
  118.     Set TextServer = CreateObject("Text.Document")
  119.     LoadText
  120.     '*****************************************************************
  121.     ' Show is one of TextServer's OLE Automation commands. It causes
  122.     ' TextServer to be activated and visible.
  123.     '*****************************************************************
  124.     ' NOTE: TextServer (and most OLE Automation apps) are invisible
  125.     '       by default, so you must make them visible by some method
  126.     '       if you want the user to see the application. If the user
  127.     '       doesn't need to see the application, then it isn't
  128.     '       necessary to make it visible.
  129.     '*****************************************************************
  130.     TextServer.Show
  131.     Show
  132. End Sub
  133. '*********************************************************************
  134. ' This proceedure just loads the text box with some sample text.
  135. '*********************************************************************
  136. Private Sub LoadText()
  137. Dim Source%, res$
  138.     Source = FreeFile
  139.     Open App.Path & "\sample.txt" For Input As Source
  140.         res = Input(LOF(Source), Source)
  141.         Text1 = res
  142.     Close Source
  143. End Sub
  144. '*********************************************************************
  145. ' This proceedure demonstrates how you can automatically register (or
  146. ' re-register) a application without any interaction from the user.
  147. '*********************************************************************
  148. Private Sub RegisterTextServer()
  149. Dim sTemp$, Source%, RegFile$
  150.     '*****************************************************************
  151.     ' The entire contents of sTemp was created by opening a .REG file
  152.     ' in Notepad, and inserting text before and after each line. That
  153.     ' text was then pasted into VB, and Notepad was closed without
  154.     ' saving. In addition, any of the lines that pointed to the .EXE,
  155.     ' were updated to reflect the path to the program (in this case
  156.     ' App.Path).
  157.     '*****************************************************************
  158.     sTemp = "REGEDIT" & vbCrLf
  159.     sTemp = sTemp & "; This .REG file is used to properly register TextServer." & vbCrLf
  160.     sTemp = sTemp & "COleObjectFactory::UpdateRegistryAll." & vbCrLf
  161.     sTemp = sTemp & "" & vbCrLf
  162.     sTemp = sTemp & "HKEY_CLASSES_ROOT\.txt = Text.Document" & vbCrLf
  163.     '*****************************************************************
  164.     ' The next 2 lines are combined into one line in the file that
  165.     ' points to the path where TEXTSVER.EXE is stored. If the
  166.     ' system registry doesn't point to a vaild path, DDE connections
  167.     ' will always fail uvbCrlfess TextServer is already running.
  168.     '*****************************************************************
  169.     sTemp = sTemp & "HKEY_CLASSES_ROOT\Text.Document\shell\open\command = "
  170.     sTemp = sTemp & App.Path & "\TEXTSVER.EXE %1" & vbCrLf
  171.     sTemp = sTemp & "HKEY_CLASSES_ROOT\Text.Document\shell\open\ddeexec = [open(""%1"")]" & vbCrLf
  172.     sTemp = sTemp & "HKEY_CLASSES_ROOT\Text.Document\shell\open\ddeexec\application = TEXTSVER" & vbCrLf
  173.     sTemp = sTemp & "" & vbCrLf
  174.     sTemp = sTemp & "HKEY_CLASSES_ROOT\Text.Document = Text Document" _
  175.                   & vbCrLf
  176.     sTemp = sTemp & "HKEY_CLASSES_ROOT\Text.Document\CLSID = {F15017A0-8245-101B-95FE-00AA0030472F}" & vbCrLf
  177.     sTemp = sTemp & "" & vbCrLf
  178.     sTemp = sTemp & "HKEY_CLASSES_ROOT\CLSID\{F15017A0-8245-101B-95FE-00AA0030472F} = Text Document" & vbCrLf
  179.     '*****************************************************************
  180.     ' Once again, the next two lines point to the path where
  181.     ' TEXTSVER.EXE is stored. If the system registry doesn't point
  182.     ' to a vaild path, CreateObject will always fail uvbCrlfess TextServer
  183.     ' is already running.
  184.     '*****************************************************************
  185.     sTemp = sTemp & "HKEY_CLASSES_ROOT\CLSID\{F15017A0-8245-101B-95FE-00AA0030472F}\LocalServer = "
  186.     sTemp = sTemp & App.Path & "\TEXTSVER.EXE" & vbCrLf
  187.     sTemp = sTemp & "HKEY_CLASSES_ROOT\CLSID\{F15017A0-8245-101B-95FE-00AA0030472F}\ProgId = Text.Document" & vbCrLf
  188.     '*****************************************************************
  189.     ' Create the .REG file on the end users hard drive.
  190.     '*****************************************************************
  191.     Source = FreeFile
  192.     RegFile = App.Path & "\TEXTSVER.REG"
  193.     '*****************************************************************
  194.     ' Clear the file
  195.     '*****************************************************************
  196.     Open RegFile For Output As Source
  197.     Close Source
  198.     '*****************************************************************
  199.     ' Create the reg file
  200.     '*****************************************************************
  201.     Open RegFile For Binary As Source
  202.         Put Source, , sTemp
  203.     Close Source
  204.     '*****************************************************************
  205.     ' Run RegEdit with the .REG file to automatically register it.
  206.     ' If the app was already registered, your file will update the
  207.     ' registry with any changes.
  208.     '*****************************************************************
  209.     Shell "regedit.exe /s " & RegFile, vbMinimizedNoFocus
  210. End Sub
  211.