《程序员》杂志 2002年2月期:《VB专家门诊》栏目原稿全文

问题: 如何在字符串:"name;age;addr;sex" 中指定位置插入新字符串:"School",变为: "name;age;addr;school;sex"?
解答: 先 Split,再 Join,可编写如下函数:
      Public Function InsertIntoString(StringX As String, i As Long, StringY As String, Optional Delimiter As String = " ") As String
             'StringX 为原字符串,i 为第 i 个 ";",'StringY 为要插入的字符串,'Delimiter 为分隔符
             Dim a() As String
             a = VBA.Split(VBA.Trim(StringX), Delimiter)
             If i < LBound(a) + 1 Then
                a(LBound(a)) = StringY & Delimiter & a(LBound(a)) '插在最前
             ElseIf i > UBound(a) + 1 Then
                a(UBound(a)) = a(UBound(a)) & Delimiter & StringY '插在最后
             Else
                a(LBound(a) + i - 1) = a(LBound(a) + i - 1) & Delimiter & StringY '插在中间
             End If
             InsertIntoString = VBA.Join(a, Delimiter)
      End Function
      Private Sub Command1_Click() '测试程序
              VBA.MsgBox InsertIntoString("name;age;addr;sex", 0, "school", ";") '插在最前
              VBA.MsgBox InsertIntoString("name;age;addr;sex", 1, "school", ";") '插在中间
              VBA.MsgBox InsertIntoString("name;age;addr;sex", 9, "school", ";") '插在最后
      End Sub问题: 如何获取 IE 浏览器窗口(或: WebBrowser 控件)的 HTML 源?
解答: '引用 Microsoft Internet Controls
      '该函数是用来从本地获取 IE 窗口中,取得标题栏中含有 TitlePattern 字符的 IE 窗口的 HTML 源!
      Public Function GetSourceFromIEBrowser(TitlePattern As String, Optional WithoutURLCommentInHeader As Boolean) As String
             Dim x As New SHDocVw.ShellWindows
             Dim i As Long
             For i = 0 To x.Count - 1
                 If VBA.TypeName(x.Item(i).Document) = "HTMLDocument" Then
                    If x.Item(i).Document.Title Like TitlePattern Then
                       '读者要具备一些 HTML + JavaScript 的 Web 开发经验
                       'Debug.Print x.Item(i).Document.documentElement.outerhtml
                       GetSourceFromIEBrowser = VBA.IIf(WithoutURLCommentInHeader, "", "<!-- " & x.Item(i).LocationURL & " -->" & vbCrLf) & x.Item(i).Document.documentElement.outerhtml
                       Exit For
                     End If
                 End If
             Next i
      End Function
      当然也可以用 Microsoft Internet Transfer Controls 或 Winsock Control 向 IE 窗口的 URL 所指的 WebServer(CGI)
      再次发出请求(Request),并接收 WebServer 响应(Response),分析获取的字符串,去掉头信息,得到 HTML 源!(其实本题没必要)问题: 如何响应 ListView 控件 ListItem (或: TreeView 控件 Node) 的"鼠标双击"事件?
解答: Private Sub Form_Load()
              'ListView:
              ListView1.ListItems.Add , , "aa"
              ListView1.ListItems.Add , , "bb"
              ListView1.HideSelection = False
              'TreeView:
              Dim i As Long
              Dim j As Long
              Dim NodeX As MSComctlLib.Node
              TreeView1.Style = tvwTreelinesPlusMinusPictureText
              Dim Temp As Long
              For i = 1 To 10
                  Temp = TreeView1.Nodes.Count + 1
                  Set NodeX = TreeView1.Nodes.Add(, , "Node" & Temp, "Node " & Temp)
                  For j = 0 To 5
                      TreeView1.Nodes.Add Temp, tvwChild, "Node" & TreeView1.Nodes.Count + 1, "Node " & TreeView1.Nodes.Count + 1
                  Next
                  NodeX.Expanded = True
               Next i
      End Sub
      Private Sub ListView1_DblClick()
              If Not ListView1.SelectedItem Is Nothing Then
                 VBA.MsgBox "Item: [" & ListView1.SelectedItem.Text & "] Double Click!"
              End If
      End Sub
      Private Sub ListView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
              '使双击空白处无效
              If Not ListView1.HitTest(x, y) Is ListView1.SelectedItem Then
                 Set ListView1.SelectedItem = Nothing
              End If
      End Sub
      '提醒注意的是当编程 TreeView 控件 Node 的"鼠标双击"事件时,应只响应"叶子(没有孩子的)节点":
      Private Sub TreeView1_DblClick()
              If Not TreeView1.SelectedItem Is Nothing Then
                '只响应叶节点(没有孩子)
                If TreeView1.SelectedItem.Children = 0 Then
                   VBA.MsgBox TreeView1.SelectedItem.Text
                End If
              End If
      End Sub
      Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
              If Not TreeView1.HitTest(x, y) Is TreeView1.SelectedItem Then
                 Set TreeView1.SelectedItem = Nothing
              End If
      End Sub问题: 如何实现 TreeView 控件 Node 的"鼠标右键弹出菜单",并响应选单(Menu Click)事件?
解答: 菜单结构: MenuNodes -> MenuNodesNodeX
      Private Sub Form_Load()
              Dim i As Integer
              TreeView1.Style = tvwTreelinesPlusMinusPictureText
              For i = 1 To 20
                  TreeView1.Nodes.Add , , "Node" & i, "Node " & i
              Next i
              TreeView1.HideSelection = False
              TreeView1.LabelEdit = tvwManual
      End Sub
      Private Sub MenuNodesNodeX_Click()
              VBA.MsgBox "Node: [" & MenuNodesNodeX.Caption & "] Pop Menu Click!"
      End Sub
      Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
              If Button = vbRightButton Then
                 If TreeView1.HitTest(x, y) Is TreeView1.SelectedItem Then
                    If Not TreeView1.SelectedItem Is Nothing Then
                       MenuNodesNodeX.Caption = TreeView1.SelectedItem.Text
                       Me.PopupMenu MenuNodes
                    End If
                 End If
              End If
      End Sub
      Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
              If Not TreeView1.HitTest(x, y) Is TreeView1.SelectedItem Then
                 Set TreeView1.SelectedItem = Nothing
              End If
      End Sub