📄 frmdocument.frm
字号:
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "comctl32.ocx"
Begin VB.Form frmDocument
Caption = "Project"
ClientHeight = 4440
ClientLeft = 156
ClientTop = 432
ClientWidth = 3996
Icon = "frmDocument.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4440
ScaleWidth = 3996
Begin ComctlLib.TreeView TreeView1
Height = 3375
Left = 120
TabIndex = 0
Top = 120
Width = 3495
_ExtentX = 6160
_ExtentY = 5948
_Version = 327682
HideSelection = 0 'False
Indentation = 441
LineStyle = 1
Style = 7
ImageList = "img"
BorderStyle = 1
Appearance = 0
OLEDragMode = 1
OLEDropMode = 1
End
Begin ComctlLib.ImageList img
Left = 1560
Top = 3540
_ExtentX = 995
_ExtentY = 995
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 16777215
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 8
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":0442
Key = "OutputSchema"
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":075C
Key = "CheckPoint"
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":0A76
Key = "Action"
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":0B88
Key = "DataItem"
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":0EA2
Key = "ClosedFolder"
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":11BC
Key = "Import"
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":12CE
Key = "Output"
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmDocument.frx":13E0
Key = "OpenFolder"
EndProperty
EndProperty
End
End
Attribute VB_Name = "frmDocument"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' DataMonkey Data Conversion Application. Written by Theodore L. Ward
' Copyright (C) 2002 AstroComma Incorporated.
'
' This program is free software; you can redistribute it and/or
' modify it under the terms of the GNU General Public License
' as published by the Free Software Foundation; either version 2
' of the License, or (at your option) any later version.
'
' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' GNU General Public License for more details.
'
' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
' The author may be contacted at:
' TheodoreWard@Hotmail.com or TheodoreWard@Yahoo.com
Option Explicit
Dim mRightButtonDown As Boolean
Dim mItemBeingDragged As ComctlLib.node
Public Sub SetTitle()
Me.Caption = IIf(GImport Is Nothing, "", GImport.name)
End Sub
Private Sub Form_Load()
mRightButtonDown = False
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
If UnloadMode = vbFormControlMenu Then
Cancel = 1
MainDocumentVisible False
End If
End Sub
Private Sub Form_Resize()
Me.TreeView1.top = 0
Me.TreeView1.left = 0
Me.TreeView1.Width = ScaleWidth
Me.TreeView1.Height = ScaleHeight
End Sub
Private Sub TreeView1_AfterLabelEdit(Cancel As Integer, NewString As String)
Dim i As Boolean
Dim cp As CInputRecord
Select Case tiGetSelectedItemType()
'*********************************
' Change the name of a checkpoint.
'*********************************
Case etiType.ticheckpoint
i = GImport.ChangeCheckPointName( _
TreeView1.SelectedItem.key, NewString)
Cancel = Not i
'*******************************
' Change the name of a dataitem.
'*******************************
Case etiType.tidataitem
' Get the checkpoint that owns this dataitem.
Set cp = GImport.GetCheckPoint( _
TreeView1.SelectedItem.parent.parent.key)
If cp Is Nothing Then
LogError "frmDocument", "AfterLabelEdit", _
"Invalid parent CheckPoint", False
Exit Sub
End If
i = cp.ChangeDataPointName(TreeView1.SelectedItem.Text, NewString)
Cancel = Not i
Case etiType.tioutputlinks
Dim ol As COutputLinks
Set ol = GImport.GetOutputLinksManager( _
TreeView1.SelectedItem.key)
ol.name = NewString
Set ol = Nothing
End Select
Set cp = Nothing
End Sub
Private Sub TreeView1_BeforeLabelEdit(Cancel As Integer)
Select Case tiGetSelectedItemType()
Case etiType.ticheckpoint, _
etiType.tidataitem, _
etiType.tioutputlinks
Cancel = False
Case Else
Cancel = True
End Select
End Sub
Private Sub TreeView1_Collapse(ByVal node As ComctlLib.node)
If node.Image = "OpenFolder" Then
node.Image = "ClosedFolder"
End If
End Sub
Private Sub TreeView1_Expand(ByVal node As ComctlLib.node)
If node.Image = "ClosedFolder" Then
node.Image = "OpenFolder"
End If
End Sub
Private Sub TreeView1_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim node As ComctlLib.node
' Specifically select the item otherwise, it can be confusing
' when dragging and dropping items, because you have to click
' and let up on the button for the items to be selected by default.
Set node = TreeView1.HitTest(x, y)
If node Is Nothing Then Exit Sub
Set TreeView1.SelectedItem = node
Call TreeView1_NodeClick(node)
Set node = Nothing
If Button And vbRightButton Then
mRightButtonDown = True
Else
mRightButtonDown = False
End If
End Sub
Private Sub TreeView1_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button And vbLeftButton Then
End If
End Sub
Private Sub TreeView1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
mRightButtonDown = False
End Sub
Private Sub TreeView1_NodeClick(ByVal node As ComctlLib.node)
On Error GoTo errhandler
' Set the global variable so that our menu item code can use it.
Set GCurrentTreeNode = node
' Set the cut/copy/paste and popup menu statuses.
tiSetMenuStatus node.tag
' If the right button was pressed, display the popup menu.
If mRightButtonDown Then
PopupMenu fMainForm.mnuMainTreePopup
End If
Exit Sub
errhandler:
MsgBox Error(Err)
End Sub
Private Sub TreeView1_OLECompleteDrag(Effect As Long)
Set TreeView1.DropHighlight = Nothing
End Sub
Private Sub TreeView1_OLEDragDrop(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
On Error GoTo done
Dim node As ComctlLib.node, nodeDropping As ComctlLib.node
' Get the node we are dragging over.
Set node = TreeView1.HitTest(x, y)
' Get the node we are dragging.
Set nodeDropping = TreeView1.Nodes(Data.GetData(1))
' Make sure both nodes exist.
If node Is Nothing Or nodeDropping Is Nothing Then
GoTo done
End If
' If we are dragging over a sibling node its okay to drop
' otherwise don't allow a drop.
If node.parent Is nodeDropping.parent And _
node.tag = nodeDropping.tag Then
Dim ItemToMoveKey As String
ItemToMoveKey = nodeDropping.key
' Move the tree item.
MoveTreeItem nodeDropping, node
Set TreeView1.SelectedItem = _
TreeView1.Nodes(ItemToMoveKey)
End If
done:
Set TreeView1.DropHighlight = Nothing
Effect = vbDropEffectNone
End Sub
Private Sub TreeView1_OLEDragOver(Data As ComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
On Error GoTo done
Dim node As ComctlLib.node, nodeDragging As ComctlLib.node
' Get the node we are dragging over.
Set node = TreeView1.HitTest(x, y)
' Get the node we are dragging.
Set nodeDragging = TreeView1.Nodes(Data.GetData(1))
' Make sure both nodes exist.
If node Is Nothing Or nodeDragging Is Nothing Then
GoTo done
End If
' If we are dragging over a sibling node,
' enable drop, otherwise, disable drop.
If node.parent Is nodeDragging.parent And _
node.tag = nodeDragging.tag Then
Set TreeView1.DropHighlight = node
Effect = vbDropEffectMove
Exit Sub
End If
done:
Set TreeView1.DropHighlight = Nothing
Effect = vbDropEffectNone
End Sub
Private Sub TreeView1_OLESetData(Data As ComctlLib.DataObject, DataFormat As Integer)
If TreeView1.SelectedItem Is Nothing Then Exit Sub
' The data being dragged is the key to the selected item.
Data.SetData TreeView1.SelectedItem.key, vbCFText
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -