📄 frmtree.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Object = "{BDC217C8-ED16-11CD-956C-0000C04E4C0A}#1.1#0"; "TABCTL32.OCX"
Object = "{8E0D0325-1E09-4CCB-A3A2-05F98DFA89B1}#1.0#0"; "vbShellCtrl.ocx"
Begin VB.Form frmtree
AutoRedraw = -1 'True
BorderStyle = 0 'None
Caption = "Dest Project"
ClientHeight = 6885
ClientLeft = 0
ClientTop = 0
ClientWidth = 3750
ControlBox = 0 'False
LinkTopic = "Form1"
Moveable = 0 'False
ScaleHeight = 6885
ScaleWidth = 3750
ShowInTaskbar = 0 'False
Begin MSComctlLib.ImageList ImageList2
Left = 3360
Top = 7320
_ExtentX = 794
_ExtentY = 794
BackColor = 16777215
ImageWidth = 16
ImageHeight = 16
MaskColor = -2147483628
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 4
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":08DA
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":15B4
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":1E8E
Key = ""
EndProperty
EndProperty
End
Begin TabDlg.SSTab SSTab1
Height = 6800
Left = 45
TabIndex = 0
Top = 60
Width = 3675
_ExtentX = 6482
_ExtentY = 11986
_Version = 393216
TabOrientation = 1
Style = 1
Tab = 1
TabsPerRow = 4
TabHeight = 882
MouseIcon = "frmtree.frx":2768
TabCaption(0) = "Project"
TabPicture(0) = "frmtree.frx":2BBA
Tab(0).ControlEnabled= 0 'False
Tab(0).Control(0)= "prjTreeView"
Tab(0).ControlCount= 1
TabCaption(1) = "Dom"
TabPicture(1) = "frmtree.frx":3494
Tab(1).ControlEnabled= -1 'True
Tab(1).Control(0)= "tvwNodeTree"
Tab(1).Control(0).Enabled= 0 'False
Tab(1).ControlCount= 1
TabCaption(2) = "Explorer"
TabPicture(2) = "frmtree.frx":3813
Tab(2).ControlEnabled= 0 'False
Tab(2).Control(0)= "sfExplorer"
Tab(2).ControlCount= 1
Begin MSComctlLib.TreeView tvwNodeTree
Height = 6100
Left = 105
TabIndex = 1
Top = 120
Width = 3480
_ExtentX = 6138
_ExtentY = 10769
_Version = 393217
Indentation = 529
Style = 7
HotTracking = -1 'True
ImageList = "ImageList1"
Appearance = 1
End
Begin MSComctlLib.TreeView prjTreeView
Height = 6100
Left = -74895
TabIndex = 2
Top = 105
Width = 3480
_ExtentX = 6138
_ExtentY = 10769
_Version = 393217
Indentation = 529
Style = 7
HotTracking = -1 'True
SingleSel = -1 'True
ImageList = "ImageList2"
Appearance = 1
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin vbShellCtrl.ShellTree sfExplorer
Height = 6135
Left = -74880
TabIndex = 3
Top = 120
Width = 3495
_ExtentX = 6165
_ExtentY = 10821
BackColor = -2147483634
ContextMenu = -1 'True
SelectedPath = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
End
End
Begin MSComctlLib.ImageList ImageList1
Left = 4320
Top = 1080
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
UseMaskColor = 0 'False
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 6
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":3C65
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":40B7
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":440A
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":475D
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":4AB0
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmtree.frx":4E03
Key = ""
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmtree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Implements IWillDockToActiveBar
Dim m_TreeExist As Boolean
Private Function IWillDockToActiveBar_DockYourselfTo(ByVal ActiveBar As ActiveBar2LibraryCtl.IActiveBar2, Optional ByVal parmIsVisible As Boolean = True, Optional ByVal paramDockingarea As ActiveBar2LibraryCtl.DockingAreaTypes = 3&, Optional ByVal paramGrabHandleStyle As ActiveBar2LibraryCtl.GrabHandleStyles = 7&, Optional ByVal paramDockingOffset As Long = 0&) As ActiveBar2LibraryCtl.IBand
Dim b As ActiveBar2LibraryCtl.band
Dim t As ActiveBar2LibraryCtl.tool
Dim sBandName As String
On Error GoTo eh_IWillDockToActiveBar_DockYourselfTo
sBandName = DOCKABLEBANDPREFIXNAME + Me.Name
'这个可入坞的窗体带区并没有存在，所以创建一个
Set b = ActiveBar.Bands.Add(sBandName)
b.Caption = Me.Caption
b.DockingArea = paramDockingarea
b.DockLine = 0
b.DockingOffset = paramDockingOffset
b.GrabHandleStyle = paramGrabHandleStyle
b.AutoSizeForms = True
b.Type = ddBTNormal
b.DisplayMoreToolsButton = False
ABAddFlag ddBFSizer, b
b.Visible = parmIsVisible
'添加一个可入坞窗体按钮来使这个窗口入坞
Set t = b.Tools.Add(Me.hwnd, DOCKABLETOOLPREFIXNAME + Me.Name)
t.ControlType = ddTTForm
t.Caption = Me.Caption
Set t.Custom = Me
ex_IWillDockToActiveBar_DockYourselfTo:
Exit Function
eh_IWillDockToActiveBar_DockYourselfTo:
MsgBox "There was an error while docking form [" + Me.Name + "]."
Resume ex_IWillDockToActiveBar_DockYourselfTo
End Function
Public Sub TreeView()
tvwNodeTree.Nodes.Clear
AddNode oDoc.documentElement
Me.Refresh
End Sub
Private Sub AddNode(ByRef oelem As IXMLDOMNode, Optional ByRef oTreeNode As Node)
Dim oNewNode As Node
Dim oNodeList As IXMLDOMNodeList
Dim i As Long
Dim j As Integer
Dim ntemp As Variant
If oTreeNode Is Nothing Then
Set oNewNode = tvwNodeTree.Nodes.Add(, , , 6, 6)
oNewNode.Expanded = True
Else
If oelem.nodeName = "OBJECT" Then
Set oNewNode = tvwNodeTree.Nodes.Add(oTreeNode, tvwChild, , , 5, 5)
ElseIf oelem.nodeName = "ATTRIBUTE" Then
Set oNewNode = tvwNodeTree.Nodes.Add(oTreeNode, tvwChild, , , 3, 3)
ElseIf oelem.nodeName = "METHOD" Then
Set oNewNode = tvwNodeTree.Nodes.Add(oTreeNode, tvwChild, , , 2, 2)
ElseIf oelem.nodeName = "RULE" Then
Set oNewNode = tvwNodeTree.Nodes.Add(oTreeNode, tvwChild, , , 4, 4)
Else
Set oNewNode = tvwNodeTree.Nodes.Add(oTreeNode, tvwChild, , , 1, 1)
End If
End If
oNewNode.Text = oelem.nodeName
If Not oelem.attributes Is Nothing Then
If (oelem.attributes.length > 0) Then
For i = 0 To oelem.attributes.length - 1
If (oelem.attributes(i).nodeName = "name") Then
oNewNode.Text = oelem.attributes(i).nodeValue
End If
Next
If (oelem.nodeName = "SELECT") Then
oNewNode.Text = oelem.nodeName + " " + oelem.attributes(0).nodeValue + " " + oelem.attributes(1).nodeValue
End If
If (oelem.nodeName = "REASON") Then
oNewNode.Text = oelem.nodeName + " " + oelem.attributes(0).nodeValue + " " + oelem.attributes(1).nodeValue
End If
If (oelem.nodeName = "SEND") Then
oNewNode.Text = oelem.nodeName + " " + oelem.attributes(0).nodeValue + " " + oelem.attributes(1).nodeValue
End If
If (oelem.nodeName = "VARIABLE") Then
oNewNode.Text = oelem.nodeName + " " + oelem.attributes(0).nodeValue + " " + oelem.attributes(1).nodeValue
End If
If (oelem.nodeName = "SELECTNUM") Then
oNewNode.Text = oelem.nodeName + " " + oelem.attributes(0).nodeValue + " " + oelem.attributes(1).nodeValue
End If
End If
Else
oNewNode.Text = oelem.nodeValue
End If
If (oelem.nodeName = "STATEMENT") Then
For i = 0 To oelem.attributes.length - 1
oelem.Text = oelem.Text + oelem.attributes(i).Text
Next
End If
Set oNewNode.Tag = oelem
Set oNodeList = oelem.childNodes
For i = 0 To oNodeList.length - 1
AddNode oNodeList.item(i), oNewNode '递归调用 addnode
Next
End Sub
Private Sub Form_Load()
Me.SSTab1.Tab = 0
m_TreeExist = True
End Sub
Private Sub Form_Resize()
Me.SSTab1.Height = Me.Height - Me.SSTab1.Top
Me.prjTreeView.Height = Me.SSTab1.Height - Me.prjTreeView.Top - 600
Me.tvwNodeTree.Height = Me.prjTreeView.Height
Me.sfExplorer.Height = Me.prjTreeView.Height
End Sub
Private Sub mnuAddKnowledge_Click()
frmAddKnowledge.Show
End Sub
'''''''''''''''''''''''''''''''''''''''''
' 禁用右上角的关闭按钮
'''''''''''''''''''''''''''''''''''''''''
Private Sub Form_Unload(Cancel As Integer)
'Cancel = True
End Sub
Private Sub prjTreeView_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = "DELETE" Then
fMainForm.mnuDeleteKnowledge_Click
End If
End Sub
Private Sub prjTreeView_Mouseup(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim hitem As Node
On Error Resume Next
If Button = vbRightButton Then
Set hitem = prjTreeView.HitTest(x, y)
If Not hitem Is Nothing Then
Select Case hitem.Index
Case 1
fMainForm.ActiveBar.Bands("popuptree").Tools("miReasonCompile").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPAddFile").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPDeleteFile").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPSaveFile").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPSaveFileas").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPExportFile").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPPreviewFile").Enabled = False
Case Is > 1
fMainForm.ActiveBar.Bands("popuptree").Tools("miReasonCompile").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPAddFile").Enabled = False
fMainForm.ActiveBar.Bands("popuptree").Tools("miPDeleteFile").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPSaveFile").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPSaveFileas").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPExportFile").Enabled = True
fMainForm.ActiveBar.Bands("popuptree").Tools("miPPreviewFile").Enabled = True
End Select
fMainForm.ActiveBar.Bands("popuptree").PopupMenu
End If
End If
End Sub
Private Sub prjTreeView_NodeClick(ByVal Node As MSComctlLib.Node)
Dim find, flag As Boolean
Dim f As Form
find = False
If Node.Index > 1 Then
For Each f In Forms
If (Not f Is Nothing) Then
If Node.Tag = f.Caption Then
find = True
f.ZOrder (0)
Exit Sub
End If
End If
Next f
If (find = False) Then '工程树中文档已被卸载，重新载入
fMainForm.LoadNewDoc
fMainForm.ActiveForm.rtfText.LoadFile Node.Tag, rtfText
fMainForm.ActiveForm.SetModified (False)
fMainForm.ActiveForm.Caption = Node.Tag
fMainForm.ActiveForm.Tag = Node.Text
flag = False
End If
End If
End Sub
Public Function TreeExist() As Boolean
TreeExist = m_TreeExist
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -