Visual Basic/Jarithmetic Round Two Implementation

From Wikibooks, open books for an open world
< Visual Basic(Redirected from Programming:Visual Basic Classic/Jarithmetic Round Two Implementation)
Jump to: navigation, search

Introduction[edit]

This chapter describes an implementation of what has been discussed so far.

The technique used is to intersperse code and discussion. You should be able to extract the code by simply copying the whole page and commenting out the discussion.

The previous discussion has been at a very high level, implementing it will require both high level and low level coding and also a lot of refinement of our ideas.

The application will consist of a form, some modules and some classes. We'll begin at the top by creating the user interface of the application, then we will add the code that makes it work piece by piece. We will find that some of what was said in the previous discussion was incomplete, some of it misleading. That's what happens in real development.

User Interface[edit]

I have chosen to implement this program as a Multiple Document Interface application. this is usually referred to as a MDI application. All this means is that it will be possible to have more than one Jarithmetic document open at the same time in the same instance of the program. This is the way that most Microsoft Office applications worked in the past.


fMainform.frm[edit]

Here is a possible main form. The picture shows more menus than are actually implemented in the first version, implement them as you go along.

MDI form

Here is the declaration of the controls on the form. You can paste this into a text editor and save it as fMainForm.frm to get started quickly.

The main form is a container for as many documents as the user wants to open. Each document will be an instance of frmDocument, see the next section.

 VERSION 5.00
 Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
 Begin VB.MDIForm fMainform 
    BackColor       =   &H8000000C&
    Caption         =   "Arithmetic"
    ClientHeight    =   2790
    ClientLeft      =   165
    ClientTop       =   765
    ClientWidth     =   5280
    Icon            =   "Fmainform.frx":0000
    LinkTopic       =   "MDIForm1"
    StartUpPosition =   3  'Windows Default
    Begin MSComDlg.CommonDialog CommonDialog1 
       Left            =   360
       Top             =   240
       _ExtentX        =   847
       _ExtentY        =   847
       _Version        =   393216
    End
    Begin VB.Menu mnuFile 
       Caption         =   "&File"
       Index           =   1
       Begin VB.Menu mnuFileNew 
          Caption         =   "&New"
          Shortcut        =   ^N
       End
       Begin VB.Menu mnuFileOpen 
          Caption         =   "&Open..."
          Shortcut        =   ^O
       End
       Begin VB.Menu mnuFileBar0 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFileSave 
          Caption         =   "&Save"
          Shortcut        =   ^S
       End
       Begin VB.Menu mnuFileSaveAs 
          Caption         =   "Save &As..."
       End
       Begin VB.Menu mnuFileSaveAll 
          Caption         =   "Save A&ll"
       End
       Begin VB.Menu mnuFileClose 
          Caption         =   "&Close"
          Shortcut        =   ^E
       End
       Begin VB.Menu mnuFileCloseAll 
          Caption         =   "&CloseAll"
       End
       Begin VB.Menu mnuFileBar1 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFilePrint 
          Caption         =   "&Print..."
          Shortcut        =   ^P
       End
       Begin VB.Menu mnuFilePrintSetup 
          Caption         =   "&PrintSetup"
       End
       Begin VB.Menu mnuFilePrintPreview 
          Caption         =   "&PrintPreview"
          Shortcut        =   ^R
       End
       Begin VB.Menu mnuFileBar3 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFileSend 
          Caption         =   "&Send"
          Begin VB.Menu mnuFileSendEmail 
             Caption         =   "&Email"
          End
       End
       Begin VB.Menu mnuFileExit 
          Caption         =   "E&xit"
          Shortcut        =   {F4}
       End
    End
    Begin VB.Menu mnuEdit 
       Caption         =   "&Edit"
       Begin VB.Menu mnuEditUndo 
          Caption         =   "&Undo"
          Shortcut        =   ^Z
       End
       Begin VB.Menu mnuEditRedo 
          Caption         =   "&Redo"
       End
       Begin VB.Menu mnueditbar2 
          Caption         =   "-"
       End
       Begin VB.Menu mnuEditCut 
          Caption         =   "Cu&t"
          Shortcut        =   ^X
       End
       Begin VB.Menu mnuEditCopy 
          Caption         =   "&Copy"
          Shortcut        =   ^C
       End
       Begin VB.Menu mnuEditPaste 
          Caption         =   "&Paste"
          Shortcut        =   ^V
       End
       Begin VB.Menu mnueditbar3 
          Caption         =   "-"
       End
       Begin VB.Menu mnuEditSelectAll 
          Caption         =   "&SelectAll"
          Shortcut        =   ^A
       End
    End
    Begin VB.Menu mnuData 
       Caption         =   "&Data"
       Begin VB.Menu mnuEvaluate 
          Caption         =   "&Evaluate"
          Shortcut        =   {F9}
       End
    End
    Begin VB.Menu mnuWindow 
       Caption         =   "&Window"
       WindowList      =   -1  'True
       Begin VB.Menu mnuWindowNewWindow 
          Caption         =   "&New Window"
          Shortcut        =   {F12}
       End
       Begin VB.Menu mnuWindowBar0 
          Caption         =   "-"
       End
       Begin VB.Menu mnuWindowCascade 
          Caption         =   "&Cascade"
       End
       Begin VB.Menu mnuWindowTileHorizontal 
          Caption         =   "Tile &Horizontal"
       End
       Begin VB.Menu mnuWindowTileVertical 
          Caption         =   "Tile &Vertical"
       End
       Begin VB.Menu mnuWindowArrangeIcons 
          Caption         =   "&Arrange Icons"
       End
    End
    Begin VB.Menu mnuHelp 
       Caption         =   "&Help"
       Begin VB.Menu mnuHelpContents 
          Caption         =   "&HelpContents"
          Shortcut        =   {F1}
       End
       Begin VB.Menu mnuHelpTipoftheDay 
          Caption         =   "&TipoftheDay"
       End
       Begin VB.Menu mnuHelpAbout 
          Caption         =   "&About "
       End
       Begin VB.Menu mnuHelpSpecialThanks 
          Caption         =   "&SpecialThanks"
       End
    End
 End
 Attribute VB_Name = "fMainform"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False


Now here is the visible code of the form. It is quite short as the MDI form doesn't do very much, it mostly just acts as a container for document forms.

The MDI form has a file menu. When there are no document forms open it is this menu that is active. When document forms are open the file menu that is shown belongs to the document form but we will still call this method. When VB creates the mthod for us it will be marked Private, we can change this to Public as has been done here but it might be cleaner and less confusing to leave it Private and add a new Friend method that calls it.

When we open a document we must first create a document form to hold it. Within this program instance of frmDocument represent the document. The design decision made here is that each time we open a document it will be loaded into a new instance of frmDocument. This might or might not be appropriate, consider what happens if the user opens the same document twice and edits both.

We use the Common Dialog control provided by Microsoft but we could also use a form containing Drive, Folder and File list controls.

 Option Explicit ' always use this to ensure that you don't forget to declare variables
 
 
 Public Sub mnuFileOpen_Click()
     
   Dim oForm As frmDocument
   Set oForm = LoadNewDoc
   
   With CommonDialog1
     ' The title should probably say something meaningful about the application and the document 
     .DialogTitle = "Open" type
     .CancelError = False
     .Filter = gsFILE_FILTER
     .ShowOpen
     If Len(.FileName) = 0 Then
       Exit Sub
     End If
     If Not oForm.LoadFile(.FileName) Then
       MsgBox "Could not load file <" & .FileName & ">," & vbCrLf & "probably couldn't find the zlib.dll.", _
              vbOKOnly + vbCritical, Title
     End If
   End With
 
 End Sub
 

