关于类模块加结构的错误要怎么修改？简化后的代码～Form1:VB codeOption ExplicitDim FN As StringPrivate W
关于类模块加结构的错误要怎么修改？
简化后的代码～
Form1:
- VB code
Option ExplicitDim FN As StringPrivate WithEvents ABC As Class1Private Sub ABC_BackStruct(ByVal Num As Integer, ByVal Lines As Long)Dim i As Integer, j As Integer, k As Integer With Test For i = 0 To UBound(.A1) '.....???? For j = 0 To UBound(.A1(i).A2) '.....???? For k = 0 To UBound(.A1(i).A2(j).A3) '.....???? Next k Next j Next i End WithEnd SubPrivate Sub cmdCommand1_Click() With Dialog1 .ShowOpen If .FileName <> "" Then FN = .FileName txtText1.Text = FN End If .FileName = "" End WithEnd SubPrivate Sub cmdCommand2_Click()Dim Status As Boolean Set ABC = New Class1 With ABC .GetFile = FN .Run End With Set ABC = NothingEnd Sub
Module1:
- VB code
Option ExplicitPublic Type CCC A3() As New Class2 A1Data As StringEnd TypePublic Type BBB A2() As CCC A1Data As StringEnd TypePublic Type AAA A1() As BBBEnd TypePublic Test As AAA
Class1:
- VB code
Option ExplicitPrivate mvarClass2 As Class2Private mvarGetFile As StringPublic Event BackStruct(ByVal Num As Integer, ByVal Lines As Long)Public Property Let GetFile(ByVal vData As String) mvarGetFile = vDataEnd PropertyPrivate Sub Class_Initialize() Set mvarClass2 = New Class2 ReDim Test.A1(0)End SubPublic Property Get Class2() As Class2 Set Class2 = mvarClass2End PropertyPublic Property Set Class2(vData As Class2) Set mvarClass2 = vDataEnd PropertyPrivate Sub Class_Terminate() Set mvarClass2 = NothingEnd SubPublic Sub Run() Call StartEnd SubPrivate Sub Start()Dim TempString As String, Status As IntegerDim i As Integer, j As Integer, k As Integer, FileNum As IntegerDim ItemType As String Status = 0: i = 0: j = 0: k = 0: FileNum = FreeFile If mvarGetFile <> "" Then Open mvarGetFile For Input As #FileNum Do While Not EOF(FileNum) Line Input #FileNum, TempString TempString = Trim$(TempString) If TempString <> "" Then If InStr(TempString, "*") <> 0 Then Status = 1 ElseIf InStr(TempString, "-") <> 0 Then Status = 2 ElseIf InStr(TempString, "=") = 0 Then Status = 3 End If With Test If Status = 1 And InStr(TempString, "=") <> 0 Then ReDim Preserve .A1(i) .A1(i).A1Data = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1)) i = i + 1 ElseIf Status = 2 And InStr(TempString, "=") <> 0 Then ReDim Preserve .A1(i - 1).A2(j) .A1(i - 1).A2(j).A1Data = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1)) j = j + 1 ElseIf Status = 3 And InStr(TempString, "=") <> 0 Then ReDim Preserve .A1(i - 1).A2(j - 1).A3(k) ItemType = Mid$(TempString, 1, InStr(TempString, "=") - 1) .A1(i - 1).A2(j - 1).A3(k) = mvarClass2.GetP(ItemType, TempString) k = k + 1 End If End With End If Loop Close #FileNum End If End Sub
Class2:
- VB code
Option ExplicitPrivate Type B3 EEE As StringEnd TypePrivate Type B2 WWW As StringEnd TypePrivate Type B1 QQQ As StringEnd TypePublic Function GetP(ItemType As String, Source As String) As Class2 GetP = CheckItemType(ItemType, Source)End FunctionPrivate Function CheckItemType(iType As String, Temp As String) As Class2 iType = Trim$(iType) Select Case iType Case "CCCC" GetP(iType, Temp) = DPS_1(Temp) Case "DDDD" GetP(iType, Temp) = DPS_2(Temp) Case "EEEE" GetP(iType, Temp) = DPS_3(Temp) End Select End FunctionPrivate Function DPS_1(TempString As String) As Class2Dim DPS1_Struct As B1 DPS1_Struct.QQQ = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1)) DPS_1 = DPS1_Struct 'Error End FunctionPrivate Function DPS_2(TempString As String) As Class2Dim DPS2_Struct As B2 DPS2_Struct.WWW = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1)) DPS_2 = DPS2_Struct 'Error End FunctionPrivate Function DPS_3(TempString As String) As Class2Dim DPS3_Struct As B3 DPS3_Struct.EEE = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1)) DPS_3 = DPS3_Struct 'Error End Function
问题在怎把Class2建立的结构型态和结果传回Class1～
组合成一个完整的Test结构资料～
再返回到Form1的ABC_BackStruct()里面进行解析～?
[解决办法]
结构定义到标准模块中去
或把类做成dll再引用之
[解决办法]
Option Explicit
'Private Type B3
' EEE As String
'End Type
'Private Type B2
' WWW As String
'End Type
'Private Type B1
' QQQ As String
'End Type
Public MessageType As String '类型 B1、B2、B3
Public Message As String '内容
Public Function GetP(ItemType As String, Source As String) As Class2
Set GetP = CheckItemType(ItemType, Source)
End Function
Private Function CheckItemType(iType As String, Temp As String) As Class2
iType = Trim$(iType)
Select Case iType
Case "CCCC"
Set CheckItemType = DPS_1(Temp)
Case "DDDD"
Set CheckItemType = DPS_2(Temp)
Case "EEEE"
Set CheckItemType = DPS_3(Temp)
End Select
End Function
Private Function DPS_1(TempString As String) As Class2
'Dim DPS1_Struct As B1
'DPS1_Struct.QQQ = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
'DPS_1 = DPS1_Struct 'Error
MessageType="B1"
Message=Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
Set DPS_1=Me
End Function
Private Function DPS_2(TempString As String) As Class2
'Dim DPS2_Struct As B2
'DPS2_Struct.WWW = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
'DPS_2 = DPS2_Struct 'Error
MessageType="B2"
Message=Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
Set DPS_2=Me
End Function
Private Function DPS_3(TempString As String) As Class2
'Dim DPS3_Struct As B3
'DPS3_Struct.EEE = Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
'DPS_3 = DPS3_Struct 'Error
MessageType="B3"
Message=Trim(Mid$(TempString, InStrRev(TempString, "=") + 1))
Set DPS_3=Me
End Function
[解决办法]