Aliasing in VB6

[Elroy]

I'm really just sort of brainstorming here, but I'm at a point for the second time in my little project where I wouldn't mind some aliasing in VB6.

(Sure, I know I could wrap things in classes, and just use additional references, but that's not how I'm set up.)

Here's what I've got. Basically, I've got a complex UDT with several dynamic arrays as sub-elements. There are certain places where a series of option buttons specify which sub-element-array I'm working on.

(Yeah, I could set things up as an option button control array, and use the control indexes too (maybe even defining an enumeration that outlines the indexes), but I'm just not set up that way either.)

Rather than have to set up Select Case statements for several things that may change one of these sub-element-arrays, I'm thinking of doing some temporary aliasing (and doing it anytime the option buttons are clicked).

To do this, I'd just use a bit of GetMem4 and VarPtr. I'd also save the original VarPtr for the temp-alias-variable, and be sure and put it back when it went out of scope. Also, the complex-UDT is in a BAS module and completely global, so no fear of it going out of scope.

Basically, in other words, I want to alias a dynamic array. For the immediate situation, I know it'll be dimensioned.

------

I'll be sure and work out an example before I actually start doing it.

However, I'm just wondering if there are any potholes I'm overlooking.

Thanks,
Elroy

[xiaoyao]

try this sample:http://www.vbforums.com/showthread.p...red-variables)

[xiaoyao]

dim a()
dim bb as new Dictionary
bb.add "v_a",a()

[Elroy]

try this sample:http://www.vbforums.com/showthread.p...red-variables)

Hi xiaoyao,

Thanks for the read, but I'm not really interested in any multi-threading, and/or all the marshaling that comes with "sharing" data. Also, this is a portable (single EXE, no installation) project.

What I want is more a matter of "code convenience" than anything else. Once one of my option buttons is selected, there are several changes that might be made to a specific array within my UDT. I just want a "quick" way to make the changes to the specific array (the one specified by the selected option button).

There are several ways to skin this cat ... but I just like the way I've got my code organized. My UDT is 17 well-named dynamic arrays, and I'd like to keep it that way. I'd just like to take any one of those though, and alias it into a "common" variable for purposes of editing.

(One might suggest copying the specified array, making changes, and then put it back once the changes are done. However, there's lots of DirectX going on in this project, and I'd like all the changes to be dynamic on the DirectX viewport. I can re-render whenever changes are made. That's the easy part.)

[The trick]

Im not sure if i understand correctly but what's about Variant?
Like that:

Option Explicit

Private Type tArr
    a() As Long
    b() As Currency
End Type

Private Sub Form_Load()
    Dim v As tArr
    
    ReDim v.a(10)
    ReDim v.b(5)
    
    DoSmth v.a
    DoSmth v.b
    
End Sub

Private Sub DoSmth( _
            ByRef v As Variant)
                
    v(0) = 1
    v(1) = 2
                
End Sub

[Elroy]

Hi Trick,

Yeah, I know I can alias a global (or module) variable by passing it as local (variant or not). But that doesn't quite get at what I'm trying to do either.

To simplify, I've got a BAS project wide UDT global, and I'd like to alias a piece of it (temporarily) in a FRM module-level variable. There's no way to pass the piece into the FRM module and then get it into a module-level variable without copying it (well, without some GetMem4 tricks). It's got to be aliased (not copied) because I'll be modifying it with sliders, and simultaneously rendering those changes (and the rendering goes back to the module-level UDT).

And I'd rather not get into a lot of copying back and forth. I'll do several Select Case statements before I do that.

Thanks Though,
Elroy

[qvb6]

I don't think I fully understood your request(an example would help), but in similar situations, I have done things like this:

1 - Learn to use Excel/LibreOffice as a quick code builder. I know Select Case isn't your favorite. In the first column I put enum or variables, and in the second column I do this:

="Case """ & MID(A1, 4, 100) & """: udt" & MID(A1, 4, 100) & "(1) = Iif(opt" & MID(A1, 4, 100) & ".Value <> 0, 5, 4)"

If the value in the first column was enmTest, then the above yields:

Case "Test": udtTest(1) = Iif(optTest.Value <> 0, 5, 4)

Copying and pasting the formula above generates the code for me based on what I enter in column A, so I only do one line.

2 - Write 17 functions that make changes to the 17 dynamic arrays, and call these instead.

[Eduardo-]

Another option I think it could be to put the arrays into a class object (it must be the same class type for all the arrays that need to be "aliased") and then to set the proper reference to that class instance containing the desired array to work with.

[The trick]

Still im not sure if i understand correclty:

Private Type tArr
    a() As Long
    b() As Currency
End Type

Private Declare Sub VariantCopy Lib "oleaut32" (ByRef pvargDest As Variant, ByRef pvargSrc As Variant)

Dim m_vAlias As Variant

Private Sub Form_Load()
    Dim v As tArr
    
    ReDim v.a(10)
    ReDim v.b(5)
    
    MakeAlias v.a
    
    m_vAlias(1) = 1
    m_vAlias(2) = 2
    
    MakeAlias v.b

    m_vAlias(1) = 7
    m_vAlias(2) = 8
    
End Sub

Private Sub MakeAlias( _
            ByRef v As Variant)
    VariantCopy m_vAlias, v
End Sub

Just you need to track if variable is out of scope.

[Elroy]

@Eduardo: Yeah, I know I could "fix" it by using classes. I was just looking for a simpler solution. This project is already rather involved, and I was just trying to keep this section simple.

@qvb6: Yeah, I know I could write 17 functions (or, as I stated it, have a large Select Case statement for my option buttons, each time something else changed my array).

@Trick: Yeah, I need to study what you just posted.

-------

But, here, I worked out a little example of the concept I'm thinking about. I'd just like to know if there's some pitfall I'm overlooking:

Here's a BAS module:

Option Explicit

Public Type MyUdtType
    a1() As Long
    a2() As Long
    a3() As Long
End Type

Public MyUdt As MyUdtType

Private Sub Main()
    ReDim MyUdt.a1(5)
    ReDim MyUdt.a2(5)
    ReDim MyUdt.a3(5)

    Dim i As Long
    For i = 0 To 5
        MyUdt.a1(i) = i
        MyUdt.a2(i) = i * 10
        MyUdt.a3(i) = i * 20
    Next

    Form1.Show

End Sub

And here's code for a form (Form1):

Option Explicit

Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (a() As Any) As Long

Dim iOrigVarPtr As Long
Dim aTemp()     As Long         ' <---- THIS is what the slider will always operate on, the ALIAS.

Private Sub Form_Load()
    GetMem4 ByVal ArrPtr(aTemp), iOrigVarPtr


    AliasTheGlobal

End Sub

Private Sub Form_Unload(Cancel As Integer)
    GetMem4 iOrigVarPtr, ByVal ArrPtr(aTemp)        ' ABSOLUTELY essential to not crash.
End Sub

Private Sub AliasTheGlobal()
    Select Case True
    Case Option1.Value: GetMem4 ByVal ArrPtr(MyUdt.a1), ByVal ArrPtr(aTemp)
    Case Option2.Value: GetMem4 ByVal ArrPtr(MyUdt.a2), ByVal ArrPtr(aTemp)
    Case Option3.Value: GetMem4 ByVal ArrPtr(MyUdt.a3), ByVal ArrPtr(aTemp)
    End Select
End Sub


Private Function IsTempDimmed() As Boolean
    On Error Resume Next
        If UBound(aTemp) >= LBound(aTemp) Then IsTempDimmed = True
    On Error GoTo 0
End Function

Private Sub Option1_Click()
    AliasTheGlobal
End Sub

Private Sub Option2_Click()
    AliasTheGlobal
End Sub

Private Sub Option3_Click()
    AliasTheGlobal
End Sub

Private Sub Slider1_Click()
    Dim i As Long
    If IsTempDimmed Then
        For i = LBound(aTemp) To UBound(aTemp)
            aTemp(i) = aTemp(i) + Slider1.Value
        Next

        Debug.Print MyUdt.a1(0), MyUdt.a2(0), MyUdt.a3(0)   ' <--- Just to examine the concept.  Notice it's NOT the temp variable.

    End If
End Sub

Private Sub Slider1_Scroll()
    Slider1_Click
End Sub

And here's a picture of the form:



And the whole demo is attached. Be SURE to notice the Debug.Print statement and how it's referencing the ORIGINAL arrays.

If nobody sees any problems with this, that's what I'd like to do.

EDIT1: I know that, when it's simplified like this, it looks obvious that there are other solutions. However, this is a complex project, and I'm just trying to avoid yet another layer of abstraction. If this will reliably work, it will simplify things for me.

[qvb6]

I think the OP means to alias a dynamic array to a different variable? Maybe like reseating a Byte array to point at a Bitmap buffer, so changes can be done quickly? One possible example:

Public Type MainUDT
    ArrayA() As Byte
    ArrayB() As Byte
    ArrayC() As Byte
End Type
 
Public g_MainUDT As MainUDT
 
Private MyArray() As Byte ' 2 Dimensions
 
ReDim MyArray(1 To 3, 1 To 1000000) ' 1 To 3 translates to A, B, C arrays in MainUDT
 
MyArray(2, 5) = 9 ' Should be same as g_MainUDT.ArrayB(5) = 9

That's my understanding.

[The trick]

Elroy, if you have all the arrays with the same type you can just map your aTemp array like here (in this case you couldn't keep tracking to pointer):

Option Explicit

Private Const FADF_AUTO As Long = 1

Private Type SAFEARRAYBOUND
    cElements   As Long
    lLbound     As Long
End Type

Private Type SAFEARRAY
    cDims       As Integer
    fFeatures   As Integer
    cbElements  As Long
    cLocks      As Long
    pvData      As Long
    Bounds      As SAFEARRAYBOUND
End Type

Private Declare Sub MoveArray Lib "msvbvm60" _
                    Alias "__vbaAryMove" ( _
                    ByRef Destination() As Any, _
                    ByRef Source As Any)
                    
Private Declare Function GetMem4 Lib "msvbvm60" (ByRef Source As Any, ByRef Dest As Any) As Long ' Always ignore the returned value, it's useless.
Private Declare Function ArrPtr Lib "msvbvm60" Alias "VarPtr" (a() As Any) As Long

Dim iOrigVarPtr As Long
Dim aTemp()     As Long         ' <---- THIS is what the slider will always operate on.
Dim tDesk       As SAFEARRAY
Dim pDesk       As Long

Private Sub Form_Load()
    
    tDesk.cDims = 1
    tDesk.cbElements = 4
    tDesk.fFeatures = FADF_AUTO
    pDesk = VarPtr(tDesk)
    MoveArray aTemp, pDesk
    
    AliasTheGlobal
    
End Sub

Private Sub AliasTheGlobal()

    Select Case True
    Case Option1.Value:
        tDesk.pvData = VarPtr(MyUdt.a1(0))
        tDesk.Bounds.cElements = UBound(MyUdt.a1) + 1
    Case Option2.Value
        tDesk.pvData = VarPtr(MyUdt.a2(0))
        tDesk.Bounds.cElements = UBound(MyUdt.a2) + 1
    Case Option3.Value
        tDesk.pvData = VarPtr(MyUdt.a3(0))
        tDesk.Bounds.cElements = UBound(MyUdt.a3) + 1
    End Select

End Sub


Private Function IsTempDimmed() As Boolean
    On Error Resume Next
        If UBound(aTemp) >= LBound(aTemp) Then IsTempDimmed = True
    On Error GoTo 0
End Function

Private Sub Option1_Click()
    AliasTheGlobal
End Sub

Private Sub Option2_Click()
    AliasTheGlobal
End Sub

Private Sub Option3_Click()
    AliasTheGlobal
End Sub

Private Sub Slider1_Click()
    Dim i As Long
    If IsTempDimmed Then
        For i = LBound(aTemp) To UBound(aTemp)
            aTemp(i) = aTemp(i) + Slider1.Value
        Next
    
        Debug.Print MyUdt.a1(0), MyUdt.a2(0), MyUdt.a3(0)   ' <--- Just to examine the concept.  Notice it's NOT the temp variable.
    
    End If
End Sub

Private Sub Slider1_Scroll()
    Slider1_Click
End Sub

[Elroy]

Hi Trick,

YES! That looks better (and safer) than what I was doing. I'm not 100% on top of all the SafeArray stuff, so let me just ask...

That FADF_AUTO is what's keeping the global array safe? That's why we don't have to worry about doing anything in Form_Unload, when our aTemp() falls out of scope?

Thank You,
Elroy

[xiaoyao]

Hi xiaoyao,

Thanks for the read, but I'm not really interested in any multi-threading, and/or all the marshaling that comes with "sharing" data. Also, this is a portable (single EXE, no installation) project.

What I want is more a matter of "code convenience" than anything else. Once one of my option buttons is selected, there are several changes that might be made to a specific array within my UDT. I just want a "quick" way to make the changes to the specific array (the one specified by the selected option button).

There are several ways to skin this cat ... but I just like the way I've got my code organized. My UDT is 17 well-named dynamic arrays, and I'd like to keep it that way. I'd just like to take any one of those though, and alias it into a "common" variable for purposes of editing.

(One might suggest copying the specified array, making changes, and then put it back once the changes are done. However, there's lots of DirectX going on in this project, and I'd like all the changes to be dynamic on the DirectX viewport. I can re-render whenever changes are made. That's the easy part.)

create 17 multi-threading for single EXE, I think this is the best approach.

Each array has a dedicated thread management, plus 17 signals, the data automatically stops after processing

Process synchronization --- semaphore mechanism A very effective process synchronization mechanism. 1. Integer semaphore Integer ... How to make the program not work in VB? Forum Questions about WaitForSingleObject semaphore ...
chinese:进程同步---信号量机制 一种非常有效的进程同步机制。1.整型信号量 整型信... 在VB中怎么让程序不工作空等待。 论坛 关于WaitForSingleObject信号量的问题...

[xiaoyao]

use WaitForSingleObjectl wait in every thread,or MsgWaitForMultipleObjects in The 18th thread for manger all thread。

hEvent = CreateEvent(ByVal 0, ByVal 1, ByVal 0, ByVal 0)  'Default security, Manual Reset, Initially Not-signalled, no Name
 End Sub
Sub PauseEvent(ByVal WaitMilliseconds As Long)
ResetEvent hEvent
TimerHandle = timeSetEvent(WaitMilliseconds, 0&, hEvent, ByVal 0&, ByVal (TIME_PERIODIC Or TIME_CALLBACK_EVENT_SET))
      Do While MsgWaitForMultipleObjects(1&, hEvent, FAL_SE, INFINITE, QS_ALLINPUT)
          DoEvents
      Loop

SetEvent(hEvent1)
SetEvent(hEvent17)
https://blog.csdn.net/silencenet/art...etails/6057227

[xiaoyao]

YOU CAN USE this code:

Public Type Long2
    Value() As Long
End Type
Public Type MyUdtType
    A() As Long2
End Type

ReDim MyUdt.A(1 To 3)
ReDim MyUdt.A(1).Value(5)
ReDim MyUdt.A(2).Value(5)
ReDim MyUdt.A(3).Value(5)

    Dim i As Long
    For i = 0 To 5
        MyUdt.A(1).Value(i) = i
        MyUdt.A(2).Value(i) = i * 10
        MyUdt.A(3).Value(i) = i * 20
    Next

[Arnoutdv]

@xiaoyao, not every programming solution requires threading, so stop hammering about using multi threading