The LoadNewDoc function is separated from the File Open event handler so that it can be used by other callers.

 Public Function LoadNewDoc() As frmDocument
   
   Static lDocumentCount As Long
   lDocumentCount = lDocumentCount + 1
   Set LoadNewDoc = New frmDocument
   LoadNewDoc.Caption = "Document " & lDocumentCount
   LoadNewDoc.Show
 
 End Function
 

When we unload the main form we want to be able to make sure that all the documents are properly cleaned up so we call a function to exit from the application. We could use the return value to set the Cancel argument, then the user might be able to stop the shutdown.

 Private Sub MDIForm_Unload(Cancel As Integer)
   ExitApplication
 End Sub

frmDocument.frm[edit]

The document form holds one of our arithmetic documents. It is not much more complicated than the main form. However it does define some different menus. Also because of the way VB6 works it must define all the same menus too, it can't inherit them from the main form. VB shows the menus defined by the current form unless there is only the MDI form in which case that one is shown. Again the graphic shows more menus than are actually implemented in this prototype.

Document form

Here are the definitions of the menus and controls:

 VERSION 5.00
 Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "RICHTX32.OCX"
 Begin VB.Form frmDocument 
    Caption         =   "Document"
    ClientHeight    =   3600
    ClientLeft      =   60
    ClientTop       =   60
    ClientWidth     =   6225
    Icon            =   "frmDocument.frx":0000
    KeyPreview      =   -1  'True
    LinkTopic       =   "Form1"
    MDIChild        =   -1  'True
    ScaleHeight     =   3600
    ScaleWidth      =   6225
    WindowState     =   2  'Maximized
    Begin RichTextLib.RichTextBox rtfBox 
       Height          =   3315
       Left            =   120
       TabIndex        =   0
       Top             =   240
       Width           =   6000
       _ExtentX        =   10583
       _ExtentY        =   5847
       _Version        =   393217
       Enabled         =   -1  'True
       HideSelection   =   0   'False
       ScrollBars      =   2
       TextRTF         =   $"frmDocument.frx":030A
       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
          Name            =   "Times New Roman"
          Size            =   12
          Charset         =   0
          Weight          =   400
          Underline       =   0   'False
          Italic          =   0   'False
          Strikethrough   =   0   'False
       EndProperty
    End
    Begin VB.Menu mnuFile 
       Caption         =   "&File"
       Index           =   1
       Begin VB.Menu mnuFileNew 
          Caption         =   "&New"
          Shortcut        =   ^N
       End
       Begin VB.Menu mnuFileOpen 
          Caption         =   "&Open..."
          Shortcut        =   ^O
       End
       Begin VB.Menu mnuFileBar0 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFileSave 
          Caption         =   "&Save"
          Shortcut        =   ^S
       End
       Begin VB.Menu mnuFileSaveAs 
          Caption         =   "Save &As..."
       End
       Begin VB.Menu mnuSaveCompressed 
          Caption         =   "Save &Compressed"
       End
       Begin VB.Menu mnuFileSaveAll 
          Caption         =   "Save A&ll"
       End
       Begin VB.Menu mnuFileClose 
          Caption         =   "&Close"
          Shortcut        =   ^E
       End
       Begin VB.Menu mnuFileCloseAll 
          Caption         =   "&CloseAll"
       End
       Begin VB.Menu mnuFileBar1 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFilePrint 
          Caption         =   "&Print..."
          Shortcut        =   ^P
       End
       Begin VB.Menu mnuFilePrintSetup 
          Caption         =   "&PrintSetup"
       End
       Begin VB.Menu mnuFilePrintPreview 
          Caption         =   "&PrintPreview"
          Shortcut        =   ^R
       End
       Begin VB.Menu mnuFileBar3 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFileSend 
          Caption         =   "&Send"
          Begin VB.Menu mnuFileSendEmail 
             Caption         =   "&Email"
          End
       End
       Begin VB.Menu mnuFileExit 
          Caption         =   "E&xit"
          Shortcut        =   {F4}
       End
    End
    Begin VB.Menu mnuEdit 
       Caption         =   "&Edit"
       Begin VB.Menu mnuEditUndo 
          Caption         =   "&Undo"
          Shortcut        =   ^Z
       End
       Begin VB.Menu mnuEditRedo 
          Caption         =   "&Redo"
       End
       Begin VB.Menu mnueditbar2 
          Caption         =   "-"
       End
       Begin VB.Menu mnuEditCut 
          Caption         =   "Cu&t"
          Shortcut        =   ^X
       End
       Begin VB.Menu mnuEditCopy 
          Caption         =   "&Copy"
          Shortcut        =   ^C
       End
       Begin VB.Menu mnuEditPaste 
          Caption         =   "&Paste"
          Shortcut        =   ^V
       End
       Begin VB.Menu mnueditbar3 
          Caption         =   "-"
       End
       Begin VB.Menu mnuEditSelectAll 
          Caption         =   "&SelectAll"
          Shortcut        =   ^A
       End
       Begin VB.Menu mnuEditPloticus 
          Caption         =   "Ploticus"
       End
    End
    Begin VB.Menu mnuView 
       Caption         =   "&View"
       Begin VB.Menu mnuViewToolbar 
          Caption         =   "&Toolbar"
          Checked         =   -1  'True
       End
       Begin VB.Menu mnuViewStatusBar 
          Caption         =   "Status &Bar"
          Checked         =   -1  'True
       End
       Begin VB.Menu mnuViewRuler 
          Caption         =   "&Ruler"
          Checked         =   -1  'True
       End
    End
    Begin VB.Menu mnuFormat 
       Caption         =   "F&ormat"
       Begin VB.Menu mnuFormatFont 
          Caption         =   "&Font..."
       End
       Begin VB.Menu mnuFormatColor 
          Caption         =   "&Color..."
       End
       Begin VB.Menu mnuFormatBullet 
          Caption         =   "&Bullet"
       End
       Begin VB.Menu mnuFormatTabs 
          Caption         =   "&Tabs..."
       End
       Begin VB.Menu mnuFormatParagraph 
          Caption         =   "&Paragraph"
          Begin VB.Menu mnuParagraphLeft 
             Caption         =   "&Left Justified"
          End
          Begin VB.Menu mnuParagraphCentred 
             Caption         =   "&Centred"
          End
          Begin VB.Menu mnuParagraphRight 
             Caption         =   "&Right Justified"
          End
       End
       Begin VB.Menu mnuTypestyle 
          Caption         =   "&Typestyle"
          Begin VB.Menu mnuBold 
             Caption         =   "&Bold"
             Shortcut        =   ^B
          End
          Begin VB.Menu mnuItalic 
             Caption         =   "&Italic"
             Shortcut        =   ^I
          End
          Begin VB.Menu mnuUnderline 
             Caption         =   "&Underline"
             Shortcut        =   ^U
          End
       End
       Begin VB.Menu mnuformatfilebar1 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFormatChangeCase 
          Caption         =   "&ChangeCase"
          Begin VB.Menu mnuFormatChangeCaseLowerCase 
             Caption         =   "&LowerCase"
          End
          Begin VB.Menu mnuFormatChangeCaseUpperCase 
             Caption         =   "&UpperCase"
          End
       End
       Begin VB.Menu mnuFormatFilebar2 
          Caption         =   "-"
       End
       Begin VB.Menu mnuFormatIncreaseIndent 
          Caption         =   "&IncreaseIndent"
       End
       Begin VB.Menu mnuFormatDecreaseIndent 
          Caption         =   "&DecreaseIndent"
       End
    End
    Begin VB.Menu mnuInsert 
       Caption         =   "&Insert"
       Begin VB.Menu mnuInsertObject 
          Caption         =   "&Object..."
       End
       Begin VB.Menu mnuInsertPicture 
          Caption         =   "&Picture..."
       End
       Begin VB.Menu mnuInsertbar1 
          Caption         =   "-"
          Index           =   2
       End
       Begin VB.Menu mnuPloticusPrefab 
          Caption         =   "Ploticus &Prefab"
          Begin VB.Menu mnuPloticusScatter 
             Caption         =   "&Scatter Plot"
          End
       End
       Begin VB.Menu mnuInsertbar3 
          Caption         =   "-"
       End
       Begin VB.Menu mnuInsertTextFile 
          Caption         =   "&TextFile..."
          Shortcut        =   ^T
       End
       Begin VB.Menu mnuInsertDate 
          Caption         =   "&Date"
          Shortcut        =   ^D
       End
       Begin VB.Menu mnuInsertbar2 
          Caption         =   "-"
       End
       Begin VB.Menu mnuInsertSymbols 
          Caption         =   "&Symbols"
       End
    End
    Begin VB.Menu mnuData 
       Caption         =   "&Data"
       Begin VB.Menu mnuEvaluate 
          Caption         =   "&Evaluate"
          Shortcut        =   {F9}
       End
    End
    Begin VB.Menu mnuTools 
       Caption         =   "&Tools"
    End
    Begin VB.Menu mnuWindow 
       Caption         =   "&Window"
       WindowList      =   -1  'True
       Begin VB.Menu mnuWindowNewWindow 
          Caption         =   "&New Window"
          Shortcut        =   {F12}
       End
       Begin VB.Menu mnuWindowBar0 
          Caption         =   "-"
       End
       Begin VB.Menu mnuWindowCascade 
          Caption         =   "&Cascade"
       End
       Begin VB.Menu mnuWindowTileHorizontal 
          Caption         =   "Tile &Horizontal"
       End
       Begin VB.Menu mnuWindowTileVertical 
          Caption         =   "Tile &Vertical"
       End
       Begin VB.Menu mnuWindowArrangeIcons 
          Caption         =   "&Arrange Icons"
       End
    End
    Begin VB.Menu mnuHelp 
       Caption         =   "&Help"
       Begin VB.Menu mnuHelpContents 
          Caption         =   "&HelpContents"
          Shortcut        =   {F1}
       End
       Begin VB.Menu mnuHelpTipoftheDay 
          Caption         =   "&TipoftheDay"
       End
       Begin VB.Menu mnuHelpAbout 
          Caption         =   "&About "
       End
       Begin VB.Menu mnuHelpSpecialThanks 
          Caption         =   "&SpecialThanks"
       End
    End
 End
 Attribute VB_Name = "frmDocument"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Option Explicit

Here is the code. Some of the routines have very little to do with our principal goals of creating a live mathematical document. This is often the case; as you develop a program you discover small unforeseen problems that need to be solved as you go along in order make the program work properly or simply be comfortable to use.

In VB the Tab key is used to move the focus from on control to the next but when editing text we usually want to actually insert a Tab character. One way to make this happen is to declare an Event Handler for the KeyDown event of the Rich Text Box. This checks to see what the ASCII code of the key is and directly overwrites the selected characters in the Rich Text Box to a Tab character:

 Private Sub rtfbox_KeyDown(KeyCode As Integer, Shift As Integer)
   If KeyCode = 9 Then
     rtfBox.SelText = vbTab
     KeyCode = 0
   End If    
 End Sub

Loading a file is easy. Just call the LoadFile method of the Rich Text Box. The only complication to take care of is that the user could try tpo pen a document that the Rich Text Box can't handle. Here we decide that this is not really an error in the program so we don't raise an error; instead we return a status value: True if we succeeded, false if not.

 Public Function LoadFile(rsFile As String) As Boolean
   On Error Resume Next
   rtfBox.LoadFile rsFile
   LoadFile = Err.Number = 0    
 End Function

Here is the method that actually does the work. Note that all the complicated stuff is in another module. This is because we can easily amigine cases where we would want to automate these things in which case it might be that we get the text from somewhere else

 Public Sub EvalDoc()
   goEvalDoc.EvalDoc rtfBox
 End Sub

Of course there is no point in having a method to recalculate the document if there is no way of running it so we call it from the Data Evaluate menu item. Take a look at the declarations above and see that a short cut key is attached to that menu item (F9):

 Public Sub mnuEvaluate_Click()
   EvalDoc
 End Sub

Remember that the main form's menu is not available when this form is active so we call the File Open event handler of the main form from our own file Open event handler. this is why we had to change from Private to Public (Friend would have worked too):

 Public Sub mnuFileOpen_Click()
   fMainform.mnuFileOpen_Click
 End Sub

To create a brand new document we must call the LoadNewDoc method of the main form:

 Public Sub mnuFileNew_Click()
   fMainform.LoadNewDoc
 End Sub

Behind the Scenes[edit]

cEvalDoc.cls[edit]

This class is where a lot of the hard work is done. The main method, EvalDoc looks very simple because it simply calls three other functions. These functions:

  • pre-process the document so that it is legal JScript,
  • execute the JScript,
  • update the document with the results.

The pre-processing step converts macros into JScript functions that store the location of the text to be replaced in a table and also converts matrices into JScript function calls that return arrays. This makes it practical to assign arrays of values to a variable and deal with the array as a whole instead of each element one at a time.

Here is the header of the class. In the Visual Basic IDE you can't see this text but you can change the values because they are shown in the properties window.

 VERSION 1.0 CLASS
 BEGIN
   MultiUse = -1  'True
   Persistable = 0  'NotPersistable
   DataBindingBehavior = 0  'vbNone
   DataSourceBehavior  = 0  'vbNone
   MTSTransactionMode  = 0  'NotAnMTSObject
 END
 Attribute VB_Name = "cEvalDoc"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = True
 Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
 
 Option Explicit

The actual evaluation of the JScript source code is done by the MSScript control. Not sure what the Attibute is for.

 Public moScriptControl As MSScriptControl.ScriptControl
 Attribute moScriptControl.VB_VarHelpID = -1

The Jscript interpreter only provides the basic functions of JavaScript, any unusual funtions must be provided by us. We do this by creating an object that provides those functions as methods.

 Private moFunctions As cFunctions

The document evaluator object must be initialized before use. This means creating an instance of the script control, telling the script control which language will be used and providing a global object that adds extra functions to the interpreter.

 Private Sub Class_Initialize()
   Set moScriptControl = New MSScriptControl.ScriptControl
   With moScriptControl
     .AllowUI = False
     .Language = "JScript"
     .UseSafeSubset = True
   End With
   Set moFunctions = New cFunctions
   moScriptControl.AddObject "Functions", moFunctions, True
   Set moFunctions.oScriptControl = moScriptControl
 End Sub

The only public method of this class is EvalDoc which takes a Rich Text box as its only argument, processes the text it finds in it and puts the answers back in the document.

 Public Sub EvalDoc(ByRef roDoc As RichTextBox)
   On Error GoTo ErrorHandler
   

We begin by replacing all the macros we find in the text by JScript function calls that will create the results in the results arrray.

   Dim sScript As String
   sScript = xPreprocess(roDoc.Text)

The results array is a dynamic array that we allow to grow as needed but we don't shrink it because we know that we will evaluate the document again so deallocating the memory would be a waste of time. So we reinitialize the array by simply setting the count of results to zero. The counter is also the pointer to the next free slot in the array.

   glResultsCount = 0

Now everything is ready all we have to do is execute the script using the built in Eval function.

   moScriptControl.Run "eval", sScript

Lastly, if everything went well, we have to put the answers back into the document.

   xUpdateDisplay roDoc
 
   Exit Sub

Unfortunately things can go wrong so we must take steps to prevent the program crashing. Problems can occur if the user mis-types a macro by missing out the closing bracket. There can be ordinary syntax errors in the JScript that the user writes and, of course, the program itself can have bugs. So we must have an error handler.

 ErrorHandler:
   Select Case Err.Number

