home *** CD-ROM | disk | FTP | other *** search
/ Mastering Visual Basic 6 / mastvb6.iso / ch_code / ch20 / seditor / script.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-07-02  |  6.4 KB  |  201 lines
  1. VERSION 5.00
  2. Object = "{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0"; "MSSCRIPT.OCX"
  3. Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
  4. Begin VB.Form ScriptForm 
  5.    Caption         =   "Interactive Script Editor"
  6.    ClientHeight    =   6180
  7.    ClientLeft      =   165
  8.    ClientTop       =   735
  9.    ClientWidth     =   9090
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   6180
  12.    ScaleWidth      =   9090
  13.    StartUpPosition =   3  'Windows Default
  14.    Begin MSComDlg.CommonDialog CommonDialog1 
  15.       Left            =   8040
  16.       Top             =   240
  17.       _ExtentX        =   847
  18.       _ExtentY        =   847
  19.       _Version        =   393216
  20.    End
  21.    Begin MSScriptControlCtl.ScriptControl ScriptControl1 
  22.       Left            =   7320
  23.       Top             =   120
  24.       _ExtentX        =   1005
  25.       _ExtentY        =   1005
  26.       AllowUI         =   -1  'True
  27.    End
  28.    Begin VB.CommandButton Command2 
  29.       Caption         =   "List Procedures"
  30.       BeginProperty Font 
  31.          Name            =   "Verdana"
  32.          Size            =   9.75
  33.          Charset         =   0
  34.          Weight          =   700
  35.          Underline       =   0   'False
  36.          Italic          =   0   'False
  37.          Strikethrough   =   0   'False
  38.       EndProperty
  39.       Height          =   645
  40.       Left            =   7215
  41.       TabIndex        =   3
  42.       TabStop         =   0   'False
  43.       Top             =   2385
  44.       Width           =   1785
  45.    End
  46.    Begin VB.TextBox Text2 
  47.       BeginProperty Font 
  48.          Name            =   "Courier New"
  49.          Size            =   9.75
  50.          Charset         =   0
  51.          Weight          =   400
  52.          Underline       =   0   'False
  53.          Italic          =   0   'False
  54.          Strikethrough   =   0   'False
  55.       EndProperty
  56.       Height          =   2085
  57.       Left            =   90
  58.       MultiLine       =   -1  'True
  59.       ScrollBars      =   2  'Vertical
  60.       TabIndex        =   2
  61.       TabStop         =   0   'False
  62.       Top             =   3945
  63.       Width           =   8895
  64.    End
  65.    Begin VB.CommandButton Command1 
  66.       Caption         =   "Execute Script"
  67.       BeginProperty Font 
  68.          Name            =   "Verdana"
  69.          Size            =   9.75
  70.          Charset         =   0
  71.          Weight          =   700
  72.          Underline       =   0   'False
  73.          Italic          =   0   'False
  74.          Strikethrough   =   0   'False
  75.       EndProperty
  76.       Height          =   645
  77.       Left            =   7215
  78.       TabIndex        =   1
  79.       TabStop         =   0   'False
  80.       Top             =   3120
  81.       Width           =   1785
  82.    End
  83.    Begin VB.TextBox Text1 
  84.       BeginProperty Font 
  85.          Name            =   "Verdana"
  86.          Size            =   9
  87.          Charset         =   0
  88.          Weight          =   400
  89.          Underline       =   0   'False
  90.          Italic          =   0   'False
  91.          Strikethrough   =   0   'False
  92.       EndProperty
  93.       Height          =   3645
  94.       Left            =   75
  95.       MultiLine       =   -1  'True
  96.       ScrollBars      =   3  'Both
  97.       TabIndex        =   0
  98.       TabStop         =   0   'False
  99.       Text            =   "Script.frx":0000
  100.       Top             =   105
  101.       Width           =   7035
  102.    End
  103.    Begin VB.Menu FileMenu 
  104.       Caption         =   "File"
  105.       Begin VB.Menu FileNew 
  106.          Caption         =   "New Script"
  107.       End
  108.       Begin VB.Menu FileLoad 
  109.          Caption         =   "Load Script"
  110.       End
  111.       Begin VB.Menu FileSave 
  112.          Caption         =   "Save Script"
  113.       End
  114.       Begin VB.Menu separator1 
  115.          Caption         =   "-"
  116.       End
  117.       Begin VB.Menu FileExit 
  118.          Caption         =   "Exit"
  119.       End
  120.    End
  121. Attribute VB_Name = "ScriptForm"
  122. Attribute VB_GlobalNameSpace = False
  123. Attribute VB_Creatable = False
  124. Attribute VB_PredeclaredId = True
  125. Attribute VB_Exposed = False
  126. '  ******************************
  127. '  ******************************
  128. '  ** MASTERING VB6            **
  129. '  ** by Evangelos Petroutos   **
  130. '  ** SYBEX, 1998              **
  131. '  ******************************
  132. '  ******************************
  133. Private display As New DisplayClass
  134. Private Sub Command1_Click()
  135. On Error GoTo CodeError
  136.     ScriptControl1.AddCode Text1.Text
  137.     ScriptControl1.Run "Main"
  138.     Exit Sub
  139. CodeError:
  140.     If ScriptControl1.Error.Number <> 0 Then
  141.         msg = ScriptControl1.Error.Description & vbCrLf
  142.         msg = msg & "In line " & ScriptControl1.Error.Line & ", column " & ScriptControl1.Error.Column
  143.         MsgBox msg, , "Error in script"
  144.     Else
  145.         MsgBox "ERROR # " & Err.Number & vbCrLf & Err.Description
  146.     End If
  147. End Sub
  148. Private Sub Command2_Click()
  149. On Error GoTo CodeError
  150.     ScriptControl1.AddCode Text1.Text
  151.     For i = 1 To ScriptControl1.Procedures.Count
  152.         If ScriptControl1.Procedures(i).HasReturnValue Then
  153.             Text2.Text = Text2.Text & vbCrLf & "Function   " & ScriptControl1.Procedures(1).Name
  154.         Else
  155.             Text2.Text = Text2.Text & vbCrLf & "Subroutine " & ScriptControl1.Procedures(1).Name
  156.         End If
  157.     Next
  158.     Exit Sub
  159. CodeError:
  160.     MsgBox Err.Description
  161. End Sub
  162. Private Sub FileLoad_Click()
  163. On Error GoTo OpenError
  164.     CommonDialog1.Filter = "Scripts|*.SCR|Text Files|*.TXT|All Files|*.*"
  165.     CommonDialog1.InitDir = App.Path
  166.     CommonDialog1.CancelError = True
  167.     CommonDialog1.ShowOpen
  168.     fnum = FreeFile
  169.     Open CommonDialog1.FileName For Input As #fnum
  170.     scriptText = Input(LOF(fnum), fnum)
  171.     Close #fnum
  172.     Text1.Text = scriptText
  173.     Exit Sub
  174. OpenError:
  175. End Sub
  176. Private Sub FileNew_Click()
  177.     Text1.Text = ""
  178.     Text2.Text = ""
  179. End Sub
  180. Private Sub FileSave_Click()
  181. On Error GoTo SaveError
  182.     CommonDialog1.Filter = "Scripts|*.SCR|Text Files|*.TXT|All Files|*.*"
  183.     CommonDialog1.DefaultExt = "*.SCR"
  184.     CommonDialog1.CancelError = True
  185.     CommonDialog1.ShowSave
  186.     fnum = FreeFile
  187.     Open CommonDialog1.FileName For Output As #fnum
  188.     Write #fnum, Text1.Text
  189.     Close #fnum
  190.     Exit Sub
  191. SaveError:
  192. End Sub
  193. Private Sub Form_Load()
  194.     ScriptControl1.AddObject "Output", display, True
  195. End Sub
  196. Private Sub ScriptControl1_Error()
  197. '    msg = ScriptControl1.Error.Description & bvcrlf
  198. '    msg = msg & "In line " & ScriptControl1.Error.Line & ", column " & ScriptControl1.Error.Column
  199. '    MsgBox msg, , "Error in Script Control"
  200. End Sub
  201.