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

📄 frmcheckpointentry.frm

📁 Data monkey是一个强大的是数据传输和转换应用程序。使用DataMonkey用户可以把复杂的文本文件格式
💻 FRM
📖 第 1 页 / 共 2 页
字号:
    
    If lstFields.ListItems.Count > 0 Then
        Dim item As ListItem
        Set item = lstFields.ListItems(1)
        Set lstFields.SelectedItem = item
        Call lstFields_ItemClick(item)
    Else
        Me.lstFieldActions.ListItems.Clear
    End If
    
    ' Update the status of the various buttons.
    SetButtonStatus

End Sub

Private Sub btnDeleteFieldAction_Click()
    Dim cp As CInputRecord
    Dim di As CInputField
    Dim act As Object
    
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    If cp Is Nothing Then Exit Sub
    
    Set di = cp.GetDataPointByName(Me.lstFields.SelectedItem.Text)
    If di Is Nothing Then Exit Sub
    
    di.GetActions.Remove Me.lstFieldActions.SelectedItem.index
    di.GetActions.Reorder
    ChangeFieldActionList
    
    ' Need to save now!
    GImport.dirty = True

    Set di = Nothing
    Set cp = Nothing
    
    ' Update the status of the various buttons.
    SetButtonStatus

End Sub

Private Sub btnDeleteLine_Click()
    ' Add a new item with a default name.
    lfcDeleteCheckpoint GImport, lstCheckPoints

    ' Need to save now!
    GImport.dirty = True

    If lstCheckPoints.ListItems.Count > 0 Then
        Dim item As ListItem
        Set item = lstCheckPoints.ListItems(1)
        Set lstCheckPoints.SelectedItem = item
        Call lstCheckPoints_ItemClick(item)
    Else
        Me.lstActions.ListItems.Clear
        Me.lstFieldActions.ListItems.Clear
        Me.lstFields.ListItems.Clear
    End If
    
    
    ' Update the status of the various buttons.
    SetButtonStatus
End Sub

Private Sub btnEditFieldAction_Click()
    Dim cp As CInputRecord
    Dim di As CInputField
    Dim act As Object
    
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    Set di = cp.GetDataPointByName(Me.lstFields.SelectedItem.Text)
    Set act = di.GetAction(lstFieldActions.SelectedItem.index)

    act.EditProperties Me.lstFields.SelectedItem.Text, GImport
    
    If GFormReturnValue = vbOK Then
        ' The action description may have changed
        ChangeFieldActionList
        
        ' Need to save now!
        GImport.dirty = True
    End If
    
    Set act = Nothing
    Set di = Nothing
    Set cp = Nothing

End Sub

Private Sub btnEditStep_Click()

    Dim cp As CInputRecord
    Dim act As Object
    
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    Set act = cp.GetAction(Me.lstActions.SelectedItem.index)
    act.EditProperties lstCheckPoints.SelectedItem.Text, GImport
    
    If GFormReturnValue = vbOK Then
        ' The action description may have changed
        lfcLoadActionList cp.GetActions, lstActions
    
        ' Need to save now!
        GImport.dirty = True
    End If
    
    Set cp = Nothing
    Set act = Nothing
End Sub

Private Sub btnNewField_Click()
    Dim dp As CInputField
    
    '************************************
    ' Add a new item with a default name.
    '************************************
    
    Set dp = AddFieldItem()
    
    ' Update the status of the various buttons.
    SetButtonStatus

End Sub

Private Sub Form_Load()
    
    FillCheckPointList
    SetButtonStatus
    
End Sub

Private Sub FillCheckPointList()
    Dim cp As CInputRecord
    Dim ItemsAdded As Boolean
    
    ItemsAdded = False

    For Each cp In GImport.GetCheckPoints()
        Dim newItem As ListItem
    
        Set newItem = lstCheckPoints.ListItems.Add(, cp.GetID)
        newItem.Text = cp.name
        ItemsAdded = True
    Next cp
    
    If ItemsAdded Then
        Set lstCheckPoints.SelectedItem = lstCheckPoints.ListItems(1)
        Call lstCheckPoints_ItemClick(lstCheckPoints.SelectedItem)
    End If
    
End Sub



Private Sub lstFields_AfterLabelEdit(Cancel As Integer, NewString As String)
    Dim cp As CInputRecord
    Dim i As Boolean
    
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    If cp Is Nothing Then Exit Sub
    
    If cp.name = NewString Then Exit Sub
    i = cp.ChangeDataPointName(mDataPointBeingEdited, NewString)
    mDataPointBeingEdited = ""
    
    If i Then
        ' Need to save now!
        GImport.dirty = True
    Else
        Cancel = 1
    End If