If the user mis-typed the macro by omitting the closing bracket this will be noticed by the preprocessor. In this prototype we handle the problem by selecting the offending text and showing a message box to alert the user.

     Case ChunkNotTerminated
       roDoc.SelStart = xErrData(Err.Description)(0)
       roDoc.SelLength = xErrData(Err.Description)(1)
       MsgBox "Missing #> at end of macro"

If the problem is that the macro is correctly formed but unrecognized we do the same as for a syntactically faulty macro.

     Case UnrecognizedMacro
       roDoc.SelStart = xErrData(Err.Description)(0)
       roDoc.SelLength = xErrData(Err.Description)(1)
       MsgBox "Unrecognized macro, did you mean to display a value?"

Because we cannot predict what errors will occur we end with a catch all clause that notifies the user. Note the .ErrorContextxxx properties; these are set by the JScript functions that were written by the preprocessor so that the user can be directed at the part of the document that was being processed when the error was discovered.

     Case Else
       With moFunctions
         .MakeResult Empty, .ErrorContextStart_, _
                     .ErrorContextEnd_ - .ErrorContextStart_, _
                     SourceError
       End With        
   End Select
 
 End Sub

Because Visual basic does not have exceptions we need some way of passing information from the routine that raises an error to the routine that catches it. One simple way is to package the information into a string and use the description property of the Err object. Then when the error is trapped we can fetch the data out of the description using the Split function. This little function simply wraps the Split function, partly this is simply to give it a meaningful name but also because it seemed at the beginning that the processing would be more complicated.

 Private Function xErrData(ByRef rsErrDescription As String) As Variant
   xErrData = Split(rsErrDescription, "|")
 End Function

Before the text of the document can be evaluated by the Script control we must ensure that the text is legal JScript. We do this by taking a copy of the text in a string, looking for directives and macros and generating appropriate code for them.

Output is handled by calling functions that add variable values to the output list. These functions need three arguments: the value to be output, the starting point in the text and the length of the text range that is to be replaced. The user cannot be expected to count lines and maintain these values so a macro is used instead. The output is placed in the text at the point where the macro appears. Unlike most macro replacement systems we won't replace the whole macro with the output because then we would lose the placeholder and would not be able to update it. The macro comprises three parts: intro, body, outro. The intro and outro stay put in the text but the body is replaced by the new output. It is important to choose character sequence that cannot occur as a legal sequence in a JavaScript program and is also unlikely to appear in text string.

The sequence I have chosen is <# #>.

Macros can appear in comments and will work there too.

For now Split' and Instr are used to find the markers, regular expressions might be better but I don't know for sure. This function is rather complicated in practice but the basic idea is quite straightforward:

  • split the text into chunks using the intro as a delimiter,
  • note the character offset of each intro string by accumulating the lengths of the chunks
  • remove all text that is in comments,
  • replace the macros with function calls to a function that stores the value of the named variable along with the start and length of the position where it is to be inserted,

All this happens on a copy of the text, the rich text box is not disturbed at this point.

 Private Function xPreprocess(rsText As String) As String
   
   Const sINTRO As String = "<#"
   Const sOUTRO As String = "#>"
   Dim aChunks As Variant

Split the text using the intro sequence. This results in a list (Variant array) of chunks of text that all start with a macro (except for the first item in the list if there was any text before the first macro).

   aChunks = Split((rsText), sINTRO)
   Dim lChunk As Long

The actual text that is executed doesn't need any comments so we create a new text from the chunks by removing the both single line and multiple line comments from the first chunk. This chunk must be dealt with specially because it is the exception to the rule that all chunks begin with a macro.

   xPreprocess = xRemoveComments((aChunks(LBound(aChunks))))
   Dim lStart As Long

In order for the results to be placed in the text at the correct positions we must keep track of the character offset from the start of the text to the macro. Note that we must always add the length of the intro explicitly because it does not appear in the list of chunks.

   lStart = Len(aChunks(LBound(aChunks))) + Len(sINTRO)
   Dim lEnd As Long
   Dim lLenChunk As Long
   Dim lEndVar As Long

Now we can process each chunk and add the processed text to the string to be executed.

   For lChunk = LBound(aChunks) + 1 To UBound(aChunks)

First we must check to see if the macro was terminated searching the chunk for the outro. If the outro is missing we raise an error because the user must have made a mistake and forgotten to complete the macro. It might be argued that we should attempt to patch up the text and continue. See Exercises.

     lEnd = InStr(aChunks(lChunk), sOUTRO)
     If lEnd Then
       Dim sChunk As String
       sChunk = Left$(aChunks(lChunk), lEnd)

Now we have a complate macro we must check to see if we recognize it. At the moment there is only one type of macro, that is the show value macro.

       lEndVar = InStr(sChunk, "=")
       If lEndVar Then
         xPreprocess = xPreprocess & ";" & vbCrLf _
                     & "show(" & Left$(aChunks(lChunk), lEndVar - 1) _
                     & "," & (lStart + lEndVar) & "," & (lEnd - lEndVar - 1) _
                     & ")" & vbCrLf _
                     & xRemoveComments(Mid$(aChunks(lChunk), _
                                            lEnd + Len(sOUTRO)))
         lStart = lStart + Len(aChunks(lChunk)) + Len(sINTRO)
       Else

If the = sign is missing then this isn't a show value macro. As we haven't defined any others this must be an error so we abort the process and report it.

         Err.Raise UnrecognizedMacro, "xPreprocess", _
            lStart & "|" & Len(aChunks(lChunk)) & "|" & "Unrecognized macro type"
       End If
     Else

If the closing chunk characters are not found we raise an error and abort the process.

       Err.Raise ChunkNotTerminated, "xPreprocess", _
          lStart & "|" & Len(aChunks(lChunk)) & "|" & "Unterminated chunk"
     End If
   Next lChunk
   
 End Function
 

It is simpler to convert the macros to code if we remove the surrounding comments. We can do this on a chunk by chunk basis by defining a function that accepts a chunk and returns the same chunk minus any comments.

 Private Function xRemoveComments(ByRef rsChunk As String) As String

Deal with the simplest cases first: single line comments and complete multiline comments.

   xRemoveComments = xRemoveBracketed(rsChunk, "//", vbLf)
   xRemoveComments = xRemoveBracketed(xRemoveComments, "/*", "*/")
 

Now remove any leading or traing multiline comment fragments. These oocur because the chunk split ignores comment boundaries. We search the chunk for the closing and opening multiline comment markers.

   Dim lComment As Long
   lComment = InStr(xRemoveComments, "*/")
   If lComment Then
     xRemoveComments = Mid$(xRemoveComments, lComment + Len("*/"))
   End If
   
   lComment = InStr(xRemoveComments, "/*")
   If lComment Then
     xRemoveComments = Left$(xRemoveComments, lComment - 1)
   End If
   
 End Function

This function repeatedly removes substrings that fall between given starting and finishing markers until the starting marker no longer appears in the string.

 Private Function xRemoveBracketed(ByRef rsChunk As String, _
                                   ByRef rsStart As String, _
                                   ByRef rsfinish As String) As String
   
   xRemoveBracketed = rsChunk
   Dim lStart As Long
   Do
     lStart = InStr(xRemoveBracketed, rsStart) ' single line
     If lStart Then
       Dim lFinish As Long
       lFinish = InStr(lStart, xRemoveBracketed, rsfinish)

If the finish marker does not appear then treat the string as though such a marker appeared at the character following the end of the string. This allows us to delete single line comments that do not end in a newline sequence and multiline comments that are split by macros.

       If lFinish = 0 Then
         lFinish = Len(xRemoveBracketed) + 1
       End If
       xRemoveBracketed = Left$(xRemoveBracketed, lStart - 1) _
                        & Mid$(xRemoveBracketed, lFinish)
     End If
   Loop Until lStart = 0
   
 End Function


