VB自定义数据类型的数组调用内部变量，如何做入子程序 - 编程论坛

#2

风吹过b2015-05-27 16:45

能不能做一个子程序调用如 TestAll(Value)，所有都直接调用如：
可以，但 OutStatus 需要定义为类，而不能定义为结构。

类 Class1 代码：

程序代码：

Option Explicit

Public A_Value As Long
Public B_Value As Long
Public C_Value As Long
Public D_Value As Long
Public E_Value As Long
Public F_Value As Long
Public G_Value As Long
Public H_Value As Long
Public I_Value As Long
Public J_Value As Long
Public K_Value As Long
Public L_Value As Long
Public M_Value As Long
Public N_Value As Long
Public O_Value As Long
Public P_Value As Long
Public Q_Value As Long
Public R_Value As Long
Public S_Value As Long
Public T_Value As Long
Public U_Value As Long
Public V_Value As Long
Public W_Value As Long
Public X_Value As Long
Public Y_Value As Long
Public Z_Value As Long

引入模块文件，以便定义全局的 RecNum 和 Outstatus
代码如下：

程序代码：

Option Explicit

Public Const RecNum = 10
Public Outstatus(RecNum) As New Class1

最后窗体上的函数

程序代码：

Public Sub RVALUE(cs As String)
Dim i As Long
    For i = 1 To RecNum
        data(i) = CallByName(Outstatus(i), cs, VbGet)
    Next i
    Call Test(data(), Result1, Result2)
    Report = Report & vbCrLf & "I_Value:" & vbTab & Result1 & vbTab & Result2
End Sub

因为这行 Call Test(data(), Result1, Result2) 无法测试，所以只测试了循环不报错。

调用方式：
Call RVALUE("Z_Value")
属性名是字符串类型。

#3

风吹过b2015-05-27 16:46

如果你 RecNum 是动态的，也可以使用动态数组的方式进行
Public Outstatus() As New Class1

使用前，
redim Outstatus(RecNum)

#4

donholy2015-05-28 08:15

十分感谢版主！这段程序近20年前设计的，有近百个子模块，现在改成类模块工程太浩大了，所以在寻找不改变自定义变量结构的方法。
版主还有别的办法吗？

#5

wmf20142015-05-28 09:24

如果结构体中各变量是按顺序定义的，可以用一个函数完成，该函数定义为“fun xxx(结构体内变量字符串 as string,结构体变量 as rec，要赋值的变量 as integer) as string，返回的字串即report。

#6

风吹过b2015-05-28 09:29

回4楼
你看到我的代码不？
如果你在运行过程中，不需要重定义数组元素，那就完全就可以直接改成类，就是修改一下定义而以。
或者重定义数组元素大小，但不要求保留数据（保留数据我没测试过，不知道适用于类否）都可以使用这种方式。

原来是使用 type 定义的，
现在使用 Class 来定义而以。

Class 是 TYPE 的升级。
结构：按一定规律组织的数据。
类：按一定规定组织的数据和方法。

#7

lianyicq2015-05-28 10:33

回复楼主 donholy

自定义结构体是有一定的存储规则，结构体中各变量的地址是相对固定的。可以使用VB的内部函数VarPtr得到各变量的地址，再用CopyMemory得到数据。
写了一个简单的例子。

程序代码：

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type student
  BH As Integer
  BW As Integer
  AGE As Integer
End Type

Dim Stu(5) As student

Private Sub Form_Load()
  Dim i As Integer, j As Integer
  Dim test As Integer
  For i = 0 To 5
    Stu(i).BH = Int((160 - 120 + 1) * Rnd + 120)
    Stu(i).BW = Int((60 - 40 + 1) * Rnd + 40)
    Stu(i).AGE = Int((12 - 9 + 1) * Rnd + 9)
  Next

Form1.Caption = Hex(VarPtr(Stu(0))) & Hex(VarPtr(Stu(1)))
Call CopyMemory(ByVal VarPtr(test), ByVal VarPtr(Stu(0).BH), 2)
Text1.Text = test

End Sub

#8

wmf20142015-05-28 10:57

回复 7楼 lianyicq

想法一样。

#9

donholy2015-06-01 13:49

谢谢wmf2014版主和lianyicq版主，这样好像还是不能直接用变量名字符串调用啊？（如用你们例子中的"BH"作为变量）

#10

donholy2015-06-01 13:53

回复 6楼风吹过b

您这个方法应该很好，我会把他作为下一个版本的标准。谢谢您！

我现在暂时在找不改动数据结构方法，怕存储数据读不出来了

#11

lianyicq2015-06-01 14:08

回复 9楼 donholy

当然不直接用变量名来操作数据，通过相对地址来操作。是不是有点象C的指针。

#12

donholy2015-06-01 14:10

回复 6楼风吹过b

直接用出错。数组问题不好解决

只有本站会员才能查看附件，请登录

#13

donholy2015-06-01 14:22

回复 11楼 lianyicq

这样就不是我们需要解决的问题了

#14

风吹过b2015-06-01 16:25

回复 12楼 donholy

所以要引入全局的模块
在全局模块里写过程，所以有些过程也必须放到全局模块中写成全局的过程。

这点是很烦的。限制有点多，比结构要多一点。

#15

lianyicq2015-06-01 16:25

回复 13楼 donholy

没有正确理解,再给你写了一例.多琢磨

程序代码：

Option Explicit
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Type StuSub
  Chinese As Integer
  Math As Integer
  English As Integer
  Physics As Integer
  Chemistry As Integer
End Type

Dim Stu(5) As StuSub
  Dim FirstAdd As Long
Private Sub Form_Load()

  Dim i As Integer
  FirstAdd = VarPtr(Stu(0))
  For i = 0 To 5
    Stu(i).Chinese = Int((150 - 70 + 1) * Rnd + 70)
    Stu(i).Math = Int((150 - 70 + 1) * Rnd + 70)
    Stu(i).English = Int((100 - 40 + 1) * Rnd + 40)
    Stu(i).Physics = Int((100 - 50 + 1) * Rnd + 50)
    Stu(i).Chemistry = Int((100 - 50 + 1) * Rnd + 50)
  Next
Calculate

End Sub

Sub Calculate()
  Dim temp As Integer
  Dim i As Integer, j As Integer
  Dim output(4) As Integer
  For j = 0 To 4
    For i = 0 To 50 Step 10
      Call CopyMemory(ByVal VarPtr(temp), ByVal FirstAdd + i + 2 * j, 2)
      output(j) = output(j) + temp
    Next
  Next
  For i = 0 To 4
    Text1.Text = Text1.Text & output(i) & vbCrLf
  Next
End Sub

#16

风吹过b2015-06-01 17:56

15楼的代码。
一个结构的数据，在内存里就是顺序保存的。
如果你知道各个结构占用的内存长度（i = 0 To 50 Step 10），也知道首地址（FirstAdd = VarPtr(Stu(0))）
也知道每个字段占用内存长度（2），那就计算出具体字段所在的地址。
就可以把这个地址的内存复制出来。

按照你的代码，然后重写了函数，供楼主参考，要求很严格的。

程序代码：

Option Explicit

'要求最好各个字段的数据是一样的，这里定义的是 long ，占4字节。一共是26个字段。
'如果每个字段占用的内存长度不一样，要么有函数计算到某个字段的长度，要么手动计算好长度后保存到一个数组中
'顺序一定不能错。
Private Type OutStatustype
    A_Value As Long
    B_Value As Long
    C_Value As Long
    D_Value As Long
    E_Value As Long
    F_Value As Long
    G_Value As Long
    H_Value As Long
    I_Value As Long
    J_Value As Long
    K_Value As Long
    L_Value As Long
    M_Value As Long
    N_Value As Long
    O_Value As Long
    P_Value As Long
    Q_Value As Long
    R_Value As Long
    S_Value As Long
    T_Value As Long
    U_Value As Long
    V_Value As Long
    W_Value As Long
    X_Value As Long
    Y_Value As Long
    Z_Value As Long