End Sub

Private Sub lstFields_BeforeLabelEdit(Cancel As Integer)
    mDataPointBeingEdited = lstFields.SelectedItem.Text
End Sub

Private Sub lstFields_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
    ' When a ColumnHeader object is clicked, the ListView control is
    ' sorted by the subitems of that column.
    ' Set the SortKey to the Index of the ColumnHeader - 1

    If ColumnHeader.index = 2 Then
        lstFields.Sorted = False
        
        lstFields.ListItems.Clear
        lfcLoadFieldList _
            GImport.GetCheckPoint(lstCheckPoints.SelectedItem.Text), _
            lstFields
        ChangeFieldActionList

    Else
        ' Sort on the first column.
        lstFields.SortKey = 0
        
        ' Set Sorted to True to sort the list.
        lstFields.Sorted = True
    End If

End Sub

Private Sub lstFields_ItemClick(ByVal item As ComctlLib.ListItem)
    ChangeFieldActionList
    SetButtonStatus
End Sub

Private Sub picDnAction_Click()
    
    Dim cp As CInputRecord
    If lstCheckPoints.SelectedItem Is Nothing Then Exit Sub
    Set cp = GImport.GetCheckPoint(lstCheckPoints.SelectedItem.key)
    If cp Is Nothing Then Exit Sub
    
    lvMoveSelectedActionDown cp.GetActions, lstActions
    
    ' Need to save now!
    GImport.dirty = True

End Sub


Private Sub picDnCheckpoint_Click()
    lvMoveSelectedCheckpointDown GImport, lstCheckPoints
    
    ' Need to save now!
    GImport.dirty = True
End Sub

Private Sub picDnDataItem_Click()
    Dim cp As CInputRecord
    Set cp = GImport.GetCheckPoint(lstCheckPoints.SelectedItem.key)
    If cp Is Nothing Then Exit Sub
    
    lvMoveSelectedDataItemDown cp, Me.lstFields
    
    ' Need to save now!
    GImport.dirty = True
End Sub

Private Sub picDnFieldAction_Click()
    
    Dim cp As CInputRecord
    Dim di As CInputField
    
    If lstCheckPoints.SelectedItem Is Nothing Then Exit Sub
    If lstFields.SelectedItem Is Nothing Then Exit Sub
    
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    If cp Is Nothing Then GoTo done
    Set di = cp.GetDataPoint(lstFields.SelectedItem.key)
    If di Is Nothing Then GoTo done
    
    lvMoveSelectedActionDown di.GetActions, lstFieldActions
    
    ' Need to save now!
    GImport.dirty = True

done:
    Set cp = Nothing
    Set di = Nothing
    
End Sub

Private Sub picUpAction_Click()
    Dim cp As CInputRecord
    If lstCheckPoints.SelectedItem Is Nothing Then Exit Sub
    Set cp = GImport.GetCheckPoint(lstCheckPoints.SelectedItem.key)
    If cp Is Nothing Then Exit Sub
    
    lvMoveSelectedActionUp cp.GetActions, Me.lstActions
    
    ' Need to save now!
    GImport.dirty = True
End Sub

Private Sub picUpCheckpoint_Click()
    lvMoveSelectedCheckpointUp GImport, Me.lstCheckPoints
    
    ' Need to save now!
    GImport.dirty = True
End Sub

Private Sub lstCheckPoints_AfterLabelEdit(Cancel As Integer, NewString As String)
    
    Dim i As Boolean
    i = GImport.ChangeCheckPointName( _
        lstCheckPoints.SelectedItem.key, NewString)
    
    If i Then
        ' Need to save now!
        GImport.dirty = True
    Else
        Cancel = 1
    End If
End Sub

Private Sub lstCheckPoints_ColumnClick(ByVal ColumnHeader As ComctlLib.ColumnHeader)
    ' When a ColumnHeader object is clicked, the ListView control is
    ' sorted by the subitems of that column.
    ' Set the SortKey to the Index of the ColumnHeader - 1

    If ColumnHeader.index = 2 Then
        lstCheckPoints.Sorted = False
        
        lstCheckPoints.ListItems.Clear
        FillCheckPointList
    Else
        ' Sort on the first column.
        lstCheckPoints.SortKey = 0
        
        ' Set Sorted to True to sort the list.
        lstCheckPoints.Sorted = True
    End If

End Sub

