Related
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.
This is the story:
I want to make a vb.NET code from the DiretX 10 C++ code, the function D3DX10CreateDeviceAndSwapChain() works fine with me :
Public Declare Function D3DX10CreateDeviceAndSwapChain Lib "d3dx10_43.dll" _
(ByVal pAdapter As IDXGIAdapter,
ByVal drivertype As D3D10_DRIVER_TYPE,
ByVal software As IntPtr,
ByVal flags As UInteger,
ByRef pswapchaindesc As DXGI_SWAP_CHAIN_DESC,
ByRef ppSwapChain As IntPtr,
ByRef ppDevice As IntPtr) As Integer`
The rest of code is:
Dim swapChainDesc As New DXGI_SWAP_CHAIN_DESC()
swapChainDesc.BufferCount = 1
swapChainDesc.BufferDesc.Width = Me.Width
swapChainDesc.BufferDesc.Height = Me.Height
swapChainDesc.BufferDesc.Format = DXGI_FORMAT.DXGI_FORMAT_R8G8B8A8_UNORM
swapChainDesc.BufferUsage = 1L << (1 + 4)
swapChainDesc.OutputWindow = Me.Handle
swapChainDesc.SampleDesc.Count = 1
swapChainDesc.SampleDesc.Quality = 0
swapChainDesc.Windowed = True
Dim sc As IntPtr
Dim d As IntPtr
D3DX10CreateDeviceAndSwapChain(Nothing,D3D10_DRIVER_TYPE.D3D10_DRIVER_TYPE_HARDWARE,IntPtr.Zero,0,swapChainDesc,sc,d)
and to convert intptr to a valid interface object i use (it works fine):
Dim s As IDXGISwapChain = CType(Marshal.GetTypedObjectForIUnknown(sc, GetType(IDXGISwapChain)), IDXGISwapChain)
Dim device As ID3D10Device = CType(Marshal.GetTypedObjectForIUnknown(d, GetType(ID3D10Device)), ID3D10Device)
Dim surface As ID3D10Texture2D
s.GetBuffer(0, Marshal.GenerateGuidForType(GetType(ID3D10Texture2D)), surface)
until here the code returns success.
Dim rtv As ID3D10RenderTargetView
Dim hresult As Integer = device.CreateRenderTargetView(surface, Nothing, rtv)
surface.Release() ' this works fine
MsgBox(rtv IsNot Nothing)
the question is :
when i change the location (the ranking of the members between them into the interface ID3D10Device), i get either AccessViolationException or
ArgumentException for the line
Dim hresult as ...
why this undefined behaviours?
REMARKS : the interface ID3D10Device contains more than 80 members, i have also change some members locations and they work fine.
I am working in Access 2013 and try to get GetRawInputDeviceList, GetRawInputDeviceInfo, RegisterRawInputDevices and GetRawInputData equivalents for VBA with no success. I have also searched in vain for a procedure, function or module to get a list of connected HID devices to a computer to pick out a barcode scanner. This is the beginning of the third week so I am on my knees begging for assistance. Do any of you all have a module you're willing to share, a link to a website where this is dealt with? Any help is greatly appreciated.
Using the GetRawInputDeviceList API from VBA would be pretty tricky because of the pRawInputDeviceList parameter. Unless you're willing to jump through a ton of hoops to manage your own memory and manually handle the resulting array of RAWINPUTDEVICELIST in raw memory, you'll be better off coming at this from another direction.
Most barcode scanners I've dealt with present themselves to Windows as a keyboard. One possible solution would be to use a WMI query to enumerate attached Win32_Keyboard devices:
Private Sub ShowKeyboardInfo()
Dim WmiServer As Object
Dim ResultSet As Object
Dim Keyboard As Object
Dim Query As String
Query = "SELECT * From Win32_Keyboard"
Set WmiServer = GetObject("winmgmts:root/CIMV2")
Set ResultSet = WmiServer.ExecQuery(Query)
For Each Keyboard In ResultSet
Debug.Print Keyboard.Name & vbTab & _
Keyboard.Description & vbTab & _
Keyboard.DeviceID & vbTab & _
Keyboard.Status
Next Keyboard
End Sub
Note: If it doesn't turn up there, you can enumerate all of the USB devices by querying CIM_USBDevice: Query = "SELECT * From Win32_Keyboard"
EDIT: Per the comments, the above code won't return the handle needed to register to receive raw input events. This should get you started though - the RegisterRawInputDevices and GetRawInputData aspects are beyond the scope of what will easily go in an answer. Take a hack at it, and if you run into any problems post your code in another question.
Declarations:
Private Type RawInputDeviceList
hDevice As Long
dwType As Long
End Type
Private Type RidKeyboardInfo
cbSize As Long
dwType As Long
dwKeyboardMode As Long
dwNumberOfFunctionKeys As Long
dwNumberOfIndicators As Long
dwNumberOfKeysTotal As Long
End Type
Private Enum DeviceType
TypeMouse = 0
TypeKeyboard = 1
TypeHID = 2
End Enum
Private Enum DeviceCommand
DeviceName = &H20000007
DeviceInfo = &H2000000B
PreParseData = &H20000005
End Enum
Private Declare Function GetRawInputDeviceList Lib "user32" ( _
ByVal pRawInputDeviceList As Long, _
ByRef puiNumDevices As Long, _
ByVal cbSize As Long) As Long
Private Declare Function GetRawInputDeviceInfo Lib "user32" Alias "GetRawInputDeviceInfoW" ( _
ByVal hDevice As Long, _
ByVal uiCommand As Long, _
ByVal pData As Long, _
ByRef pcbSize As Long) As Long
Private Declare Function GetLastError Lib "kernel32" () As Long
Sample of retrieving device names with GetRawInputDeviceInfo:
Private Sub SampleCode()
Dim devices() As RawInputDeviceList
devices = GetRawInputDevices
Dim i As Long
For i = 0 To UBound(devices)
'Inspect the type - only looking for a keyboard.
If devices(i).dwType = TypeKeyboard Then
Dim buffer As String
Dim size As Long
'First call with a null pointer returns the string length in size.
If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, 0&, size) = -1 Then
Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
Else
'Size the string buffer.
buffer = String(size, Chr$(0))
'The second call copies the name into the passed buffer.
If GetRawInputDeviceInfo(devices(i).hDevice, DeviceName, StrPtr(buffer), size) = -1 Then
Debug.Print "GetRawInputDeviceInfo error " & GetLastError()
Else
Debug.Print buffer
End If
End If
End If
Next i
End Sub
Private Function GetRawInputDevices() As RawInputDeviceList()
Dim devs As Long
Dim output() As RawInputDeviceList
'First call with a null pointer returns the number of devices in devs
If GetRawInputDeviceList(0&, devs, LenB(output(0))) = -1 Then
Debug.Print "GetRawInputDeviceList error " & GetLastError()
Else
'Size the output array.
ReDim output(devs - 1)
'Second call actually fills the array.
If GetRawInputDeviceList(VarPtr(output(0)), devs, LenB(output(0))) = -1 Then
Debug.Print "GetRawInputDeviceList error " & GetLastError()
Else
GetRawInputDevices = output
End If
End If
End Function
Sorry about the side scrolling.
I'm working in VB.NET and having some issues with a POS Printer I just connected (Epson TM-T88V). I recently downloaded a sample code from something I found on YouTube that used an Epson TM-88II, an older model of the V. This code would work perfectly fine if I could just open the serial port! What's happening is that the printer is on port USB-001 (the virtual printer port) and you can't just set that as your COM Port in VB to write to it. I downloaded the Microsoft POS for .NET and the OPOSN from Epson. The only question I have so far is where do I even start? Can anyone help me with connecting to the printer with VB and then maybe move into sending a basic "Hello World" to the printer followed by an autocut?
This is hard since it is not easy to find good articles. If you look for information you will notice how epson is not really happy sharing their knowleage. bot here are some articles that helped me with this:
this article is really good if you want to print images Images
This one is from epson Epson
** Update **
this is what makes the magic:
Public Class EscPOS
Private Shared PrintNam As String = "POS"
Public Shared Property PrinterName
Set(value)
PrintNam = value
End Set
Get
Return PrintNam
End Get
End Property
' Structure and API declarions:
<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
Structure DOCINFOW
<MarshalAs(UnmanagedType.LPWStr)> Public pDocName As String
<MarshalAs(UnmanagedType.LPWStr)> Public pOutputFile As String
<MarshalAs(UnmanagedType.LPWStr)> Public pDataType As String
End Structure
<DllImport("winspool.Drv", EntryPoint:="OpenPrinterW", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function OpenPrinter(ByVal src As String, ByRef hPrinter As IntPtr, ByVal pd As Long) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="ClosePrinter", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function ClosePrinter(ByVal hPrinter As IntPtr) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="StartDocPrinterW", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function StartDocPrinter(ByVal hPrinter As IntPtr, ByVal level As Int32, ByRef pDI As DOCINFOW) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="EndDocPrinter", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function EndDocPrinter(ByVal hPrinter As IntPtr) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="StartPagePrinter", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function StartPagePrinter(ByVal hPrinter As IntPtr) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="EndPagePrinter", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function EndPagePrinter(ByVal hPrinter As IntPtr) As Boolean
End Function
<DllImport("winspool.Drv", EntryPoint:="WritePrinter", _
SetLastError:=True, CharSet:=CharSet.Unicode, _
ExactSpelling:=True, CallingConvention:=CallingConvention.StdCall)> _
Public Shared Function WritePrinter(ByVal hPrinter As IntPtr, ByVal pBytes As IntPtr, ByVal dwCount As Int32, ByRef dwWritten As Int32) As Boolean
End Function
Public Shared Function PrintImage(BM As Bitmap) As Boolean
Dim b As Byte() = ConvertImagetoBytes(BM)
Dim bSuccess As Boolean
Dim pUnmanagedBytes As IntPtr
' Allocate some unmanaged memory for those bytes.
pUnmanagedBytes = Marshal.AllocCoTaskMem(b.Count)
' Copy the managed byte array into the unmanaged array.
Marshal.Copy(b, 0, pUnmanagedBytes, b.Count)
' Send the unmanaged bytes to the printer.
bSuccess = EscPOS.PrintBytes(b)
Return bSuccess
End Function
Public Shared Function PrintBytes(Document As Byte()) As Boolean
Dim hPrinter As IntPtr ' The printer handle.
Dim dwError As Int32 ' Last error - in case there was trouble.
Dim di As DOCINFOW ' Describes your document (name, port, data type).
Dim dwWritten As Int32 ' The number of bytes written by WritePrinter().
Dim bSuccess As Boolean ' Your success code.
' Set up the DOCINFO structure.
di = New DOCINFOW
di.pDocName = "RAW LOGO"
di.pDataType = "RAW"
hPrinter = New IntPtr(0)
bSuccess = False
If OpenPrinter(PrinterName.Normalize(), hPrinter, 0) Then
If StartDocPrinter(hPrinter, 1, di) Then
Dim managedData As Byte()
Dim unmanagedData As IntPtr
managedData = Document
unmanagedData = Marshal.AllocCoTaskMem(managedData.Length)
Marshal.Copy(managedData, 0, unmanagedData, managedData.Length)
If StartPagePrinter(hPrinter) Then
bSuccess = WritePrinter(hPrinter, unmanagedData, managedData.Length, dwWritten)
EndPagePrinter(hPrinter)
End If
Marshal.FreeCoTaskMem(unmanagedData)
EndDocPrinter(hPrinter)
End If
ClosePrinter(hPrinter)
End If
If bSuccess = False Then
dwError = Marshal.GetLastWin32Error()
End If
Return bSuccess
End Function
Public Shared Function ConvertImagetoBytes(BM As Bitmap) As Byte()
Dim Data As BitMapData = GetBitmapData(BM)
Dim Op As New MemoryStream
Dim bw As New BinaryWriter(Op)
bw.Write(Chr(Keys.Escape))
bw.Write("#"c)
' So we have our bitmap data sitting in a bit array called "dots."
' This is one long array of 1s (black) and 0s (white) pixels arranged
' as if we had scanned the bitmap from top to bottom, left to right.
' The printer wants to see these arranged in bytes stacked three high.
' So, essentially, we need to read 24 bits for x = 0, generate those
' bytes, and send them to the printer, then keep increasing x. If our
' image is more than 24 dots high, we have to send a second bit image
' command to draw the next slice of 24 dots in the image.
' Set the line spacing to 24 dots, the height of each "stripe" of the
' image that we're drawing. If we don't do this, and we need to
' draw the bitmap in multiple passes, then we'll end up with some
' whitespace between slices of the image since the default line
' height--how much the printer moves on a newline--is 30 dots.
bw.Write(Chr(Keys.Escape))
bw.Write("3"c)
' '3' just means 'change line height command'
bw.Write(CByte(24))
' OK. So, starting from x = 0, read 24 bits down and send that data
' to the printer. The offset variable keeps track of our global 'y'
' position in the image. For example, if we were drawing a bitmap
' that is 48 pixels high, then this while loop will execute twice,
' once for each pass of 24 dots. On the first pass, the offset is
' 0, and on the second pass, the offset is 24. We keep making
' these 24-dot stripes until we've run past the height of the
' bitmap.
Dim offset As Integer = 0
Dim width As Byte()
While offset < Data.Height
' The third and fourth parameters to the bit image command are
' 'nL' and 'nH'. The 'L' and the 'H' refer to 'low' and 'high', respectively.
' All 'n' really is is the width of the image that we're about to draw.
' Since the width can be greater than 255 dots, the parameter has to
' be split across two bytes, which is why the documentation says the
' width is 'nL' + ('nH' * 256).
bw.Write(Chr(Keys.Escape))
bw.Write("*"c)
' bit-image mode
bw.Write(CByte(33))
' 24-dot double-density
width = BitConverter.GetBytes(Data.Width)
bw.Write(width(0))
' width low byte
bw.Write(width(1))
' width high byte
For x As Integer = 0 To Data.Width - 1
' Remember, 24 dots = 24 bits = 3 bytes.
' The 'k' variable keeps track of which of those
' three bytes that we're currently scribbling into.
For k As Integer = 0 To 2
Dim slice As Byte = 0
' A byte is 8 bits. The 'b' variable keeps track
' of which bit in the byte we're recording.
For b As Integer = 0 To 7
' Calculate the y position that we're currently
' trying to draw. We take our offset, divide it
' by 8 so we're talking about the y offset in
' terms of bytes, add our current 'k' byte
' offset to that, multiple by 8 to get it in terms
' of bits again, and add our bit offset to it.
Dim y As Integer = (((offset \ 8) + k) * 8) + b
' Calculate the location of the pixel we want in the bit array.
' It'll be at (y * width) + x.
Dim i As Integer = (y * Data.Width) + x
' If the image (or this stripe of the image)
' is shorter than 24 dots, pad with zero.
Dim v As Boolean = False
If i < Data.Dots.Length Then
v = Data.Dots(i)
End If
' Finally, store our bit in the byte that we're currently
' scribbling to. Our current 'b' is actually the exact
' opposite of where we want it to be in the byte, so
' subtract it from 7, shift our bit into place in a temp
' byte, and OR it with the target byte to get it into there.
slice = slice Or CByte((If(v, 1, 0)) << (7 - b))
Next
' Phew! Write the damn byte to the buffer
bw.Write(slice)
Next
Next
' We're done with this 24-dot high pass. Render a newline
' to bump the print head down to the next line
' and keep on trucking.
offset = offset + 24
bw.Write(vbCrLf.ToCharArray)
End While
' Restore the line spacing to the default of 30 dots.
bw.Write(Chr(Keys.Escape))
bw.Write("3"c)
bw.Write(CByte(30))
bw.Flush()
Return Op.ToArray
End Function
Private Shared Function GetBitmapData(BM As Bitmap) As BitMapData
Dim threshold = 127
Dim index As Integer = 0
Dim dimensions As Integer = BM.Width * BM.Height
Dim dots As BitArray = New BitArray(dimensions)
Dim res As New BitMapData
Dim a As Integer
For y = 0 To BM.Height - 1
For x = 0 To BM.Width - 1
Dim col As Color = BM.GetPixel(x, y)
Dim luminance = CInt(col.R * 0.3 + col.G * 0.59 + col.B * 0.11)
If (luminance < threshold) = True Then
a = 1
End If
dots(index) = (luminance < threshold)
index = index + 1
Next
Next
res.Dots = dots : res.Height = BM.Height : res.Width = BM.Width
Return res
End Function
Private Class BitMapData
Public Dots As BitArray
Public Height As Int16
Public Width As Int16
End Class
' When the function is given a printer name and an unmanaged array of
' bytes, the function sends those bytes to the print queue.
' Returns True on success or False on failure.
Private Shared Function PrintEsto(ByVal pBytes As IntPtr, ByVal dwCount As Int32) As Boolean
Dim hPrinter As IntPtr ' The printer handle.
Dim dwError As Int32 ' Last error - in case there was trouble.
Dim di As DOCINFOW = Nothing ' Describes your document (name, port, data type).
Dim dwWritten As Int32 ' The number of bytes written by WritePrinter().
Dim bSuccess As Boolean ' Your success code.
' Set up the DOCINFO structure.
With di
.pDocName = "RAW Document"
.pDataType = "RAW"
End With
' Assume failure unless you specifically succeed.
bSuccess = False
If OpenPrinter(PrinterName, hPrinter, 0) Then
If StartDocPrinter(hPrinter, 1, di) Then
If StartPagePrinter(hPrinter) Then
' Write your printer-specific bytes to the printer.
bSuccess = WritePrinter(hPrinter, pBytes, dwCount, dwWritten)
EndPagePrinter(hPrinter)
End If
EndDocPrinter(hPrinter)
End If
ClosePrinter(hPrinter)
End If
' If you did not succeed, GetLastError may give more information
' about why not.
If bSuccess = False Then
dwError = Marshal.GetLastWin32Error()
End If
Return bSuccess
End Function
' SendFileToPrinter()
' When the function is given a file name and a printer name,
' the function reads the contents of the file and sends the
' contents to the printer.
' Presumes that the file contains printer-ready data.
' Shows how to use the SendBytesToPrinter function.
' Returns True on success or False on failure.
Public Shared Function PrintFile(ByVal szFileName As String) As Boolean
' Open the file.
Try
Dim fs As New FileStream(szFileName, FileMode.Open)
' Create a BinaryReader on the file.
Dim br As New BinaryReader(fs)
' Dim an array of bytes large enough to hold the file's contents.
Dim bytes(fs.Length) As Byte
Dim bSuccess As Boolean
' Your unmanaged pointer.
Dim pUnmanagedBytes As IntPtr
' Read the contents of the file into the array.
bytes = br.ReadBytes(fs.Length)
' Allocate some unmanaged memory for those bytes.
pUnmanagedBytes = Marshal.AllocCoTaskMem(fs.Length)
' Copy the managed byte array into the unmanaged array.
Marshal.Copy(bytes, 0, pUnmanagedBytes, fs.Length)
' Send the unmanaged bytes to the printer.
bSuccess = PrintEsto(pUnmanagedBytes, fs.Length)
' Free the unmanaged memory that you allocated earlier.
Marshal.FreeCoTaskMem(pUnmanagedBytes)
fs.Close()
Return bSuccess
Catch ex As Exception
MsgBox(ex.Message)
Return False
End Try
End Function
' When the function is given a string and a printer name,
' the function sends the string to the printer as raw bytes.
Public Shared Function PrintString(ByVal szString As String)
Dim pBytes As IntPtr
Dim dwCount As Int32
Dim Res As Boolean
' How many characters are in the string?
dwCount = szString.Length()
' Assume that the printer is expecting ANSI text, and then convert
' the string to ANSI text.
pBytes = Marshal.StringToCoTaskMemAnsi(szString)
' Send the converted ANSI string to the printer.
Res = PrintEsto(pBytes, dwCount)
Marshal.FreeCoTaskMem(pBytes)
Return Res
End Function
End Class
And this is how I call whit class:
If EsImpresionTermica Then
If File.Exists(My.Application.Info.DirectoryPath & "\Settings.{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}\Logo.conf") Then _
RawPrinting.EscPOS.PrintBytes(File.ReadAllBytes(My.Application.Info.DirectoryPath & "\Settings.{2559a1f2-21d7-11d4-bdaf-00c04f60b9f0}\Logo.conf"))
Else
Dim MSe As New MemoryStream
Dim BWe As New BinaryWriter(MSe)
BWe.Write(Chr(&H1B))
BWe.Write("#"c) 'Inicia Imresora
BWe.Write(Chr(&H1B))
BWe.Write(CByte(3))
BWe.Write(Chr(18)) 'Establece interlineado
BWe.Write(Chr(&H1B))
BWe.Write("U"c)
BWe.Write(Chr(1)) 'Impresión unidireccional
BWe.Write(Chr(&H1B))
BWe.Write("a"c)
BWe.Write(Chr(1)) 'Centra Impresión
BWe.Write(Chr(&H1B))
BWe.Write(vbCrLf.ToCharArray)
BWe.Write(Encoding.ASCII.GetBytes(Encabezado))
BWe.Write(Chr(10))
BWe.Write(Chr(10))
BWe.Flush()
BWe.Close()
RawPrinting.EscPOS.PrintBytes(MSe.ToArray)
End If
End Sub
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