⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmdocument.frm

📁 Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式
💻 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 + -