Private Sub lstCheckPoints_ItemClick(ByVal item As ComctlLib.ListItem)
    
    Dim cp As CInputRecord
    Dim di As CInputField
    
    Set cp = GImport.GetCheckPointByName(item.Text)
    If cp Is Nothing Then
        
        Exit Sub
    End If

    ' Update the list of Checkpoint Actions.
    lfcLoadActionList cp.GetActions(), lstActions

    ' Update the list of DataItems.
    lstFields.ListItems.Clear
    lfcLoadFieldList GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text), lstFields
    
    ' Update the list of DataItem actions.
    ChangeFieldActionList
    
    Me.fraFields.Caption = "Fields for line " & lstCheckPoints.SelectedItem.Text
    SetButtonStatus
End Sub

Private Function AddFieldItem() As CInputField

    Set AddFieldItem = Nothing
    Dim cp As CInputRecord
    
    ' Get the checkpoint that will own the new data item.
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    
    ' Add a field to the checkpoint and to the listbox.
    lfcAddField cp, lstFields
    
    ' Need to save now!
    GImport.dirty = True

End Function

Private Sub ChangeFieldActionList()
    On Error GoTo eHandler
    
    Dim cp As CInputRecord
    Dim dp As CInputField
    
    If lstCheckPoints.SelectedItem Is Nothing Then Exit Sub
    If lstFields.SelectedItem Is Nothing Then Exit Sub

    ' Get the checkpoint.
    Set cp = GImport.GetCheckPointByName(lstCheckPoints.SelectedItem.Text)
    If cp Is Nothing Then Exit Sub
    
    ' Get the DataItem.
    Set dp = cp.GetDataPointByName(lstFields.SelectedItem.Text)
    If dp Is Nothing Then Exit Sub
    
    ' Load the Field Action list with the data items actions.
    lfcLoadActionList dp.GetActions, lstFieldActions
    
    Exit Sub

eHandler:
    LogError "frmDataItemEntry", "ChangeFieldActionList", Error(Err), False
'
End Sub


Private Sub SetButtonStatus()
    
    ' If we have any checkpoint items.
    If lstCheckPoints.ListItems.Count > 0 Then
        
        btnNewField.Enabled = True
        btnAddStep.Enabled = True
        btnDeleteLine.Enabled = True
        
        ' If there are any actions for this checkpoint.
        If lstActions.ListItems.Count > 0 Then
            btnEditStep.Enabled = True
            btnDelete.Enabled = True
        Else
            btnEditStep.Enabled = False
            btnDelete.Enabled = False
        End If
    
        ' If we have any field items.
        If lstFields.ListItems.Count > 0 Then
            btnAddFieldAction.Enabled = True
            btnDeleteField.Enabled = True
            
            ' If we have any field actions.
            If lstFieldActions.ListItems.Count > 0 Then
                btnEditFieldAction.Enabled = True
                btnDeleteFieldAction.Enabled = True
            Else
                btnEditFieldAction.Enabled = False
                btnDeleteFieldAction.Enabled = False
            End If
            
        ' We have no fields.
        Else
            btnDeleteField.Enabled = False
            btnEditFieldAction.Enabled = False
            btnDeleteFieldAction.Enabled = False
            btnAddFieldAction.Enabled = False
        End If
    
    ' We have no checkpoints.
    Else
        
        ' Set Line buttons.
        btnDeleteLine.Enabled = False
        btnEditStep.Enabled = False

        ' Set Line Action buttons.
        btnAddStep.Enabled = False
        btnEditStep.Enabled = False
        btnDelete.Enabled = False
        
        ' Set Field Buttons.
        btnDeleteField.Enabled = False
        btnNewField.Enabled = False

        ' Set Field Action Buttons.
        btnDeleteFieldAction.Enabled = False
        btnAddFieldAction.Enabled = False
        btnEditFieldAction.Enabled = False

    End If
    
End Sub

Private Sub picUpDataItem_Click()
    Dim cp As CInputRecord
    Set cp = GImport.GetCheckPoint(lstCheckPoints.SelectedItem.key)
    If cp Is Nothing Then Exit Sub
    
    lvMoveSelectedDataItemUp cp, Me.lstFields
    
    ' Need to save now!
    GImport.dirty = True
End Sub

Private Sub picUpFieldAction_Click()
    
    Dim cp As CInputRecord
    Dim di As CInputField
    
    If lstCheckPoints.SelectedItem Is Nothing Then Exit Sub
    If lstFields.SelectedItem Is Nothing Then Exit Sub
    
    Set cp = GImport.GetCheckPoint(lstCheckPoints.SelectedItem.key)
    If cp Is Nothing Then Exit Sub
    Set di = cp.GetDataPoint(lstFields.SelectedItem.key)
    If di Is Nothing Then Exit Sub
    
    lvMoveSelectedActionUp di.GetActions, Me.lstFieldActions
    
    ' Need to save now!
    GImport.dirty = True

End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -