Has anyone used VB.NET to get face recognition data from a Dahua NVR using VB.NET?
I am facing two problems that I just can't figure out.
I can connect to the NVR and set up a callback for video using
bDeviceInitialized = CLIENT_Init(AddressOf DeviceDisconnected, 0)
Dim lSDKVersion As Long
lSDKVersion = CLIENT_GetSDKVersion()
console.writeline( "SDK: " + lSDKVersion.ToString.Substring(0, 1) + "." + lSDKVersion.ToString.Substring(1, 2) + " " + lSDKVersion.ToString.Substring(3) )
fAnalyzer = AddressOf AnalyzerDataCallBack
'Set reconnect callback
CLIENT_SetAutoReconnect(AddressOf DeviceReconnected, 0)
' Set device connection timeout And trial times.
' Optional operation
Dim nWaitTime As Integer = 5000 ' Timeout Is 5 seconds.
Dim nTryTimes As Integer = 3 ' If timeout, it will try to log in three times.
CLIENT_SetConnectTime(nWaitTime, nTryTimes)
'A wait is required
System.Threading.Thread.Sleep(1000)
netInLoginWithHighLevelSecurity.dwSize = Marshal.SizeOf(netInLoginWithHighLevelSecurity)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DeviceIP), netInLoginWithHighLevelSecurity.szIP, My.Settings.DeviceIP.Length)
netInLoginWithHighLevelSecurity.nPort = CInt(My.Settings.DevicePort)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DeviceUserId), netInLoginWithHighLevelSecurity.szUserName, My.Settings.DeviceUserId.Length)
Array.Copy(System.Text.Encoding.Default.GetBytes(My.Settings.DevicePassword), netInLoginWithHighLevelSecurity.szPassword, My.Settings.DevicePassword.Length)
netInLoginWithHighLevelSecurity.emSpecCap = EM_LOGIN_SPAC_CAP_TYPE.EM_LOGIN_SPEC_CAP_TCP
netOutLoginWithHighLevelSecurity.stuDeviceInfo = devInfo
netOutLoginWithHighLevelSecurity.dwSize = Marshal.SizeOf(netOutLoginWithHighLevelSecurity)
'Create a pointer for the structure
'pNetOutLoginWithHighLevelSecurity = Marshal.AllocHGlobal(Marshal.SizeOf(netOutLoginWithHighLevelSecurity))
hLoginId = CLIENT_LoginWithHighLevelSecurity(netInLoginWithHighLevelSecurity, netOutLoginWithHighLevelSecurity)
' Get the serial number of the NVR
Dim i As Integer = 0
Dim strSerial As String = ""
While i < 64 And netOutLoginWithHighLevelSecurity.stuDeviceInfo.sSerialNumber(i) <> 0
strSerial &= Chr(netOutLoginWithHighLevelSecurity.stuDeviceInfo.sSerialNumber(i))
i += 1
End While
' Enable cameras
Dim dwUser As Int64 = 0
Dim oReserved As IntPtr = 0
Dim nChannel As Int16 =0
Dim iNeedPicture As Int32 = 1
' pbChannel1 is a PictureBox
lMonitorChannel(nChannel) = CLIENT_RealPlayEx(hLoginId, nChannel, pbChannel1.Handle, EM_REAL_PLAY_TYPE.EM_REAL_PLAY_REALPLAY)
lAlarmFaceDetection(nChannel) = CLIENT_RealLoadPictureEx(hLoginId, nChannel, EVENT_IVS_ALL, iNeedPicture, fAnalyzer, Nothing, Nothing)
This works fine and I can see the video from channel 1.
The problems are in the analyzer callback which is defined as
Public Delegate Sub AnalyzerDataCallBackDelegate(lAnalyzerHandle As Int64, dwAlarmType As UInt32, AlarmInfo As IntPtr, pBuffer As IntPtr, dwBufferSize As UInt32, dwUser As Int64, nSequence As Int16, Reserved As IntPtr)
Public Shared Sub AnalyzerDataCallBack(ByVal lAnalyzerHandle As Int64, ByVal dwAlarmType As Int32, ByVal AlarmInfo As IntPtr,
ByVal pBuffer As IntPtr, ByVal dwBufferSize As Int32, ByVal dwUser As Int64, ByVal nSequence As Int16,
ByVal Reserved As IntPtr)
Firstly, I am not getting any event other than motion detect and face recognition, even though I subscribed to EVENT_IVS_ALL.
Secondly, I am not getting complete face recognition information.
I copied from the unmanaged buffer into a (complex) structure.
structFaceRecognitionInfo = CType(Marshal.PtrToStructure(AlarmInfo, GetType(DEV_EVENT_FACERECOGNITION_INFO)), DEV_EVENT_FACERECOGNITION_INFO)
But I don't get complete information. Only the first few elements are filled with the rest have garbage or zeros.
I tried copying the buffer into a byte array to inspect the data during debug and see that it is indeed filled with zeros.
Dim lenBuffer As Int32 = Marshal.SizeOf(Of DEV_EVENT_FACERECOGNITION_INFO)
ReDim bData(lenBuffer)
Dim gchBuffer As GCHandle = GCHandle.Alloc(bData, GCHandleType.Pinned)
Marshal.Copy(AlarmInfo, bData, 0, lenBuffer)
gchBuffer.Free()
I've been stuck at this point for a week.
In my array processing intensive code, the rate of processing items slows dramatically after around 12,000 items with 48,000 operating at <50% of the speed.
The code undertakes maths on the array items and repeats that maths say 1000 times. At 12,000 items in the array I can process at a rate of 40,000 per second at 48,000 items in the array I can only process at a rate of 15,000 per second.
The code reads the contents of an Excel sheet then hands off to a DLL file with all the arrays passed to the DLL, which then processes them and hands the adjusted arrays back to Excel. Once running the DLL code, there is no interfacing with Excel. No "objects" (as in an Excel object) are created inside the VB.Net.
This was VBA code that I've transferred to VB.Net (first time using it) so bound to be something dumb I haven't realised.
Just to confuse matters...
In the Net code you'll see I've used % for integer values, which I changed from the original &, as 32-bit versions of Excel threw errors in passing their & types to the DLL which was written on a 64-bit platform, if that makes sense. Aware of the change in data types from VBA to VB.Net, that is & in vba is I think the same as % in VB.Net.
Advanced apology....
I am an amateur coder and this is a project which went from a 'could I?' project and grew and grew. It does work and is fast, I just noticed this performance drop off.
Tried switching off the calling of the ANNIE_TEST function which occurs every 50 iterations through the main loop. Makes no difference in performance.
Tried changing arrays to ByVal instead of ByRef, even though I read VB.Net ignores that for arrays - no difference.
Wondering if this is garbage collection (not that I really understand that) or perhaps the use of % integers instead of & integers.
<ComClass(clsAnnie.ClassId, clsAnnie.InterfaceId, clsAnnie.EventsId)>
Public Class clsAnnie
Public Const ClassId As String = "00E45698-E5C1-4F2C-8828-3F7404EF83A2"
Public Const InterfaceId As String = "2A1D9402-78DA-41F0-8DE3-1CD573AAF72C"
Public Const EventsId As String = "346E24CC-C9E1-4915-B254-BA80E6E310C4"
Public Sub New()
MyBase.New
End Sub
'This routine is called repeatedly from the entry point
'sub-routine Public Sub Train_NNT
Private Sub Calculate_NNT(ByVal Num_Layers%, ByVal Pattern%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByRef Hidden_Neuron_Value As Double(,,), ByRef Prediction_Output As Double(,), ByRef Pattern_Error As Double(), ByRef Training_Input As Double(,), ByRef Training_Output As Double(), ByRef Input_Weights As Double(,), ByRef Output_Weights As Double(,), ByRef Inter_Weights As Double(,,), ByVal drop_out As Boolean, ByRef doi As Integer(), ByRef dol As Integer(,), ByVal activation_function%)
On Error GoTo exity
Dim alldropped As Boolean, n#, a#, c#, m%, s%, Lay%, i%, j%
'The main code is removed to keep the post short, but all it does is mathematically
'loop through the arrays and undertake maths on the values before updating one
'particular array (Training_Output) and passing that back to the main routine.
'None of the other arrays or variables have their values changed.
'Last few lines as follows for context as follows....
Prediction_Output(Pattern%, 1) = 0
For m% = 1 To Num_Hidden% : Prediction_Output(Pattern%, 1) = Prediction_Output(Pattern%, 1) + (Hidden_Neuron_Value(Pattern%, Num_Layers%, m%) * Output_Weights(m%, 1)) : Next
Pattern_Error(Pattern%) = Prediction_Output(Pattern%, 1) - Training_Output(Pattern%)
exity:
End Sub
'This is the main routine that is called from Excel VBA. It's called only once.
Public Sub Train_NNT(ByRef doi As Integer(), ByRef dol As Integer(,), ByRef OF_Array As Double(,), ByRef Cyc%, ByRef Hidden_Neuron_Value As Double(,,), ByRef Pattern_Error As Double(), ByRef Inter_Weights As Double(,,), ByRef Prediction_Output As Double(,), ByRef Training_Input As Double(,), ByRef Training_Output As Double(), ByRef Training_Input_Test As Double(,), ByRef Training_Output_Test As Double(), ByRef Input_Weights As Double(,), ByRef Output_Weights As Double(,), ByVal activation_function%, ByVal Num_Patterns%, ByVal Cycles%, ByVal Num_Layers%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByVal Num_Patterns_Test%, ByVal Learn_Rate#, ByVal Maximum_Data_Value As Double, ByVal Minimum_Data_Value As Double, ByVal DOLLR As Boolean, ByVal Overfitting_CF As Boolean, ByVal Lregression As Boolean, ByVal cosine_annealing As Boolean, ByVal ADAMW As Boolean, ByVal Nesterov As Boolean, ByVal drop_out As Boolean, ByVal random_sampling As Boolean, ByVal animations As Boolean)
On Error GoTo exit_train
'These declarations shown in case it's something to do with garbage collection?
Dim Min_CET#, Best_Error#, Best_Error_Test#, Current_Error#, Current_Error_Test#, Learn_Rate_Original#, Learn_Rate_Min#, Learn_Mult#, Learn_Rate_Const#, lamda#
Dim beta_1#, beta_1_1#, beta_2#, beta_2_2#, mom_1#, mom_2#, mom_3#, damp#, cos_tmp#, beta_1_2#, tmp#, n#, P_Pat_Error#, Learn_Rate_Inv#, beta_sqr#, epsilon#
Dim Pat_Error#, Pat_Error_M#, tmp_5#, dw#, derivative#, tmp_1#, MaDV#, MiDV#
Dim Picture_Count As Integer, Picture_VE As Integer
Dim error_counter%, Snaps%, Pattern%, i%, s%, m%, o%, Pat_Test%, Pat%, q%, Lay%, j%
Dim Error_Array(0 To 100) As Double, HNV(0 To Num_Layers%, 0 To Num_Hidden%) As Double, neuron_error(0 To Num_Layers%, 0 To Num_Hidden%) As Double
Dim vdw_o() As Double, sdw_o() As Double, vdw_i() As Double, sdw_i() As Double, Output_Momentum() As Double, Input_Momentum(,) As Double, Inter_Momentum(,,) As Double
ReDim vdw_o(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), sdw_o(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), vdw_i(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2)), sdw_i(0 To (Num_Hidden% + 1) * (Num_Inputs% + Num_Layers% + 2))
ReDim Output_Momentum(0 To Num_Hidden%), Input_Momentum(0 To (Num_Inputs% + 1), 0 To Num_Hidden%), Inter_Momentum(0 To Num_Layers%, 0 To Num_Hidden%, 0 To Num_Hidden%)
'Here we enter a loop which processes the arrays
For Cyc% = 1 To Cycles%
'Code removed here as just altering some variables and performing maths on them.
'I call the routine above...
Call Calculate_NNT(Num_Layers%, Pattern%, Num_Hidden%, Num_Inputs%, Hidden_Neuron_Value, Prediction_Output, Pattern_Error, Training_Input, Training_Output, Input_Weights, Output_Weights, Inter_Weights, drop_out, doi, dol, activation_function%)
'Lot of code removed, uses the answer from the routine above to process and alter
'a number of arrays. The array passed back (or is used) is
'Training_Output
'Every 50 cycles I need to call a function called ANNIE_TEST
'which independently verifies whether the maths hasn't exceeded
'certain thresholds, which if it has then stops the whole process
'and hands back to Excel.
'Code below just for context
If Cyc% Mod 50 = 0 Then
If Overfitting_CF Then
Current_Error_Test# = 0
For Pat_Test% = 1 To Num_Patterns_Test% : Current_Error_Test# = Current_Error_Test# + (ANNIE_TEST(Pat_Test%, Num_Hidden%, Num_Inputs%, Num_Layers%, activation_function%, Output_Weights, Inter_Weights, Training_Input_Test, Input_Weights, HNV) - Training_Output_Test(Pat_Test%)) ^ 2 : Next
Current_Error_Test# = Math.Sqrt(Current_Error_Test# / Num_Patterns_Test%)
OF_Array(q%, 1) = Cyc% : OF_Array(q%, 2) = Current_Error_Test# : q% = q% + 1
Min_CET# = 0
For o% = 1 To error_counter% : Min_CET# = Min_CET# + Error_Array(o%) : Next
Min_CET# = Min_CET# / error_counter%
If Current_Error_Test# <= Min_CET# Then
For o% = error_counter% To 2 Step -1 : Error_Array(o%) = Error_Array(o% - 1) : Next
Error_Array(1) = Current_Error_Test#
Else
Exit For
End If
End If
End If
Next 'cycles
exit_train:
End Sub
Private Function ANNIE_TEST(ByVal Pat_Test%, ByVal Num_Hidden%, ByVal Num_Inputs%, ByVal Num_Layers%, ByVal activation_function%, ByRef Output_Weights As Double(,), ByRef Inter_Weights As Double(,,), ByRef Training_Input_Test As Double(,), ByRef Input_Weights As Double(,), ByRef HNV As Double(,))
Dim m%, j%, s%, Lay%
Dim a#, c#, n#, prediction#
'Code removed as it just loops through arrays and undertakes maths on them.
'None of the arrays have values altered, just used
prediction# = 0
For j% = 1 To Num_Hidden% : prediction# = prediction# + (HNV(Num_Layers%, j%) * Output_Weights(j%, 1)) : Next
ANNIE_TEST = prediction#
End Function
End Class
OK turns out nothing to do with VB.Net and everything to do with how the arrays were handled after they arrived back in Excel, and it was really dumb. They ended up in a function which needed to load the arrays in, which had a constant so it could tell on a successive run of the function that the arrays had been loaded. I forgot to declare that constant as a public boolean, and therefore Excel just saw "null" instead of true/false.
I want to sincerely thank all of you for helping and especially TnTinMn, for making me think (like I should have done from the start) about where the timings were being taken.
Going from VBA to VB.Net gave a 7 to 10x speed increase, the fix to this has given me a further 7x speed increase on top.
Intro:
I've run into an issue when I tried to position Visio-UserForms relative to the calling Visio application window, as it is possible in other MS Office applications.
Normally I would use calling code like in the first block (Excel) to open a UserForm in a relative position to the application window.
The important properties for this uqestion are .Left and .Top, which return the offset of the window compared to the screen.
If I try the same in Visio (code block 2) I ran into the following Issue:
The application object of a the Visio application (vsApp) does not support the .Top an .Left properties, so obviously I get the standart Run.time error "438": “Object doesn't support this property or method”
Question:
My question is if there is an alternative relatively clean method to get the window position of the calling application (maybe even application-agnostic). When looking around there are a multitude of solutions for Excel, but none for Visio as far as I can tell.
This is my first question here, so please if I submitted something wrong or missed a rule/guideline please let me know.
Code:
In both cases the FooUserForm is a simple UserForm with a single button that hides the form with Me.Hide. The code below resides in a standard module
Code in Excel:
Option Explicit
Sub openFooUserForm()
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
Dim exApp As Excel.Application
Set exApp = ThisWorkbook.Application
fooUF.StartUpPosition = 0
fooUF.Top = exApp.Top + 25
fooUF.Left = exApp.Left + 25
fooUF.Show
Set fooUF = Nothing
End Sub
Code in Visio:
Option Explicit
Sub openFooUserForm()
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
Dim vsApp As Visio.Application
Set vsApp = ThisDocument.Application
fooUF.StartUpPosition = 0
fooUF.Top = vsApp.Top + 25
fooUF.Left = vsApp.Left + 25
fooUF.Show
Set fooUF = Nothing
End Sub
Since I assume to use this in many other project, I created a class containing all the code. The class works in 32-bit for now, mostly because I couldn't find a way to get the 64-bit handle from the Visio Application Object.
The code itself is prepared 64-bit thanks to the use of the LongPtr type. More Info here: https://codekabinett.com/rdumps.php?Lang=2&targetDoc=windows-api-declaration-vba-64-bit
The declarations should work since they were recreated in the 64-bit environment.
The class exposes 13 properties, 12 of these are Window positions and sizes and one is the Handle, this allows the user to target a different window instead of the application. This could be used to position a Userform in relation to a window opened inside the "Main" application.
Office UserForms (for some reason) use Points instead of Pixels to position themselves on the screen, to help with this I also built a conversion into the class.
There are still some things open that I want to change, like adding proper Error Handling and maybe giving the class a default Instance, but for now this is usable.
Resources
http://officeoneonline.com/vba/positioning_using_pixels.html
http://www.vbforums.com/showthread.php?436888-Get-Set-Window-Size-Position
Explanation
What happens in this Module/Class?
The class handles the interaction with the Windows API
It creates a Private Type Rect, which is used by the GetWindowRect function.
It declares the GetWindowRect function, wich takes the window handle of a window (obviously) and returns the position of the "Outline" in pixels
When the object is initialized it automatically stores the window handle of the Application in which it was called in this.Handle
When getting one of the px__ properties it simply updates the window position this.rc and returns the desired value.
When getting on of the pt__ properties it updates the window position and calculates the equivalent in points, this is usefull since VBA Userforms actually use points for positioning. The conversion is described here.
The windows handle can be changed by setting the Handle Property, this provides some more flexibility, for example when a multiple windows of the same application are opened.
Code
aModule (Module)
Sub openFooUserForm()
Dim winPo As WindowPositioner
Set winPo = New WindowPositioner
Dim fooUF As FooUserForm
Set fooUF = New FooUserForm
fooUF.StartUpPosition = 0
fooUF.Top = winPo.ptTop + 100
fooUF.Left = winPo.ptLeft + 50
fooUF.Show
Set fooUF = Nothing
End Sub
WindowPositioner (Class)
Option Explicit
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Private Type TWindowPositioner
Handle As LongPtr
rc As RECT
End Type
Private this As TWindowPositioner
Const LOGPIXELSX = 88
Const LOGPIXELSY = 90
Const TWIPSPERINCH = 1440
Private Declare Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hDC As LongPtr, ByVal nIndex As Long) As Long
Private Sub Class_Initialize()
#If WIN64 THEN
'this.Handle = 'Method to get the 64-bit Handle of the Application Object
#Else
this.Handle = ThisDocument.Application.WindowHandle32
#End If
this.rc.Left = 0
this.rc.Top = 0
this.rc.Right = 0
this.rc.Bottom = 0
End Sub
Public Property Get Handle() As LongPtr
Handle = this.Handle
End Property
Public Property Let Handle(val As LongPtr)
this.Handle = val
End Property
Public Property Get pxTop() As Long
UpdatePosition
pxTop = this.rc.Top
End Property
Public Property Get pxLeft() As Long
UpdatePosition
pxLeft = this.rc.Left
End Property
Public Property Get pxBottom() As Long
UpdatePosition
pxBottom = this.rc.Bottom
End Property
Public Property Get pxRight() As Long
UpdatePosition
pxRight = this.rc.Right
End Property
Public Property Get pxHeight() As Long
UpdatePosition
pxHeight = this.rc.Bottom - this.rc.Top
End Property
Public Property Get pxWidth() As Long
UpdatePosition
pxWidth = this.rc.Left - this.rc.Right
End Property
Public Property Get ptTop() As Long
ptTop = CPxToPtY(pxTop)
End Property
Public Property Get ptLeft() As Long
ptLeft = CPxToPtX(pxLeft)
End Property
Public Property Get ptBottom() As Long
ptBottom = CPxToPtY(pxBottom)
End Property
Public Property Get ptRight() As Long
ptRight = CPxToPtX(pxRight)
End Property
Public Property Get ptHeight() As Long
ptHeight = CPxToPtY(pxBottom) - CPxToPtY(pxTop)
End Property
Public Property Get ptWidth() As Long
ptWidth = CPxToPtX(pxRight) - CPxToPtX(pxLeft)
End Property
Private Sub UpdatePosition()
GetWindowRect this.Handle, this.rc
End Sub
Private Function CPxToPtX(ByRef val As Long) As Long
Dim hDC As LongPtr
Dim RetVal As Long
Dim XPixelsPerInch As Long
hDC = GetDC(0)
XPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSX)
RetVal = ReleaseDC(0, hDC)
CPxToPtX = CLng(val * TWIPSPERINCH / 20 / XPixelsPerInch)
End Function
Private Function CPxToPtY(ByRef val As Long) As Long
Dim hDC As LongPtr
Dim RetVal As Long
Dim YPixelsPerInch As Long
hDC = GetDC(0)
YPixelsPerInch = GetDeviceCaps(hDC, LOGPIXELSY)
RetVal = ReleaseDC(0, hDC)
CPxToPtY = CLng(val * TWIPSPERINCH / 20 / YPixelsPerInch)
End Function
You simply need to use Application.Window.GetWindowRect instead of Application.Top and Application.Left in Visio to get the main window coordinates (for historical reasons - when Visio became part of the Microsoft Office some 20 years ago, this API already existed, and it was different from other office apps you are referring to). Anyways, the subject can be done easier than in the accepted answer:
Set vsApp = ThisDocument.Application
'''' here we go
Dim left As Long, top As Long, width As Long, height As Long
vsApp.Window.GetWindowRect left, top, width, height
fooUF.StartUpPosition = 0
fooUF.Top = top + 25
fooUF.Left = left + 25
Below code contains the fortran77 dll call from vb.net with two-dimensional array and struture. Input Parameters are flg & a_in(,), it calculates some value and in turn it populates the output array in a_pn(,) and a_vOUT(,). There is a addressof callback function used in fortran dll. I wasn't able to fetch the output values to proceed further.
---VB.Net Code with Fortran dll call---
Dim flg As Int32
Dim a_in(,) As Double --- Input array with values
Dim a_PN(,) as Double ----Output array return from Fortran77 DLL (Value calculated from a_in(,) array and returns)
Dim a_vOUT(,) as Double ----Output array return from Fortran77 DLL
Dim a_Flgs(,) as Int32
Dim a_b() as byte
Dim a_string1 As New VB6.FixedLengthString(255)
Public Structure Case_Info
Dim nx() As Double
Dim ny() As Double
Dim tc() As Double
Dim ip(,) As Double
End Structure
W_Ftrn(Flg, a_in(1, 1), a_PN(1, 1),a_vOUT(1, 1), a_Flgs(1, 1), .TC(1), .ip(1, 1),.nx(1), .ny(1), AddressOf CallBack0, AddressOf CallBack1, a_b(1), a_string1.Value, 255)
---Fortran declaration in vb.net--
Public Declare Sub W_Ftrn _
Lib "D:\Proj2\Fortran.DLL" Alias "W_Ftrn" _
(ByRef flg As integer,ByRef a_in As Double, ByRef a_PN As Double, ByRef a_vOUT As Double, ByRef a_Flgs As Int32, _
ByRef constray As Double, ByRef ipn As Double, _
ByRef aGX%, ByRef aGY#, _
ByVal cbaddr0 As long,ByVal cbaddr1 As long,ByRef bPlain As Byte, _
ByVal s1 As String, ByRef L1 As Int32)
My guess is that you are going to have to do your own manual copy-in and copy-out of the array-cells that you want to write to before and after the F77 call. Something like this:
Dim a_in1 As Double
Dim a_PN1 as Double
Dim a_vOUT1 as Double
Dim a_Flgs1 as Int32
Dim a_b1 as byte
Dim nx As Double
Dim ny As Double
Dim tc As Double
Dim ip1 As Double
' copy-in, manually '
a_in1 = a_in(1, 1)
a_PN1 = a_PN(1, 1)
a_vOUT1 = a_vOUT(1, 1)
a_Flgs1 = a_Flgs(1, 1)
tc = .TC(1)
ip1 = .ip(1, 1)
nx = .nx(1)
ny = .ny(1)
a_b1 = a_b(1)
W_Ftrn(Flg, a_in1, a_PN1,a_vOUT1, a_Flgs1, TC, ip1, nx, ny, AddressOf CallBack0, AddressOf CallBack1, a_b1, a_string1.Value, 255)
' copy-out, manually '
a_in(1, 1) = a_in1
a_PN(1, 1) = a_PN1
a_vOUT(1, 1) = a_vOUT1
a_Flgs(1, 1) = a_Flgs1
.TC(1) = tc
.ip(1, 1) = ip1
.nx(1) = nx
.ny(1) = ny
a_b(1) = a_b1