Once the document has been evaluated we must put the answers back in the document at the correct places. This seems at first to be a simple job because we have a list of values together with their locations in the document so at first sight it seems that we need to do is enumerate the results and replace the specified character ranges with the answers. Unfortunately this won't work unless the new text is exactly the same length as the original because inserting new text that is of a different length will move the text that is to be replaced so the results records will point at the wrong place. The solution is to enumerate the results in reverse order so that successive results to are inserted nearer the beginning of the document which means that only text that has already been updated will move.

 Private Sub xUpdateDisplay(roDoc As RichTextBox)
   On Error GoTo ErrorHandler
   
   With roDoc

An additional complication is that we would like to preserve the user's selection. We cannot simply store the values .SelStart and .SelLength and later copy them back because replacement may have occurred before or inside the selection, it might even happen that the selection boundaries fall inside a macro. So each time we do a replacement we must update the selection. So the first thing we must do is copy the values of those properties.

     Dim lSelStart As Long
     Dim lSelLen As Long
     Dim lSelNext As Long
     lSelStart = .SelStart
     lSelLen = .SelLength
     lSelNext = lSelStart + lSelLen

We start at the last result record and count back. The results array is zero based so the results counter always points at the next avaialble slot. Therefore we decrement the counter at the start of the loop, when we finish the counter will be zero.

     Do While 0 < glResultsCount
       glResultsCount = glResultsCount - 1

To replace the text in the rich text box we must first set the .SelStart and .SelLength properties and in order to preserve the user's selection we must compare these values to the current values of the user's selection and update the user's selection if necessary.

       .SelStart = gaResults(glResultsCount).Start
       .SelLength = gaResults(glResultsCount).length
       If .SelStart + .SelLength < lSelStart Then
         lSelStart = lSelStart - .SelLength
         lSelNext = lSelStart + lSelLen
       End If

Exactly what the replacement text is depends on the result type and on whether or not an error occurred when trying to calculate it. If an error occured then we colour the offending text red and leave it unchanged.

       Select Case gaResults(glResultsCount).ResultType
         Case SourceError
           .SelColor = vbRed
         Case Else

If we succeeded then we colour the selection black and replace replaceable part of the macro with the result. Now we see the reason for declaring the result as Variant because at last we see that it is possible to have charts in this document. How the replacement is actually done depends on the type of the result. If the result is a scalar then it is easy to use Visual Basic's string conversion functions to create a human readable representation but a plot is quite a different animal. Because they are so fifferent we create separate functions for them.

           .SelColor = vbBlack
           If TypeOf gaResults(glResultsCount).Value Is cPlot Then
             xReplacePlot gaResults(glResultsCount).Value, roDoc
             If .SelStart < lSelStart Then
               lSelStart = lSelStart + 1
               lSelNext = lSelStart + lSelLen
             End If
           Else
             .SelText = xToString(gaResults(glResultsCount).Value)
             If .SelStart < lSelStart Then
               lSelStart = lSelStart _
                         + Len(xToString(gaResults(glResultsCount).Value))
               lSelNext = lSelStart + lSelLen
             End If
           End If
       End Select
     Loop

Now we can set the .SelStart and .SelLength properties again to restore the user's selection. Of course if it included a macro that was replaced then the length of the selection may be quite different from what it was to start with.

     .SelStart = lSelStart
     .SelLength = lSelLen
   End With
   
   Exit Sub

The error handler in this function is incomplete, an exercise for the student perhaps. At the moment is simply asserts a falsehood to stop the program and allow the developer to debug it. In real life this would be quite complicated because we would like to process the whole document.

 ErrorHandler:
   Debug.Assert False
   Resume
 End Sub

Because this is really a proof of concenpt rather than a finished aplication we can use a very simply method of converting results to text: just use implicit conversion. The exception to this is matrices. Matrices are JScript arrays so we must do some extra work to format them.

 Private Function xToString(rvResult As Variant) As String
   
   If TypeName(rvResult) = "JScriptTypeInfo" Then
     ' assume that the object is a JavaScript array
     xToString = xJArrayToString(rvResult)
   Else
     Select Case VarType(rvResult)
       Case vbDouble, vbLong, vbInteger
         xToString = " " & rvResult
       Case vbString
         xToString = " '" & rvResult & "'"
       Case Else
         xToString = rvResult
     End Select
   End If
 End Function

If the result is a plot then the result is really the name of a picture file. To put it in the text we must use the clipboard to insert it, at least that is the simplest way. If the file doesn't exist then we insert text to say so rather than leave the user wndering where the plot is. Note that when this routine is called the selection has already been set to the replaceable part of the macro.

 Private Sub xReplacePlot(ByRef rvPlot As Variant, roDoc As RichTextBox)
   
   With roDoc
     If goFSO.FileExists(rvPlot.PicFileName) Then
       .SelText = ""     ' delete the old plot or whatever else there was.
       InsertPicture rvPlot.PicFileName, roDoc
     Else
       .SelText = "File <" & rvPlot.PicFileName & "> does not exist."
     End If
     
   End With
   
 End Sub

If the result is an array then we format it in rows and columns using tab characters to separate the columns. It is up to the user to set the tabs for that part of the text. Unfortunately we haven't given the user the ability to do this yet, another exercise for the student.

 Private Function xJArrayToString(rvResult As Variant) As String
   
   Debug.Assert TypeName(rvResult) = "JScriptTypeInfo"
   Dim oRow As Variant
   
   Dim lRow As Long
   Dim vItem As Variant
   xJArrayToString = vbTab & "["
   For lRow = 0 To rvResult.length - 1
     If lRow <> 0 Then
       xJArrayToString = xJArrayToString & vbTab
     End If
     Set oRow = CallByName(rvResult, lRow, VbGet)
     If TypeName(oRow) = "JScriptTypeInfo" Then
       xJArrayToString = xJArrayToString & vbTab & xJRowToString(oRow)
     Else
       vItem = CallByName(rvResult, lRow, VbGet)
       xJArrayToString = xJArrayToString & vbTab & "[" & vbTab & vItem & "]"
     End If
     If lRow < rvResult.length - 1 Then
       xJArrayToString = xJArrayToString & "," & vbCrLf
     End If
   Next lRow
   xJArrayToString = xJArrayToString & "]"
   
 End Function

Each row is in fact a JScript array. JScript doesn't have multidimensional arrays but because everything in JScript is an object we can easily simulate multi-dimensional arrays by having arrays of arrays.

 Private Function xJRowToString(rvResult As Variant) As String
   
   Debug.Assert TypeName(rvResult) = "JScriptTypeInfo"
   Dim oRow As Variant
   
   Dim lCol As Long
   Dim vItem As Variant
   xJRowToString = "["
   For lCol = 0 To rvResult.length - 1
     vItem = CallByName(rvResult, lCol, VbGet)
     If VarType(vItem) = vbString Then
       vItem = "'" & vItem & "'"
     End If
     xJRowToString = xJRowToString & vItem
     If lCol < rvResult.length - 1 Then
       xJRowToString = xJRowToString & "," & vbTab
     End If
   Next lCol
   xJRowToString = xJRowToString & "]"
   
 End Function

cFunctions.cls[edit]

Predefined functions for EvalDoc. An instance of this class is provided to the JScript object to provide global functions for such things as matrix multiplication. Provides an example of multilanguage programming: the application is written in VB, the document in JScript and the library used by JScript is written in VB.

 Option Explicit
   
 Public Enum enumFunctionErrors
   IncompatibleDimensions = vbObjectError + 1
   ChunkNotTerminated
   UnrecognizedMacro
 End Enum
 

The ErrorContextxxxx attributes are used to enable the errorhandlers to determine the location of the offending source code. Statements are inserted in the code to set these values before the macros.

 Public ErrorContextStart_ As Long
 Public ErrorContextEnd_    As Long
 

Some of the functions need to be able to create variables on the fly so we must provide a reference to the object that is running the script.

 Public oScriptControl  As ScriptControl 
 

Plot is a function that the document can call just as though it were a built in JScript function. It produces an object that in turn is used to drive the ploticus charting program. (Many Thanks to Steve Grubb <http://ploticus.sourceforge.net>).

The first argument is a matrix holding the data to be plotted and the second must be a string representing the ploticus command line except that it does not include data=datafilename, that is provided aiutomatically becuse we use a temporary file.

The matrix is written to a file then the a batch file is created to drive ploticus. The ploticus file is executed to create a picture file. The path to this picture file is stored in a cPlot object for later use.

Note that Ploticus is very particular about spaces in the command line:

This will fail: 'pl -gif -prefab scat x=1 y =2 data=12 -o 11

because the y =2 should say y=2, note the extra space.

 Public Function Plot(ByRef rvData As Variant, ByRef rsPlotCommands As String) As cPlot
 
   Set Plot = New cPlot
   Plot.PicFileName = TF & ".gif"
   Dim sDataFileName As String
   sDataFileName = xSaveMatrix(rvData)
 
   RunCmd "pl -gif " & rsPlotCommands & " data=" & sDataFileName & " -o " & Plot.PicFileName
   ' @TODO: check output of plot command for errors
 End Function

Ploticus reads its data from a file so we must write one. We don't care what it is called and we can delete it afterwards so we create a unique file name. Actually it is possible to create situations where this doesn't work but it is hard.

 Public Function TF() As String
   TF = goFSO.BuildPath(gsTempFolder, Trim$(NextSerial))
 End Function
 

Because ploticus is a separate program we must start it and wait for it to finish. This routine is a generic command line program executor.

For each parameter that expects an output file name use a macro of the form $(x) where x is the name of a variable that either contains a file name or is to receive an auto-generated file name. The variable can be used later in other commands. The user need not consider what the name actually is if it is used in a sequence of commands because the variable will be given a unique string value on first use that points into the temporary session folder.

If you need to provide a file as input and the data is held in a variable then construct the string by concatenating it with calls to the SaveData function; this writes the variable to a new temporary file and returns the file name.

For example you can drive ploticus like this:

s=Cmd('pl -gif -prefab scat x=2 y=3 data=' + SaveData(b) + ' -o $f(plot)')

In this example s receives the output from standard out (if any) and a variable named plot names the file that will receive the ploticus picture. If the plot variable is an empty string then a unique temporary file name will be created for it.

If you want to re-use a file name make sure that you clear it first unless you really want to use the same name again.

Macros are $x(args) where x is the name of the macro and args is whatever arguments the macro takes in whatever form in takes them.

 Public Function Cmd(ByRef rsCommandLine As String) As cPlot
 
   RunCmd rsCommandLine
   '  ' @TODO: check output of plot command for errors
 
 End Function

Ploticus needs the data for the plot in a file with a particular format. The routine that starts ploticus needs to know the name of that file. This function creates the file, writes the data to it and returns the file name.

 Private Function xSaveMatrix(rvData As Variant) As String
   xSaveMatrix = goFSO.BuildPath(gsTempFolder, Trim$(NextSerial)) & ".dat"
   goFSO.OpenTextFile(xSaveMatrix, ForWriting, True).Write _
        JArrayToPlotData(rvData)
 
 End Function
 

The macros in the document create result records in the gaResults array by calling this function.

 Public Sub MakeResult(ByRef rvResult As Variant, _
                       ByRef rlStart As Long, ByRef rlLength As Long, _
                       ByRef reResultType As eResultType)
 
   With gaResults(glResultsCount)

Note that we can't use TypeOf to find out if the result is a JScript object because the type doesn't exist according to VB. This is very strange because the Locals and Watch windows show it correctly so the IDE must know. Use typeName instead, the disadvantage is that string comparisons are slower.

     If TypeName(rvResult) = "JScriptTypeInfo" Or IsObject(rvResult) Then
       Set .Value = rvResult
     Else
       .Value = rvResult
     End If
     .Start = rlStart
     .length = rlLength
     .ResultType = reResultType
   End With

Another exercise for the student: what happens if glresultsCount is greater than the upper bound of the array? What should be done here?

   glResultsCount = glResultsCount + 1

 End Sub

The Show function is public so that JScript can call it. The macro replacement process puts these calls in the source code replacing the macros. At the moment this simply calls the Makeresult routine. the reason for the wrapper is to facilitate more sophisticated error handling.

 Public Function Show(o As Variant, rlStart As Long, rlLength As Long)
 
   MakeResult o, rlStart, rlLength, Result
 
 End Function

Multiply to JScript matrices together and return another JScript matrix. This is just a wrapper for the low level matrix multiplication routine. This wrapper converts the incoming matrices from JScript to VB and the result from VB to JScript.

 Public Function Multiply(ra1 As Variant, ra2 As Variant) As Object
   On Error GoTo ErrorHandler
 
   Set Multiply = VBMatrixToJArray(xMultiply(JArrayToMatrix(ra1), JArrayToMatrix(ra2)))
 
   Exit Function
 
 ErrorHandler:
   MakeResult Empty, ErrorContextStart_, ErrorContextEnd_, SourceError
 End Function

This function multiplies two matrices. It is called from the public function Multiply.

The rules for multiplying matrices are given in Matrix Operations in the Algebra book. This function is a straightforward implementation using essentialy the same notation as shown on that page. The one notable difference is that our array indices extend from zero upwards instead of from one upwards.

 Public Function xMultiply(ByRef raA() As Double, ByRef raB() As Double) As Double()
   Dim j As Long
   Dim k As Long
   Dim m As Long
   Dim n As Long
   Dim p As Long
   Dim i As Long
   Dim aC() As Double
   Dim cij As Double

Remember that the Ubound function accepts an optional second argument that tells which dimension to return; the first dimension is number one, the second number two and so on. Matrices have only two dimensions, the first is the row, the second is th column.

   n = UBound(raA, 2)
   m = UBound(raA, 1)
   p = UBound(raB, 2)
 
   ReDim aC(0 To n, 0 To p)
 
   For i = 0 To m
     For j = 0 To p
       nAcc = 0
       For k = 0 To n
         cij = cij + raA(i, k) * raB(k, j)
       Next k
       aC(i, j) = cij
     Next j
   Next i
 
   xMultiply = aC
 
   Exit Function
 
 End Function

Exercises[edit]

  • The strategy of reading the results list from the end instead of the beginning is not guaranteed to work for all documents. Can you explain why? Hint, think of the different kinds of JScript statements that you could use.

modJavaScript[edit]

This module is for functions that help connect the JavaScript document to the Visual Basic world inside the program.

This implementation provides some simple matrix manipulation functions. Because these are written in Visual Basic and the matrices must be written in JScript we need functions to convert between JScript objects and Visual Basic arrays.

 Option Explicit

JScript matrices are actually nested arrays. Each row is a one dimensional array of elements and the matrix is also a one dimensional array where each element is an array. This means that JScript matrices can be ragged arrays. In Visual Basic it is usual to represent a matrix as a rectangular array. In this implementation we shall simply assume that all rows in the array have the same number of elements so we can discover the number of rows by checking the count of the outer JScript array and the number of columns by checking the count of elements in the first row.

This function converts a JScript array to a Visual Basic array.

 Public Function JArrayToMatrix(rvResult As Variant) As Double()
 
   Dim oRow As Variant
   Dim lRows As Long
   Dim lCols As Long

Finding the number of rows is easy because all JScript objects are in fact dictionaries and they all have a length property. Getting the number of rows is slightly more complicated. We must first get hold of the JScript object that is the first row. Remember that JScript objects are actually dictionaries so arrays are dictionaries where the keys are numbers. In the Script control this is mapped so that each item appears to be a property of the object so we can use CallByName to retrieve the value. The name in this case is simply 0 (that's the numeral zero) because JScript arrays are numbered from zero to length - 1.

   lRows = rvResult.length
   Set oRow = CallByName(rvResult, 0, VbGet)    
   lCols = oRow.length

Now we can allocate the Visual Basic array. To avoid confusion we explicitly specify both the lower and upper bounds; this is good practice because it means that you don't have to wonder whether or not there is an Option Base statement at the top of the file.

   ReDim JArrayToMatrix(0 To lRows - 1, 0 To lCols - 1)

Now we simply enumerate the rows and copy the contents one row at a time into the array.

   Dim lRow As Long
   Dim vItem As Variant
   For lRow = 0 To lRows - 1
     Set oRow = CallByName(rvResult, lRow, VbGet)
     xJRowToMatrix JArrayToMatrix, lRow, oRow
   Next lRow
   
 End Function

In the interests of readability the copying of data from a row is performed in a separate routine. Although, in this case, it doesn't add much readability it does serve to clearly distinguish the row operations from the column operations. Note that this is a subroutine that accepts a reference to the target array and a row number because we cannot assign to a row in Visual Basic.

 Private Sub xJRowToMatrix(raMatrix() As Double, _
                           rlRow As Long, _
                           rvResult As Variant)
   
   Dim lCol As Long
   Dim vItem As Variant
   
   For lCol = 0 To rvResult.length - 1
     vItem = CallByName(rvResult, lCol, VbGet)
     raMatrix(rlRow, lCol) = vItem
   Next lCol
   
 End Sub

Converting from a Visual Basic array to a JScript matrix can be done by creating a snippet of JScript source code and evaluating it. All we have to do is create a string that looks just as the user would type it. Presumably direct manipulation of a JScript object would be faster, if anyone can find out how.

Note the late binding of the function result. This is because the objects exposed by the Script Control seem to not implement the interfaces that Visual Basic needs. This could be because of the extra layer of indirection provided by the Script Control.

 Public Function VBMatrixToJArray(raMatrix() As Double) As Object
   
   Dim lRow As Long
   Dim lCol As Long
   Dim sArray As String
   
   sArray = "["
   For lRow = LBound(raMatrix, 1) To UBound(raMatrix, 1)
     sArray = sArray & "["
     For lCol = LBound(raMatrix, 2) To UBound(raMatrix, 2)
       sArray = sArray & raMatrix(lRow, lCol)
       If lCol < UBound(raMatrix, 2) Then
         sArray = sArray & ","
       End If
     Next lCol
     sArray = sArray & "]"
     If lRow < UBound(raMatrix, 1) Then
       sArray = sArray & ","
     End If
   Next lRow
   sArray = sArray & "]"
   Set VBMatrixToJArray = goEvalDoc.moScriptControl.Eval(sArray)
   
 End Function

cPlot.cls[edit]

Represents a plot. Allows the tostring function to decide what to do to display the plot. The tostring function will use the filename property to find the picture file created by Ploticus and embed that into the rich text file.

 Option Explicit
 Public PicFileName As String

modPlot.bas[edit]

This module provides the low level connections to ploticus.

 Option Explicit

There are at least two ways to put a picture into a rich text box. The one chosen here requires the least programming but has the disadvantage that it uses the Windows clipboard which is rather impolite because the user might have something in it at the time. To do this we use the SendMessage API call which sends windows messages to window handles.

 Private Const WM_PASTE = &H302&
 
 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
         (ByVal hwnd As Long, ByVal wMsg As Long, _
          ByVal wParam As Long, lParam As Any) As Long

Insert the picture that was created by ploticus by loading it into the clipboard and then instructing the rich text box to paste it in.

 Public Sub InsertPicture(rsFile As String, rtfText As RichTextBox)
 
   Clipboard.Clear
   Clipboard.SetData LoadPicture(rsFile)
   
   SendMessage rtfText.hwnd, WM_PASTE, 0, 0&
 
 End Sub

Ploticus needs a file of data in rows and columns. This data is represented in our document as a matrix. We must convert that matrix to a string and then save it to a file. This function does the string conversion part.

 Public Function JArrayToPlotData(rvResult As Variant) As String
   
   Debug.Assert TypeName(rvResult) = "JScriptTypeInfo"
   Dim oRow As Variant
   
   Dim lRow As Long
   For lRow = 0 To rvResult.length - 1
     Set oRow = CallByName(rvResult, lRow, VbGet)
     If TypeName(oRow) = "JScriptTypeInfo" Then
       JArrayToPlotData = JArrayToPlotData & xJRowToPlotData(oRow)
     Else
       JArrayToPlotData = JArrayToPlotData & " " & CallByName(rvResult, lRow, VbGet)
     End If
     If lRow < rvResult.length - 1 Then
       JArrayToPlotData = JArrayToPlotData & vbCrLf
     End If
   Next lRow
   JArrayToPlotData = JArrayToPlotData
   
 End Function
 Private Function xJRowToPlotData(rvResult As Variant) As String
 
   Dim oRow As Variant    
   Dim lCol As Long
   For lCol = 0 To rvResult.length - 1
     xJRowToPlotData = xJRowToPlotData & CallByName(rvResult, lCol, VbGet)
     If lCol < rvResult.length - 1 Then
       xJRowToPlotData = xJRowToPlotData & " "
     End If
   Next lCol
   
 End Function

Exercises[edit]

The JArrayToPlotData is very similar to the function that converts a JScript matrix to a VB array. rewrite JArrayToPlotData so that it uses that function instead of doing that conversion from JScript on its own. Does this improve the program? Hint: has the amount of code to be maintained been reduced or has duplication (or near duplication) of code been eliminated?

modShellWait[edit]

JArithmetic uses external programs to do some of the more complicated work. These programs are often command line programs so we need some wrapper functions to make the rest of the program think that they are built in functions.

The original of this code was found on http://www.msfn.org/board/lofiversion/index.php/t35615.html.

 Option Explicit
 
 
 Private Const SYNCHRONIZE = &H100000
 Public Const WAIT_OBJECT_0 = &H0
 
 Private Declare Function OpenProcess Lib "Kernel32.dll" _
         (ByVal dwDA As Long, ByVal bIH As Integer, _
          ByVal dwPID As Long) As Long
 
 
 Private Declare Function WaitForSingleObject Lib "kernel32" _
         (ByVal hHandle As Long, _
          ByVal dwMilliseconds As Long) As Long
 

This function is the one used to execute an external program. It waits no more than ten seconds (10000 milliseconds). Unfortunately it does not know how to deal with failures. This is left as an exercise for the student.

 Public Sub RunCmd(CmdPath As String)
  
   On Error GoTo Err_RunCmd
   
   If ShellWait(CmdPath, 10000) Then
     Stop ' error ' @TODO: do something useful here
   End If
   
   Exit Sub
   
 Err_RunCmd:
   Stop ' do something useful here
 End Sub
 

This is the lower level function that executes the command line and waits for a time specified in the call. See External Processes.

 Function ShellWait(CommandLine As String, _
                    TimeOut As Long) As Boolean
    
   Dim ProcessID As Long
   Dim hProcess As Long

The Shell command returns a ProcessID which is not actually very useful because almost all Windows API functions use the Process Handle, this isn't a problem though because the OpenProcess API function can translate between the two.

   ProcessID = Shell(CommandLine)

If the Process ID is non-zero then the process was created and started so we can just wait for it to complete. To wait we use an API function called WaitForSingleObject that takes the Process Handle and a timeout in milliseconds. This function simply waits until the process terminates or the timeout expires; it returns a status code to say which.

   If ProcessID Then

Non-zero (True) so Shell worked. Now get a process handle for the PID (Wait takes a handle).

     hProcess = OpenProcess(SYNCHRONIZE, False, ProcessID)
     If hProcess Then
       Dim lResult As Long
       lResult = WaitForSingleObject(hProcess, TimeOut)
       If lResult = WAIT_OBJECT_0 Then
         ShellWait = True
       Else
         ShellWait = False
       End If
     Else

Failed to get process handle. This can happen if the process terminated very quickly or it might not really have executed at all even though Windows started a process. Return false to the caller to say it failed.

       ShellWait = False
     End If
   Else

If the Process ID is zero then the Shell failed.

     ShellWait = False
   End If
 End Function

Start up and project file[edit]

modMain.bas[edit]

The main module is the one that contains all the code that starts the application and gets it into its initial state. In this case we also use it as a place to declare various constants and global functions.


 Attribute VB_Name = "modMain"
   
 Option Explicit

The constants gsFILE_FILTER and gsSAVE_AS_FILTER are used when we show the Common Dialog boxes to open and save files. The tell the dialog which file masks to put in the combo box. Notice that we have provided for rtf', txt, all files. This means that the user can open files that are plain text and save them as rtf. Of course the user can also attempt to open a file that isn't either text or rich text, we must cope with that. The declarations are public because they are actually used in a different code module.

 Public Const gsFILE_FILTER As String = "Rich text Format(*.rtf)|*.rtf|Text (*.txt)|*.txt|All Files (*.*)|*.*"
 Public Const gsSAVE_AS_FILTER As String = "Rich Text Format(*.rtf)|*.rtf|Text (*.txt)"

The hard work is done by an instance of the cEvalDoc class'. We never need more than one instance of this class so we declare it here as a global variable and instantiate it in the main subroutine.

 Public goEvalDoc As cEvalDoc

The macro processor needs to keep track of where in the text replacements are to occur and what the replacement actually is. The tResult user defined type (UDT) is used to hold the necessary information. Note that the Value member is declared as Variant because the result of an expression can be anything not just a number.

 Public Type tResult
   Value As Variant
   Start As Long
   length As Long
   ResultType As eResultType
 End Type
 

The result type is an enumerated type. This makes the code easier to read. Notice that none of the members has been explicitly assigned a value, this is because we don't care what the values are so long as they are distinct.

 Public Enum eResultType
   SourceError
   SourceNoError
   Result
 End Enum

We need a place to store the values that we will substitute back in the text because we can't put them in untill we have finished processing the whole document. The reason for this is that the length of the result might be different from the length of the text it replaces. We maintain a count of the results so that we can let the gaResults array expand. When we evaluate the document again we start off by simply resetting glresultsCount to zero; this saves time by not requiring the results array to be eallocated every time.

 Public gaResults() As tResult
 Public glResultsCount As Long

The FileSystemObject is much simpler to use than the older built in VB functions for reading files. To use it you must have the Scripting Runtime Library installed.

 Public goFSO As FileSystemObject

Some of the functions used in this program need to create temporary files. So that we are sure to avoid collisions between different instances of this program and with other programs we create a new temporary folder inside the system temporary folder and store its name in this variable.

 Public gsTempFolder As String

The main routine initialise the application. It creates the temporary work area, creates an instance of the document evaluator, shows the main form and allocates the results array.

 Sub Main()
   Set goFSO = New FileSystemObject
   
   On Error GoTo ErrorHandler
   
  
   ' Create temporary area for this instance of JArithmetic.
   gsTempFolder = Environ$("TEMP") & "\" & App.EXEName
   If Not goFSO.FolderExists(gsTempFolder) Then
     goFSO.CreateFolder gsTempFolder
   End If
   gsTempFolder = gsTempFolder & "\" & Format$(Now, "yymmddhhmmss")
   If Not goFSO.FolderExists(gsTempFolder) Then
     goFSO.CreateFolder gsTempFolder
   End If
       
   Set goEvalDoc = New cEvalDoc
   
   Load fMainform
   
   fMainform.Show
   
   ReDim gaResults(0 To 100)
   
   Exit Sub
 ErrorHandler:
   Debug.Assert False
   MsgBox Err.Number & ", " & Err.Description & ". Command line = <" & Command$ & ">", vbOKOnly, "Arithmetic"
     Resume
 End Sub

The application can be closed in several different ways but each one should end with a call to this function so that all the documents are correctly closed. So far there is no implementation of automatic saving, nor is the user prompted to save changed documents. This is the place to add such code.

 Public Sub ExitApplication()
   Dim oForm As Form
   For Each oForm In Forms
     Unload oForm
   Next oForm    
 End Sub
 
 

This routine creates a unique number. It is used by functions that need to create temporary files. The result is always a whole number but we use Double instead of Long so that we 'never' run out of numbers (in this aplication this refinement is hardly necessary).

 Public Function NextSerial() As Double
   Static nSerial As Double
   nSerial = nSerial + 1
   NextSerial = nSerial
 End Function

prjJarithmetic.vbp[edit]

Here is the Visual Basic project file (VBP) used to tie all this together. In principle it should be possible to automate the downloading and compilation of this. Do bear in mind that any absolute paths you find in this VBP might not point to anything when copied to your computer.

 Type=Exe
 Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\..\..\..\WINNT\System32\stdole2.tlb#OLE Automation
 Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\..\..\..\..\..\..\WINNT\System32\scrrun.dll#Microsoft Scripting Runtime
 Reference=*\G{0E59F1D2-1FBE-11D0-8FF2-00A0D10038BC}#1.0#0#..\..\..\..\..\..\..\ProgramFiles\Hikari\msscript.ocx#Microsoft Script Control 1.0
 Object={F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0; ComDlg32.OCX
 Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX
 Object={38911DA0-E448-11D0-84A3-00DD01104159}#1.1#0; COMCT332.OCX
 Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX
 Class=cEvalDoc; cEvalDoc.cls
 Form=Fmainform.frm
 Form=frmDocument.frm
 Class=cFunctions; cFunctions.cls
 Module=modMain; modMain.bas
 Class=cPlot; cPlot.cls
 Module=modPlot; modPlot.bas
 Module=modShellWait; modShellWait.bas
 Module=modJavaScript; modJavaScript.bas
 RelatedDoc=..\doc\jarithmetic.htm
 RelatedDoc=..\debug\index.html
 Module=modGPL; ..\..\common\gpl\modGPL.bas
 IconForm="fMainform"
 Startup="Sub Main"
 HelpFile=""
 Title="prjArithmetic"
 ExeName32="Arithmetic.exe"
 Path32="debug"
 Name="prjJArithmetic"
 HelpContextID="0"
 Description="Arithmetic document processor"
 CompatibleMode="0"
 MajorVer=1
 MinorVer=0
 RevisionVer=2
 AutoIncrementVer=1
 ServerSupportFiles=0
 VersionCompanyName="Kevin Whitefoot"
 VersionFileDescription="Embedded JScript document processor."
 VersionLegalCopyright="Copyright Kevin Whitefoot, 2005"
 VersionProductName="JArithmetic"
 CompilationType=0
 OptimizationType=0
 FavorPentiumPro(tm)=0
 CodeViewDebugInfo=0
 NoAliasing=0
 BoundsCheck=0
 OverflowCheck=0
 FlPointCheck=0
 FDIVCheck=0
 UnroundedFP=0
 StartMode=0
 Unattended=0
 Retained=0
 ThreadPerObject=0
 MaxNumberOfThreads=1
 DebugStartupOption=0
Previous: JArithmetic Round Two Contents Next: The Language