End Type
Private Const OutStatuslen = 4      '每个字段的长度,long=4 ,Integer=2

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Private Const RecNum = 10                       '数据个数，可以为变量，这个示例就使用的常量
Private Outstatus(RecNum) As OutStatustype

Private Sub Command1_Click()
'示例
Dim k(RecNum) As Long

'调用，第一个是需要取的字段的第一个字母，代表在结构体中的顺序号，第二个是保存数据的数组
Call TestAll("B", k)

'显示取得的数据以及相临的数据
Dim i As Long
Cls
For i = 0 To RecNum
    Print k(i), Outstatus(i).A_Value, Outstatus(i).B_Value, Outstatus(i).C_Value
Next i

End Sub

Private Sub Form_Load()
Dim i As Long

'示例，初始化数据
For i = 0 To RecNum
    With Outstatus(i)
        .A_Value = Rnd() * 10000
        .B_Value = Rnd() * 10000
        .C_Value = Rnd() * 10000
        .D_Value = Rnd() * 10000
        .E_Value = Rnd() * 10000
        .F_Value = Rnd() * 10000
        .G_Value = Rnd() * 10000
        .H_Value = Rnd() * 10000
        .I_Value = Rnd() * 10000
        .J_Value = Rnd() * 10000
        .K_Value = Rnd() * 10000
        .L_Value = Rnd() * 10000
        .M_Value = Rnd() * 10000
        .N_Value = Rnd() * 10000
        .O_Value = Rnd() * 10000
        .P_Value = Rnd() * 10000
        .Q_Value = Rnd() * 10000
        .R_Value = Rnd() * 10000
        .S_Value = Rnd() * 10000
        .T_Value = Rnd() * 10000
        .U_Value = Rnd() * 10000
        .V_Value = Rnd() * 10000
        .W_Value = Rnd() * 10000
        .X_Value = Rnd() * 10000
        .Y_Value = Rnd() * 10000
        .Z_Value = Rnd() * 10000
    End With
Next i

End Sub

Private Sub TestAll(cs As String, data() As Long)
'字段名参数仅使用第一个字母。data 为接收数据的数组，VB默认是按地址传递，所以可以用数组把修改后的数据传递出去。
Dim a_start As Long, a_len As Long, address As Long
Dim i As Long
address = VarPtr(Outstatus(0).A_Value)              '首地址
a_start = (Asc(UCase(Left(cs, 1))) - 65) * OutStatuslen        '计算成，A＝0，B＝1 .. 的地址偏移
'a_len = 26 * OutStatuslen                           '每元素总长度
a_len = Len(Outstatus(0))                           '这是另一种取长度的方法，这种更精确

For i = 0 To RecNum
    Call CopyMemory(ByVal VarPtr(data(i)), ByVal address + i * a_len + a_start , OutStatuslen)       '把指定地址和数据复制到指定地址去
    'byval 传值 ,Varprt 取地址
Next i

End Sub

#17

风吹过b2015-06-01 18:03

Call CopyMemory(ByVal VarPtr(data(i)), ByVal address + i * a_len + a_start, OutStatuslen) '把指定地址和数据复制到指定地址去
可以简化成：
Call CopyMemory(data(i), ByVal address + i * a_len + a_start, OutStatuslen) '把指定地址和数据复制到指定地址去

因为 VB默认是传址操作，在这个函数里，第一个我们需要的是地址，第二个需要的是值，所以第二个需要显式指出是传值。
第一个，如果我们取了地址，那也就要显式指出传值，没取地址，就可以使用默认的传地址。

#18

donholy2015-06-02 03:37

谢谢各位版主，现在明白原系统为什么那样编了——简单直观易于理解，虽然让人感觉过多重复。

尤其谢谢风吹过b，让我学到更多。