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 | 目錄 | 下一篇：語言 |