Visual Basic/Jarithmetic Round Two 实现
本章介绍了迄今为止讨论内容的实现。
所采用的技术是代码和讨论交织在一起。您应该能够通过简单地复制整个页面并注释掉讨论来提取代码。
之前的讨论一直处于非常高的层次，而实现它将需要高层次和低层次的编码，以及对我们想法的大量改进。
应用程序将由一个窗体、一些模块和一些类组成。我们将从顶部开始，创建应用程序的用户界面，然后我们将逐个添加使它工作的代码。我们将发现，之前讨论中的一些内容是不完整的，有些是误导性的。这在实际开发中很常见。
我选择将此程序实现为一个多文档界面应用程序。这通常被称为MDI应用程序。这意味着，可以在程序的同一实例中同时打开多个 Jarithmetic 文档。这是过去大多数 Microsoft Office 应用程序的工作方式。
这是一个可能的窗体。图片显示了比第一个版本实际实现的更多菜单，请在您继续进行时实现它们。
以下是窗体上控件的声明。您可以将其粘贴到文本编辑器中并将其保存为fMainForm.frm，以便快速开始。
主窗体是用户想要打开的多个文档的容器。每个文档都将是frmDocument的实例，请参见下一节。
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
现在是窗体的可见代码。它非常短，因为 MDI 窗体没有做太多工作，它主要充当文档窗体的容器。
MDI 窗体有一个文件菜单。当没有打开文档窗体时，它是活动的菜单。当文档窗体打开时，显示的文件菜单属于文档窗体，但我们仍然会调用此方法。当 VB 为我们创建方法时，它将被标记为Private，我们可以将其更改为Public，如这里所做的那样，但将其保留为Private 并添加一个新的Friend 方法来调用它可能会更简洁明了。
当我们打开一个文档时，我们必须首先创建一个文档窗体来保存它。在这个程序实例中，frmDocument 代表了文档。这里做出的设计决策是，每次我们打开一个文档时，它都将加载到 frmDocument 的一个新实例中。这可能是也可能不是合适的，考虑一下如果用户两次打开同一个文档并编辑两个文档会发生什么。
我们使用 Microsoft 提供的通用对话框控件，但我们也可以使用一个包含驱动器、文件夹和文件列表控件的窗体。
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
LoadNewDoc 函数与文件打开事件处理程序分离，以便其他调用者可以使用它。
Public Function LoadNewDoc() As frmDocument Static lDocumentCount As Long lDocumentCount = lDocumentCount + 1 Set LoadNewDoc = New frmDocument LoadNewDoc.Caption = "Document " & lDocumentCount LoadNewDoc.Show End Function
当我们卸载主窗体时，我们希望能够确保所有文档都已正确清理，因此我们调用一个函数退出应用程序。我们可以使用返回值来设置Cancel 参数，然后用户可能能够停止关机。
Private Sub MDIForm_Unload(Cancel As Integer) ExitApplication End Sub
文档窗体保存了我们的算术文档之一。它并没有比主窗体复杂多少。但是，它确实定义了一些不同的菜单。此外，由于 VB6 的工作方式，它也必须定义所有相同的菜单，它不能从主窗体继承菜单。VB 显示当前窗体定义的菜单，除非只有 MDI 窗体，在这种情况下，将显示 MDI 窗体的菜单。同样，图形显示了比此原型中实际实现的更多菜单。
以下是菜单和控件的定义
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
以下是代码。其中一些例程与我们创建实时数学文档的主要目标几乎没有关系。这种情况很常见；当您开发程序时，您会发现一些在您继续进行中需要解决的小问题，以使程序正常工作或仅仅是方便使用。
在 VB 中，Tab 键用于将焦点从一个控件移动到下一个控件，但在编辑文本时，我们通常希望实际插入一个Tab 字符。一种实现方法是为Rich Text Box 的KeyDown 事件声明一个事件处理程序。这会检查按键的ASCII 代码是什么，并直接将Rich Text Box 中选定的字符覆盖为一个Tab 字符
Private Sub rtfbox_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 9 Then
rtfBox.SelText = vbTab
KeyCode = 0
End If
End Sub
加载文件很简单。只需调用Rich Text Box 的LoadFile 方法即可。唯一需要处理的复杂情况是，用户可能尝试打开Rich Text Box 无法处理的文档。这里我们认为这不是程序中的错误，因此不引发错误；相反，我们返回一个状态值：如果成功，则为True，否则为false。
Public Function LoadFile(rsFile As String) As Boolean On Error Resume Next rtfBox.LoadFile rsFile LoadFile = Err.Number = 0 End Function
以下是实际执行工作的代码。请注意，所有复杂的操作都在另一个模块中。这是因为我们可以轻松地想象出我们要自动执行这些操作的情况，在这种情况下，我们可能从其他地方获取文本
Public Sub EvalDoc() goEvalDoc.EvalDoc rtfBox End Sub
当然，如果无法运行文档，那么没有必要拥有一个方法来重新计算文档，因此我们从数据评估菜单项调用它。查看上面的声明，并看到一个快捷键附加到该菜单项（F9）
Public Sub mnuEvaluate_Click() EvalDoc End Sub
请记住，当此窗体处于活动状态时，主窗体的菜单不可用，因此我们从自己的文件打开事件处理程序中调用主窗体的文件打开事件处理程序。这就是我们必须从Private 更改为Public 的原因（Friend 也能工作）
Public Sub mnuFileOpen_Click() fMainform.mnuFileOpen_Click End Sub
要创建一个全新的文档，我们必须调用主窗体的LoadNewDoc 方法
Public Sub mnuFileNew_Click() fMainform.LoadNewDoc End Sub
这个类是完成很多艰苦工作的地方。主要方法EvalDoc 看起来非常简单，因为它只是调用了另外三个函数。这些函数
- 预处理文档，使其成为合法的 JScript，
- 执行 JScript，
- 使用结果更新文档。
预处理步骤将宏转换为存储要替换的文本位置的表的 JScript 函数，并将矩阵转换为返回数组的 JScript 函数调用。这使得将数组的值分配给一个变量并以整体的方式处理数组（而不是一次处理一个元素）变得实用。
以下是类的标题。在 Visual Basic IDE 中，您无法看到此文本，但您可以更改其值，因为它们在属性窗口中显示。
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
JScript 源代码的实际评估由MSScript 控件完成。不确定Attibute 是什么。
Public moScriptControl As MSScriptControl.ScriptControl Attribute moScriptControl.VB_VarHelpID = -1
Jscript 解释器只提供 JavaScript 的基本函数，任何不常见的函数都必须由我们提供。我们通过创建一个将这些函数作为方法提供给解释器的对象来实现这一点。
Private moFunctions As cFunctions
文档评估器对象必须在使用之前进行初始化。这意味着创建一个脚本控件的实例，告诉脚本控件将使用哪种语言，并提供一个全局对象，该对象向解释器添加额外的函数。
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
此类的唯一公共方法是EvalDoc，它以 Rich Text 控件作为唯一参数，处理其中找到的文本，并将答案放回文档中。
Public Sub EvalDoc(ByRef roDoc As RichTextBox) On Error GoTo ErrorHandler
首先，我们将文本中找到的所有宏替换为 JScript 函数调用，这些调用将在结果数组中创建结果。
Dim sScript As String sScript = xPreprocess(roDoc.Text)
结果数组是一个动态数组，我们允许它根据需要增长，但我们不会缩小它，因为我们知道我们会再次评估文档，所以释放内存会浪费时间。因此，我们通过简单地将结果计数设置为零来重新初始化数组。计数器也是指向数组中下一个空闲插槽的指针。
glResultsCount = 0
现在一切都准备好了，我们所要做的就是使用内置的 Eval 函数执行脚本。
moScriptControl.Run "eval", sScript
最后，如果一切顺利，我们必须将答案放回文档中。
xUpdateDisplay roDoc Exit Sub
不幸的是，事情可能会出错，因此我们必须采取措施防止程序崩溃。如果用户在输入宏时漏掉了右括号，则可能会出现问题。用户编写的 JScript 中可能存在普通的语法错误，当然，程序本身也可能存在错误。因此，我们必须有一个错误处理程序。
ErrorHandler: Select Case Err.Number
如果用户在输入宏时漏掉了右括号，预处理器会注意到这一点。在这个原型中，我们通过选择有问题的文本并显示一个消息框来提醒用户来处理这个问题。
Case ChunkNotTerminated
roDoc.SelStart = xErrData(Err.Description)(0)
roDoc.SelLength = xErrData(Err.Description)(1)
MsgBox "Missing #> at end of 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?"
因为我们无法预测会发生什么错误，所以我们以一个捕获所有子句结束，该子句通知用户。注意 .ErrorContextxxx 属性；这些属性由预处理器编写的 JScript 函数设置，以便用户可以被引导到发现错误时正在处理的文档部分。
Case Else
With moFunctions
.MakeResult Empty, .ErrorContextStart_, _
.ErrorContextEnd_ - .ErrorContextStart_, _
SourceError
End With
End Select
End Sub
由于 Visual basic 没有异常，因此我们需要某种方法将信息从引发错误的例程传递到捕获错误的例程。一种简单的方法是将信息打包到一个字符串中并使用 Err 对象的 description 属性。然后，当错误被捕获时，我们可以使用 Split 函数从 description 中获取数据。这个小函数只是包装了 Split 函数，部分原因是为了给它一个有意义的名称，但也因为一开始似乎处理会更加复杂。
Private Function xErrData(ByRef rsErrDescription As String) As Variant xErrData = Split(rsErrDescription, "|") End Function
在文档文本可以由 Script 控件评估之前，我们必须确保文本是合法的 JScript。我们通过在字符串中复制文本，查找指令和宏并为它们生成适当的代码来做到这一点。
输出通过调用将变量值添加到输出列表的函数来处理。这些函数需要三个参数：要输出的值、文本中的起始点以及要替换的文本范围的长度。不能期望用户计算行并维护这些值，因此使用宏代替。输出放在宏出现的文本中的位置。与大多数宏替换系统不同，我们不会用输出替换整个宏，因为那样我们就会丢失占位符，并且无法更新它。宏包含三个部分：intro、body、outro。intro 和 outro 保留在文本中，但 body 被新的输出替换。选择在 JavaScript 程序中无法作为合法序列出现的字符序列，并且不太可能出现在文本字符串中很重要。
我选择的序列是 <# #>。
宏可以出现在注释中，并且在那里也能工作。
目前，Split 和 Instr 用于查找标记，正则表达式可能更好，但我不能确定。这个函数在实践中相当复杂，但基本思路很简单
- 使用 intro 作为分隔符将文本分成 块，
- 通过累积 块 的长度来记录每个 intro 字符串的字符偏移量
- 删除所有在注释中的文本，
- 将宏替换为对函数的调用，该函数将命名变量的值以及要插入的位置的开始和长度一起存储，
所有这些都在文本的副本上进行，此时不会干扰富文本框。
Private Function xPreprocess(rsText As String) As String Const sINTRO As String = "<#" Const sOUTRO As String = "#>" Dim aChunks As Variant
使用 intro 序列分割文本。这将导致一个文本块列表（Variant 数组），这些文本块都以宏开头（如果第一个宏之前有任何文本，则列表中的第一个项目除外）。
aChunks = Split((rsText), sINTRO) Dim lChunk As Long
实际执行的文本不需要任何注释，因此我们通过从第一个块中删除单行和多行注释来创建一个新文本。这个块必须特殊处理，因为它违反了所有块都以宏开头的规则。
xPreprocess = xRemoveComments((aChunks(LBound(aChunks)))) Dim lStart As Long
为了将结果放置在文本中的正确位置，我们必须跟踪从文本开头到宏的字符偏移量。请注意，我们必须始终显式添加 intro 的长度，因为它不会出现在块列表中。
lStart = Len(aChunks(LBound(aChunks))) + Len(sINTRO) Dim lEnd As Long Dim lLenChunk As Long Dim lEndVar As Long
现在，我们可以处理每个块并将处理后的文本添加到要执行的字符串中。
For lChunk = LBound(aChunks) + 1 To UBound(aChunks)
首先，我们必须检查宏是否已终止，在块中搜索 outro。如果缺少 outro，我们会引发错误，因为用户肯定犯了一个错误，忘记了完成宏。有人可能会争辩说，我们应该尝试修补文本并继续。参见 练习。
lEnd = InStr(aChunks(lChunk), sOUTRO)
If lEnd Then
Dim sChunk As String
sChunk = Left$(aChunks(lChunk), lEnd)
现在我们拥有了一个完整的宏，我们必须检查是否识别它。目前只有一种类型的宏，即 显示值 宏。
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
如果缺少 = 符号，则这不是 显示值 宏。由于我们还没有定义任何其他宏，这肯定是一个错误，因此我们中止该过程并报告它。
Err.Raise UnrecognizedMacro, "xPreprocess", _
lStart & "|" & Len(aChunks(lChunk)) & "|" & "Unrecognized macro type"
End If
Else
如果找不到结束块字符，我们会引发错误并中止该过程。
Err.Raise ChunkNotTerminated, "xPreprocess", _
lStart & "|" & Len(aChunks(lChunk)) & "|" & "Unterminated chunk"
End If
Next lChunk
End Function
如果我们删除周围的注释，则将宏转换为代码会更简单。我们可以通过定义一个接受一个块并返回相同块（减去任何注释）的函数来逐个块地执行此操作。
Private Function xRemoveComments(ByRef rsChunk As String) As String
首先处理最简单的案例：单行注释和完整的多行注释。
xRemoveComments = xRemoveBracketed(rsChunk, "//", vbLf) xRemoveComments = xRemoveBracketed(xRemoveComments, "/*", "*/")
现在删除任何前导或尾随[检查拼写] 多行注释片段。这些片段的出现是因为块分割会忽略注释边界。我们在块中搜索结束和开始的多行注释标记。
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
此函数重复删除位于给定开始和结束标记之间的子字符串，直到开始标记不再出现在字符串中。
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 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
文档评估完成后，我们必须将答案放回文档中的正确位置。乍一看，这似乎是一个简单的任务，因为我们有一系列值以及它们在文档中的位置，因此乍一看，我们似乎需要做的就是枚举结果并将指定的字符范围替换为答案。不幸的是，这将不起作用，除非新文本与原始文本完全相同，因为插入长度不同的新文本会移动要替换的文本，因此结果记录将指向错误的位置。解决方案是按相反顺序枚举结果，以便将连续的结果插入到文档的更靠近开头的位置，这意味着只有已经更新的文本才会移动。
Private Sub xUpdateDisplay(roDoc As RichTextBox) On Error GoTo ErrorHandler With roDoc
另一个复杂之处是我们希望保留用户的选择。我们不能简单地存储值 .SelStart 和 .SelLength，然后将它们复制回来，因为替换可能发生在选择之前或选择内部，甚至可能发生选择边界位于宏内部的情况。因此，每次执行替换时，我们都必须更新选择。所以我们必须做的第一件事是复制这些属性的值。
Dim lSelStart As Long
Dim lSelLen As Long
Dim lSelNext As Long
lSelStart = .SelStart
lSelLen = .SelLength
lSelNext = lSelStart + lSelLen
我们从最后一个结果记录开始，并向后计数。结果数组从零开始，因此结果计数器始终指向下一个可用插槽。因此，我们在循环开始时递减计数器，当我们完成时，计数器将为零。
Do While 0 < glResultsCount
glResultsCount = glResultsCount - 1
要替换富文本框中的文本，我们必须首先设置 .SelStart 和 .SelLength 属性，为了保留用户的选择，我们必须将这些值与用户选择的当前值进行比较，并在必要时更新用户的选择。
.SelStart = gaResults(glResultsCount).Start
.SelLength = gaResults(glResultsCount).length
If .SelStart + .SelLength < lSelStart Then
lSelStart = lSelStart - .SelLength
lSelNext = lSelStart + lSelLen
End If
替换文本是什么取决于结果类型以及尝试计算结果时是否发生错误。如果发生错误，我们将有问题的文本颜色设置为红色并保留它不变。
Select Case gaResults(glResultsCount).ResultType
Case SourceError
.SelColor = vbRed
Case Else
如果成功，我们将选择颜色设置为黑色并将宏的可替换部分替换为结果。现在我们看到了将结果声明为 Variant 的原因，因为最后我们看到了在这个文档中拥有图表是可能的。实际进行替换的方式取决于结果的类型。如果结果是 标量，那么使用 Visual Basic 的字符串转换函数很容易创建人类可读的表示，但图表却完全不同。因为它们差异很大，所以我们为它们创建了单独的函数。
.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
现在，我们可以再次设置 .SelStart 和 .SelLength 属性来恢复用户的选择。当然，如果它包含一个被替换的宏，那么选择的长度可能与最初的长度大不相同。
.SelStart = lSelStart
.SelLength = lSelLen
End With
Exit Sub
此函数中的错误处理程序不完整，也许是学生的练习。目前，它只是断言了一个假值以停止程序并允许开发人员调试它。在现实生活中，这将非常复杂，因为我们希望处理整个文档。
ErrorHandler: Debug.Assert False Resume End Sub
由于这实际上是一个 概念证明 而不是一个完成的应用程序，因此我们可以使用一种非常简单的方法将结果转换为文本：只需使用隐式转换。例外情况是 矩阵。矩阵是 JScript 数组，因此我们必须做一些额外的工作来格式化它们。
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
如果结果是图表，则结果实际上是图片文件的名称。为了将它放在文本中，我们必须使用剪贴板插入它，至少这是最简单的方法。如果文件不存在，我们将插入文本来说明这一点，而不是让用户想知道图表在哪里。请注意，当调用此例程时，选择已设置为宏的可替换部分。
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
如果结果是数组，则我们将使用制表符分隔列，以行和列格式化它。用户必须为文本的该部分设置制表符。不幸的是，我们还没有给用户这样做，这是学生的另一项练习。
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
每一行实际上都是一个 JScript 数组。JScript 没有多维数组，但由于 JScript 中的一切都是对象，我们可以通过拥有数组的数组来轻松地模拟多维数组。
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
EvalDoc 的预定义函数。此类的实例被提供给 JScript 对象，以提供用于矩阵乘法等操作的全局函数。提供多语言编程示例：应用程序是用 VB 编写的，文档是用 JScript 编写的，JScript 使用的库是用 VB 编写的。
Option Explicit Public Enum enumFunctionErrors IncompatibleDimensions = vbObjectError + 1 ChunkNotTerminated UnrecognizedMacro End Enum
ErrorContextxxxx 属性用于使错误处理程序能够确定有问题的源代码的位置。在宏之前，代码中插入了语句来设置这些值。
Public ErrorContextStart_ As Long Public ErrorContextEnd_ As Long
某些函数需要能够动态创建变量，因此我们必须提供对正在运行脚本的对象的引用。
Public oScriptControl As ScriptControl
Plot 是一个函数，文档可以像调用内置的 JScript 函数一样调用它。它生成一个对象，该对象反过来用于驱动 Ploticus 制图程序。（非常感谢 Steve Grubb <http://ploticus.sourceforge.net>）。
第一个参数是包含要绘制数据的矩阵，第二个参数必须是一个字符串，表示 Ploticus 命令行，除了它不包含 data=datafilename，因为我们使用了一个临时文件，所以该文件会自动提供。
将矩阵写入文件，然后创建一个批处理文件来驱动 Ploticus。执行 Ploticus 文件以创建图片文件。此图片文件的路径存储在 cPlot 对象中，以便以后使用。
注意，Ploticus 对命令行中的空格非常敏感。
这将失败：'pl -gif -prefab scat x=1 y =2 data=12 -o 11
因为 y =2 应该说 y=2，注意多余的空格。
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 从文件读取其数据，因此我们必须写入一个文件。我们不关心它叫什么，我们可以在之后删除它，因此我们创建一个唯一的文件名。实际上，可以创建无法正常工作的情况，但这很难。
Public Function TF() As String TF = goFSO.BuildPath(gsTempFolder, Trim$(NextSerial)) End Function
因为 Ploticus 是一个单独的程序，我们必须启动它并等待它完成。此例程是一个通用的命令行程序执行器。
对于每个需要输出文件名作为参数的函数，请使用 $(x) 形式的宏，其中 x 是包含文件名的变量的名称，或者是要接收自动生成的文件名的变量的名称。该变量可以在以后的其他命令中使用。如果该变量在一系列命令中使用，用户无需考虑其实际名称，因为该变量将在首次使用时获得指向临时会话文件夹的唯一字符串值。
如果您需要提供文件作为输入，并且数据保存在变量中，请通过将该字符串与对 SaveData 函数的调用连接起来来构造该字符串；这会将变量写入新的临时文件并返回文件名。
例如，您可以像这样驱动 Ploticus
- s=Cmd('pl -gif -prefab scat x=2 y=3 data=' + SaveData(b) + ' -o $f(plot)')
在此示例中，s 从标准输出（如果有）接收输出，名为 plot 的变量命名将接收 Ploticus 图片的文件。如果 plot 变量为空字符串，则将为其创建一个唯一的临时文件名。
如果您想重新使用文件名，请确保先清除它，除非您确实想再次使用同一个名称。
宏是 $x(args)，其中 x 是宏的名称，args 是宏以任何形式接受的任何参数。
Public Function Cmd(ByRef rsCommandLine As String) As cPlot RunCmd rsCommandLine ' ' @TODO: check output of plot command for errors End Function
Ploticus 需要以特定格式的文件形式提供绘图数据。启动 Ploticus 的例程需要知道该文件的名称。此函数创建文件，将数据写入文件并返回文件名。
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
文档中的宏通过调用此函数在 gaResults 数组中创建结果记录。
Public Sub MakeResult(ByRef rvResult As Variant, _
ByRef rlStart As Long, ByRef rlLength As Long, _
ByRef reResultType As eResultType)
With gaResults(glResultsCount)
请注意，我们无法使用 TypeOf 来确定结果是否为 JScript 对象，因为根据 VB 的说法，该类型不存在。这非常奇怪，因为 Locals 和 Watch 窗口会正确显示它，因此 IDE 必须知道。使用 typeName 代替，缺点是字符串比较速度较慢。
If TypeName(rvResult) = "JScriptTypeInfo" Or IsObject(rvResult) Then
Set .Value = rvResult
Else
.Value = rvResult
End If
.Start = rlStart
.length = rlLength
.ResultType = reResultType
End With
学生练习：如果 glresultsCount 大于数组的上界，会发生什么？这里应该怎么做？
glResultsCount = glResultsCount + 1 End Sub
Show 函数是公开的，因此 JScript 可以调用它。宏替换过程将这些调用放入源代码中，替换宏。目前，这只是调用 Makeresult 例程。使用包装器的目的是促进更复杂的错误处理。
Public Function Show(o As Variant, rlStart As Long, rlLength As Long) MakeResult o, rlStart, rlLength, Result End Function
将两个 JScript 矩阵相乘并返回另一个 JScript 矩阵。这只是底层矩阵乘法例程的包装器。此包装器将传入的矩阵从 JScript 转换为 VB，并将结果从 VB 转换为 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
此函数将两个矩阵相乘。它从公共函数 Multiply 中调用。
矩阵相乘的规则在 矩阵运算 中给出，在 代数 书中。此函数是一个直接的实现，基本上使用与该页面上显示的相同的符号。一个显着的区别是，我们的数组索引从零开始而不是从一开始。
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
请记住，Ubound 函数接受一个可选的第二个参数，该参数指示要返回的维度；第一个维度是数字 1，第二个是数字 2，依此类推。矩阵只有两个维度，第一个是行，第二个是列。
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
- 从末尾而不是从开头读取结果列表的策略并不保证对所有文档都适用。你能解释一下为什么吗？提示，想想你可以使用哪些不同类型的 JScript 语句。
此模块用于帮助将 JavaScript 文档连接到程序内部 Visual Basic 世界的函数。
此实现提供了一些简单的矩阵操作函数。由于这些函数是用 Visual Basic 编写的，并且矩阵必须用 JScript 编写，因此我们需要函数来在 JScript 对象和 Visual Basic 数组之间进行转换。
Option Explicit
JScript 矩阵实际上是嵌套数组。每行都是一个一维元素数组，矩阵也是一个一维数组，其中每个元素都是一个数组。这意味着 JScript 矩阵可以是 不规则数组。在 Visual Basic 中，通常将矩阵表示为矩形数组。在此实现中，我们只假设数组中的所有行都具有相同数量的元素，因此我们可以通过检查外部 JScript 数组的计数来发现行数，并通过检查第一行的元素计数来发现列数。
此函数将 JScript 数组转换为 Visual Basic 数组。
Public Function JArrayToMatrix(rvResult As Variant) As Double() Dim oRow As Variant Dim lRows As Long Dim lCols As Long
查找行数很容易，因为所有 JScript 对象实际上都是字典，它们都有一个 length 属性。获取行数稍微复杂一些。我们首先必须获取第一个行的 JScript 对象。请记住，JScript 对象实际上是字典，因此数组是字典，其中键是数字。在 Script 控件中，这映射到使每个项目看起来都是对象的属性，因此我们可以使用 CallByName 来检索值。在这种情况下，名称只是 0（即数字零），因为 JScript 数组从 零 到 length - 1 编号。
lRows = rvResult.length Set oRow = CallByName(rvResult, 0, VbGet) lCols = oRow.length
现在我们可以分配 Visual Basic 数组。为了避免混淆，我们明确指定了下界和上界；这是一个好习惯，因为它意味着您不必担心文件顶部是否有一个 Option Base 语句。
ReDim JArrayToMatrix(0 To lRows - 1, 0 To lCols - 1)
现在我们只需枚举行并将内容逐行复制到数组中即可。
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
为了提高可读性，从行中复制数据是在单独的例程中执行的。虽然在这种情况下，它并没有增加太多可读性，但它确实有助于清楚地区分行操作和列操作。请注意，这是一个接受对目标数组的 引用 和 行号 的子例程，因为我们无法在 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
从 Visual Basic 数组转换为 JScript 矩阵可以通过创建一段 JScript 源代码并对其进行评估来完成。我们所要做的就是创建一个看起来与用户键入的完全相同的字符串。据推测，直接操作 JScript 对象会更快，如果有人能弄清楚怎么做的话。
注意函数结果的后期绑定。这是因为 Script 控件公开的对象似乎没有实现 Visual Basic 所需的接口。这可能是因为 Script 控件提供了额外的间接层。
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
表示一个绘图。允许 tostring 函数决定做什么来显示绘图。tostring 函数将使用 filename 属性查找 Ploticus 创建的图片文件，并将该图片嵌入到富文本文件中。
Option Explicit Public PicFileName As String
此模块提供了与 Ploticus 的底层连接。
Option Explicit
至少有两种方法可以将图片放入富文本框中。这里选择的方法需要最少的编程，但缺点是它使用 Windows 剪贴板，这很不礼貌，因为用户可能当时在剪贴板中有一些内容。为此，我们使用 SendMessage API 调用，它将 Windows 消息发送到窗口句柄。
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
通过将 Ploticus 创建的图片加载到剪贴板中，然后指示富文本框将其粘贴，插入图片。
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 需要一个以行和列形式存放数据的文件。此数据在我们的文档中表示为矩阵。我们必须将该矩阵转换为字符串，然后将其保存到文件。此函数执行字符串转换部分。
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
JArrayToPlotData 与将 JScript 矩阵转换为 VB 数组的函数非常相似。重写 JArrayToPlotData，使其使用该函数，而不是单独执行从 JScript 的转换。这是否改进了程序？提示：要维护的代码量减少了，还是代码重复（或近似重复）消除了？
JArithmetic 使用外部程序来完成一些比较复杂的工作。这些程序通常是命令行程序，所以我们需要一些包装函数来让程序的其余部分认为它们是内置函数。
这段代码的原始版本在 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
此函数用于执行外部程序。它最多等待十秒钟（10000 毫秒）。不幸的是，它不知道如何处理故障。这留给学生作为练习。
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
这是执行命令行并等待调用中指定的时间的低级函数。请参阅 外部进程。
Function ShellWait(CommandLine As String, _
TimeOut As Long) As Boolean
Dim ProcessID As Long
Dim hProcess As Long
Shell 命令返回一个进程 ID，它实际上没有用，因为几乎所有 Windows API 函数都使用进程句柄，但这不是问题，因为OpenProcess API 函数可以在两者之间进行转换。
ProcessID = Shell(CommandLine)
如果进程 ID 非零，则进程已创建并启动，因此我们可以直接等待它完成。为了等待，我们使用一个名为WaitForSingleObject 的 API 函数，该函数接收进程句柄和以毫秒为单位的超时时间。此函数只是等待进程终止或超时，它返回一个状态代码来指示哪一个。
If ProcessID Then
非零（True），因此 Shell 成功。现在获取 PID 的进程句柄（Wait 接收句柄）。
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
未能获取进程句柄。如果进程非常快地终止，或者它可能根本没有执行，即使 Windows 启动了一个进程，也会发生这种情况。向调用者返回false 以表示它失败。
ShellWait = False
End If
Else
如果进程 ID 为零，则 Shell 失败。
ShellWait = False End If End Function
主模块包含启动应用程序并使其进入初始状态的所有代码。在本例中，我们还使用它作为声明各种常量和全局函数的地方。
Attribute VB_Name = "modMain" Option Explicit
常量gsFILE_FILTER 和gsSAVE_AS_FILTER 在我们显示“通用对话框”以打开和保存文件时使用。它们告诉对话框在组合框中放置哪些文件掩码。请注意，我们已经为rtf、txt 和所有文件提供了支持。这意味着用户可以打开纯文本文件并将其保存为rtf。当然，用户也可以尝试打开不是文本或富文本的文件，我们必须应对这种情况。这些声明是公有的，因为它们实际上是在不同的代码模块中使用的。
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)"
cEvalDoc 类的实例完成了繁重的工作。我们永远不需要超过一个此类的实例，因此我们在这里将其声明为全局变量，并在main 子例程中实例化它。
Public goEvalDoc As cEvalDoc
宏处理器需要跟踪文本中进行替换的位置以及实际的替换内容。tResult 用户定义类型 (UDT) 用于保存必要的信息。请注意，Value 成员被声明为Variant，因为表达式的结果可以是任何东西，而不仅仅是数字。
Public Type tResult Value As Variant Start As Long length As Long ResultType As eResultType End Type
结果类型是一种枚举类型。这使得代码更易于阅读。请注意，没有成员被明确分配值，这是因为我们不关心这些值是什么，只要它们是不同的即可。
Public Enum eResultType SourceError SourceNoError Result End Enum
我们需要一个地方来存储我们将替换回文本中的值，因为在我们完成整个文档的处理之前，我们不能将它们放进去。这样做的原因是结果的长度可能与它替换的文本的长度不同。我们维护结果计数，以便我们可以让gaResults 数组扩展。当我们再次评估文档时，我们首先简单地将glresultsCount 重置为零；这样可以节省时间，因为不需要每次都重新分配结果数组。
Public gaResults() As tResult Public glResultsCount As Long
FileSystemObject 比用于读取文件的旧的内置 VB 函数更易于使用。要使用它，您必须安装脚本运行时库。
Public goFSO As FileSystemObject
此程序中使用的某些函数需要创建临时文件。为了确保避免此程序的不同实例之间以及与其他程序之间的冲突，我们在系统临时文件夹中创建了一个新的临时文件夹，并将它的名称存储在此变量中。
Public gsTempFolder As String
main 例程初始化应用程序。它创建临时工作区，创建文档评估器的实例，显示主窗体并分配结果数组。
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
应用程序可以通过多种不同的方式关闭，但每个方式都应以调用此函数结束，以便所有文档都正确关闭。到目前为止，还没有自动保存的实现，也没有提示用户保存已更改的文档。这是添加此类代码的地方。
Public Sub ExitApplication()
Dim oForm As Form
For Each oForm In Forms
Unload oForm
Next oForm
End Sub
此例程创建一个唯一的数字。它由需要创建临时文件的函数使用。结果始终是一个整数，但我们使用Double 而不是Long，以便我们“永远”不会用完数字（在这个应用程序中，这种改进几乎没有必要）。
Public Function NextSerial() As Double Static nSerial As Double nSerial = nSerial + 1 NextSerial = nSerial End Function
这是用于将所有这些内容组合在一起的 Visual Basic 项目文件 (VBP)。原则上，应该能够自动下载和编译它。请注意，您在此 VBP 中找到的任何绝对路径在复制到您的计算机后可能无法指向任何内容。
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
| 上一篇：JArithmetic Round Two | 目录 | 下一篇：语言 |