Visual Basic/Jarithmetic Round Two Implementation
Introduction
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
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
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.
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
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.
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
cEvalDoc.cls
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
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
- 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
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
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
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
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
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
modMain.bas
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
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 |