?? cinputfield.cls
字號:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "CInputField"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
' 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
Option Compare Text
Private mActions As CActions
Private mvarname As String 'local copy
Private mvarIndex As Integer 'local copy
Private mvarvalue As Variant 'local copy
Private mUniqueID As String
Private mStorageLinks As COutputLinks
Public Sub ClearLinks()
While mStorageLinks.Count > 0
mStorageLinks.Remove 1
Wend
End Sub
Public Function Copy() As CInputField
On Error GoTo eHandler
Set Copy = Nothing
Dim i As Integer
Dim newObj As CInputField
Set newObj = New CInputField
newObj.name = Me.name
newObj.value = Me.value
newObj.SetActions mActions.Copy
For i = 1 To mStorageLinks.Count
newObj.AddStorageLink mStorageLinks(i)
Next i
Set Copy = newObj
Set newObj = Nothing
Exit Function
eHandler:
LogError "CInputField", "Copy", Error(Err), False
End Function
Public Sub SetActions(NewActions As CActions)
If NewActions Is Nothing Then Exit Sub
Set mActions = Nothing
Set mActions = NewActions
End Sub
Public Function GetStorageLinks() As COutputLinks
Set GetStorageLinks = mStorageLinks
End Function
Public Sub AddStorageLink(ol As COutputLink)
If mStorageLinks(ol.GetID) Is Nothing Then
mStorageLinks.AddObject ol
End If
End Sub
Public Function GetID() As String
GetID = mUniqueID
End Function
Public Property Let value(vData As Variant)
mvarvalue = vData
End Property
Public Property Set value(ByVal vData As Object)
Set mvarvalue = vData
End Property
Public Property Get value() As Variant
Attribute value.VB_UserMemId = 0
If IsObject(mvarvalue) Then
Set value = mvarvalue
Else
value = mvarvalue
End If
End Property
Public Function GetAction(ActionKey As Variant) As Object
Set GetAction = mActions.item(ActionKey)
End Function
Public Function GetActions() As CActions
Set GetActions = mActions
End Function
Public Function AddAction(act As Object) As Object
Set AddAction = mActions.AddObject(act)
End Function
Public Function CreateAction(CmdType As eCmdTypes) As Object
Set CreateAction = mActions.AddNew(CmdType)
End Function
Public Property Let index(ByVal vData As Integer)
mvarIndex = vData
End Property
Public Property Get index() As Integer
index = mvarIndex
End Property
Public Function Save(arc As CArchive) As Boolean
On Error GoTo eHandler
Save = False
arc.SaveItem aiBEGINDATAPOINT, mvarname
arc.SaveItem aiVALUE, "NAME", mvarname
arc.SaveItem aiVALUE, "INDEX", mvarIndex
'****************************
' Save the Action structures.
'****************************
If mActions.Count > 0 Then
arc.SaveItem aiCOMMENT, "Begin Actions for DataPoint " + mvarname
Dim act As Object
For Each act In mActions
act.Save arc
Next act
End If
arc.SaveItem aiENDITEM, mvarname
Save = True
Exit Function
eHandler:
LogError "CInputField", "Save", Error(Err)
Exit Function
End Function
Public Function Verify() As Boolean
End Function
Public Function Load(arc As CArchive) As Boolean
On Error GoTo eHandler
Load = False
Dim item As String, value As Variant, retVal As ArcRetType
'***************************************
' Get the next line from the input file.
'***************************************
Do
retVal = arc.GetNextItem(item, value)
' Error, log it, then exit with error.
If retVal = ArcRetType.cERROR Then
arc.AddError
GoTo done
' We are done with this object, leave.
ElseIf retVal = cENDITEM Then
Exit Do
End If
Select Case item
Case "Name"
mvarname = value
Case "Index"
mvarIndex = value
Case "Value"
Case "BEGIN ACTION"
CreateAction(GCmdHelper.CommandTypeFromName(CStr(value))).Load arc
Case Else
' This line contains an unrecognized item.
arc.AddError
End Select
Loop While True
Load = True
done:
Exit Function
eHandler:
LogError "CInputField", "Load", Error(Err)
End Function
Public Property Let name(ByVal vData As String)
mvarname = vData
End Property
Public Property Get name() As String
name = mvarname
End Property
Public Function Import(ByRef line As String) As Boolean
On Error GoTo eHandler
Import = False
Dim act As Object
' Execute all the actions for this dataitem.
For Each act In mActions
If act.Execute(mvarvalue) = False Then Exit Function
' If the import was cancelled, git out.
If GCancelImport Then Exit Function
Next act
' Store this value to the output object.
Dim ol As COutputLink
Dim i As Integer
Import = True ' So far so good.
' Store the dataitem for each link we have.
For Each ol In mStorageLinks
i = GImport.GetSchemaObject.StoreValue(ol, value)
If i = False Then Import = False
Next ol
Exit Function
eHandler:
LogError "CInputRecord", "Import", Error(Err)
End Function
Private Sub Class_Initialize()
mUniqueID = GetUniqueID
Set mActions = New CActions
Set mStorageLinks = New COutputLinks
End Sub
Private Sub Class_Terminate()
Set mActions = Nothing
Set mStorageLinks = Nothing
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -