The code segment has the error "reference to non-shared member requires an object reference " in Line 7. I am using a MS example to work through this, so it should work. Thanks!
Sub main()
Dim TokenSource As New CancellationTokenSource()
Dim token As CancellationToken = TokenSource.Token
Dim TaskX As Task
Dim tasks As New ConcurrentBag(Of Task)()
MessageBox.Show("In Module taskStore running Main subroutine")
TaskX = TaskFactory.StartNew(Sub() DoSomeWork(1, token), token)
tasks.Add(t)
End Sub
Sub DoSomeWork(ByVal taskNum As Integer, ByVal ct As CancellationToken)
If ct.IsCancellationRequested = True Then
MessageBox.Show("TaskX cancelled before it got started")
ct.ThrowIfCancellationRequested()
End If
Dim maxIterations As Integer = 100
End Sub
The example you linked to uses :
t = Task.Factory.StartNew(Sub() DoSomeWork(1, token), token)
not
t = TaskFactory.StartNew(Sub() DoSomeWork(1, token), token)
The Task.Factory property returns a default TaskFactory instance that can be used to call the StartNew object method.
That method isn't used since 2012 when Async/Await and Task.Run were introduced. That's explained in the docs as well:
Starting with the .NET Framework 4.5, the Task.Run method provides the easiest way to create a Task object with default configuration values.
Right now the oldest supported .NET Framework version is 4.5.2 but even that will go out of support in April 2022, in just 3 months. Your code should target 4.6.2 at least, although 4.7.1 or 4.8 would be better
Here a sample code that produces the error. I have used MSscript in VB projects in the past and those projects are functioning.
The error reported is: "When casting from a number, the value must be a number less than infinity"
Or if anyone has another suggested way to easily add scripting to a project.
Private Sub Run_Script()
Dim scriptEngine As New MSScriptControl.ScriptControl()
Dim TestClass As New Sample
Dim ScriptCode As String
scriptEngine.Language = "VbScript"
scriptEngine.AddObject("Test", TestClass, True)
ScriptCode = "MsgBox ""tests"" "
scriptEngine.AddCode(ScriptCode)
End Sub
End Class
Public Class Sample
Public Sub Test()
MessageBox.Show("This is a test")
End Sub
End Class
I found the answer. I needed to set com visible to true. This is found under "Assembly Information"
Given a legacy desktop application in Windows Form, managed code (a mix of C# and VB projects) running on .NET Framework 3.5 (which can't be migrated to newer .NET for reasons beyond the scope of this question),
how GRADUALLY transition the code from GDI+ to Direct2D? Or possibly to Direct3D?
Another constraint is that the resulting application work on Windows 7, but we will migrate to Windows 8 or Windows 10 if that is the only way to get this to work.
(The impetus is bugs in GDI+ handling of texture when used with Graphics.FillPath and a small texture scaling factor; but we eventually want to move to Direct2D or Direct3D anyway.)
What we want to do would be straightforward, if we were targetting .NET Framework 4.0+ and Windows 8+, as documented here:
Direct2D and GDI Interoperability Overview
Unfortunately, attempting to adapt those instructions to our older target specification has run into a series of roadblocks.
First step is to use some managed wrapper to access Direct2D.
(not sure whether Direct2D 1.0 or 1.1 is targetted by wrappers/code examples/tutorials at Microsoft and elsewhere.)
Options I know about:
A. Microsoft DirectX 9.0 for Managed Code (MDX) (last update 2006):
I've seen discouraging comments about this long-unsupported package, and suggestions to use SlimDX or SharpDX instead [or to migrate to newer Microsoft technologies that are supported, but not compatible with our specified older platform]. Doesn't seem like a good long-term direction. So I have not tried this yet.
B. Win2D - does not support Windows 7, nor .NET Framework 3.5.
C. SharpDX (open source, actively maintained):
Tried to use this. Unfortunately, Direct2D was not added until v.3.0.0, which requires .NET Framework 4.0+. So this is not an option, until we are ready for a more major overhaul of our app.
D. SlimDX (open source, last update 2012):
Succeeded in installing and rendering to a stand-alone Direct2D window.
Stuck on adapting this to render to a "GDI context", as described in the "Interoperability Overview" linked above.
C++ code from "interoperability" link:
// Create a DC render target.
D2D1_RENDER_TARGET_PROPERTIES props = D2D1::RenderTargetProperties(
D2D1_RENDER_TARGET_TYPE_DEFAULT,
D2D1::PixelFormat(
DXGI_FORMAT_B8G8R8A8_UNORM,
D2D1_ALPHA_MODE_IGNORE),
0,
0,
D2D1_RENDER_TARGET_USAGE_NONE,
D2D1_FEATURE_LEVEL_DEFAULT
);
hr = m_pD2DFactory->CreateDCRenderTarget(&props, &m_pDCRT);
Attempting to write VB code:
Dim factory As New Direct2D.Factory
' --- THIS WORKS using SlimDX, SlimDX.Direct2D ---
' (But it is not what I need; taken from SlimDX sample code)
' Stand-alone D2D window (NOT to GDI)
' "IntPtr handle" is "The window handle to associate with the device.".
Dim windowProperties As New WindowRenderTargetProperties(handle, New Size(600, 600))
Dim target As New WindowRenderTarget(factory, windowProperties)
' --- Hand-Translation of C++ code from "interoperability" link ---
Dim targetProperties As New RenderTargetProperties
targetProperties.Type = RenderTargetType.Default
targetProperties.PixelFormat = New PixelFormat(Format.B8G8R8A8_UNorm, AlphaMode.Ignore)
' *** How invoke "ID2D1Factory::CreateDCRenderTarget"? ***
' (There aren't many methods on SlimDX.Direct2D.Factory "factory" above,
' so if it is possible at all, SlimDX must do this some other way.)
' TODO
HOW TO MOVE FORWARD
First question: is the D2D/GDI interoperability described in the link above available for the target platform specified (.NET 3.5, Windows 7)?
If not, then what I am attempting is not possible. Though if Windows 7 is the problem, then a solution for ".NET 3.5 on Windows 10" would be worth knowing.
Second question Assuming the interoperabiity is possible, then I am facing a limitation of SlimDX? Or I've overlooked something? I'd prefer not to add a C++ project to this solution, but if a custom C++ dll could be pre-compiled, and then used [in addition to the SlimDX dll], that would be a (barely) tolerable solution.
Instead of C++ code, manually write managed wrappers to access what is needed [but I can't find in SlimDX] to initialize D2D/GDI interoperability? How convert the C++ code from that link above?
UPDATE
Found the needed call in SlimDX. See my answer for details.
Just discovered DeviceContextRenderTarget class in SlimDX:
' Equivalent to "ID2D1Factory::CreateDCRenderTarget".
Dim target2 As New DeviceContextRenderTarget(factory, targetProperties)
To complete the initialization, need to bind that DC.
C++ from interoperability link:
HRESULT DemoApp::OnRender(const PAINTSTRUCT &ps)
{
HRESULT hr;
RECT rc;
// Get the dimensions of the client drawing area.
GetClientRect(m_hwnd, &rc);
// Create the DC render target.
hr = CreateDeviceResources();
if (SUCCEEDED(hr))
{
// Bind the DC to the DC render target.
hr = m_pDCRT->BindDC(ps.hdc, &rc);
// Draw with Direct2D.
m_pDCRT->BeginDraw();
m_pDCRT->SetTransform(D2D1::Matrix3x2F::Identity());
m_pDCRT->Clear(D2D1::ColorF(D2D1::ColorF::White));
m_pDCRT->DrawEllipse(
D2D1::Ellipse(
D2D1::Point2F(150.0f, 150.0f),
100.0f,
100.0f),
m_pBlackBrush,
3.0
);
hr = m_pDCRT->EndDraw();
// Draw some GDI content.
if (SUCCEEDED(hr))
{
...
}
}
if (hr == D2DERR_RECREATE_TARGET)
{
hr = S_OK;
DiscardDeviceResources();
}
return hr;
}
VB Translation:
' "canvas" is the Windows control (tested with Panel) that I wish to draw D2D in.
Private Sub canvas_Paint(sender As Object, e As System.Windows.Forms.PaintEventArgs) Handles canvas.Paint
' Render GDI content that is below D2D content
'... existing GDI calls ...
' Render Direct2D content.
cDirect2DRenderer.TestRendering(e.Graphics, canvas.ClientSize)
' Render GDI content that is above D2D content.
'... existing GDI calls ...
End Sub
Which uses VB class:
Imports System.Drawing
Imports SlimDX
Imports SlimDX.Direct2D
Imports SlimDX.DXGI
Public Class cDirect2DRenderer
#Region "=== Shared ==="
Public Shared Sub TestRendering(gr As Graphics, canvasSize As System.Drawing.Size)
Dim renderer As New cDirect2DRenderer
' CAUTION: After this, must call EndDraw or ReleaseHDC when done drawing.
Dim success As Boolean = renderer.BeginDraw(gr, canvasSize)
' Render some Direct2D content.
success = renderer.Test_Render(success)
success = renderer.EndDraw(gr, success)
If Not success Then
'TODO: Log error.
End If
renderer.Dispose() : renderer = Nothing
End Sub
#End Region
#Region "=== Fields, Constructor, Dispose ==="
Private Ready As Boolean
Private _factory As New Direct2D.Factory
Private Target As DeviceContextRenderTarget
Private Bounds As Rectangle
Private Hdc As IntPtr
Public Sub New()
End Sub
Public Sub Dispose()
If Target IsNot Nothing Then
Target.Dispose() : Target = Nothing
End If
Ready = False
End Sub
#End Region
#Region "=== BeginDraw, Test_Render, EndDraw ==="
Public Property Factory As Direct2D.Factory
Get
Return _factory
End Get
Set(value As Direct2D.Factory)
If Exists(_factory) Then
_factory.Dispose()
'_factory = Nothing
End If
_factory = value
End Set
End Property
' True if Ready to draw.
' CAUTION: Even if returns False, Caller must call EndDraw, so that ReleaseHDC is called.
Public Function BeginDraw(g As Graphics, canvasSize As System.Drawing.Size) As Boolean
' CAUTION: After this, must call EndDraw or ReleaseHDC when done drawing.
EnsureReady(g, canvasSize)
If Not Ready Then
' Initialization failed.
Return False
End If
Try
Dim success As Boolean = True
Target.BeginDraw()
Return success
Catch ex As Exception
Return False
End Try
End Function
Public Function Test_Render(success As Boolean) As Boolean
Try
Target.Transform = Matrix3x2.Identity
Target.Clear(New Color4(Color.BlueViolet))
Dim brush As Direct2D.Brush = New SolidColorBrush(Target, New Color4(Color.Black))
Dim ellipse As Direct2D.Ellipse = New Ellipse() With {
.Center = New PointF(100, 100),
.RadiusX = 80, .RadiusY = 80}
Target.DrawEllipse(brush, ellipse)
Target.FillEllipse(brush, ellipse)
Catch ex As Exception
success = False
End Try
Return success
End Function
' True if rendering succeeds.
' "success" is accumulation, included in the return value.
Public Function EndDraw(g As Graphics, success As Boolean) As Boolean
' Wrap EndDraw in Try, because "ReleaseHDC" must always be called.
Try
' EndDraw is always called (even if "success" is already False).
success = success And Target.EndDraw().IsSuccess
Catch ex As Exception
success = False
End Try
ReleaseHDC(g)
' TBD: This could be moved out elsewhere.
EnsureFactoryReleased()
If Not success Then
Trouble()
End If
Return success
End Function
' CAUTION: Caller must call EndDraw or ReleaseHDC when done drawing.
Private Sub EnsureReady(g As Graphics, canvasSize As System.Drawing.Size)
Dim newBounds As New Rectangle(0, 0, canvasSize.Width, canvasSize.Height)
If Not Ready OrElse Not SameBounds(newBounds) Then
If Ready Then
Dispose()
End If
Me.Bounds = newBounds
Me.Ready = InitializeDevice(g)
End If
End Sub
' AFTER set Me.Bounds.
' CAUTION: Caller must call g.ReleaseHdc(Me.Hdc) when done drawing.
Private Function InitializeDevice(g As Graphics) As Boolean
Try
'' Stand-alone D2D window (NOT to GDI)
' ...width As Integer, height As Integer
'Dim windowProperties As New WindowRenderTargetProperties(handle, New Size(600, 600))
'Dim target1 As New WindowRenderTarget(factory, windowProperties)
Dim targetProperties As New RenderTargetProperties
targetProperties.Type = RenderTargetType.Default
targetProperties.PixelFormat = New PixelFormat(Format.B8G8R8A8_UNorm, AlphaMode.Ignore)
' Equivalent to "ID2D1Factory::CreateDCRenderTarget".
Me.Target = New DeviceContextRenderTarget(Me.Factory, targetProperties)
' CAUTION: Caller must call g.ReleaseHdc(Me.Hdc) when done drawing.
Me.Hdc = g.GetHdc()
Try
'TestStr = Me.Hdc.ToString()
Dim result As SlimDX.Result = Target.BindDeviceContext(Me.Hdc, Me.Bounds)
If Not result.IsSuccess Then
ReleaseHDC(g)
End If
Return result.IsSuccess
Catch ex As Exception
ReleaseHDC(g)
Return False
End Try
Catch ex As Exception
Return False
End Try
End Function
Private Sub ReleaseHDC(g As Graphics)
Try
g.ReleaseHdc(Me.Hdc)
Finally
Me.Hdc = Nothing
End Try
End Sub
Private Sub EnsureFactoryReleased()
Me.Factory = Nothing
End Sub
Private Function SameBounds(newBounds As Rectangle) As Boolean
' TBD: Does Equals do what we need?
Return (newBounds.Equals(Me.Bounds))
End Function
#End Region
End Class
How can I mock one method with RhinoMocks in VB.Net? The reference I found is in C#:
Expect.Call(delegate{list.Add(0);}).IgnoreArguments()
.Do((Action<int>)delegate(int item) {
if (item < 0) throw new ArgumentOutOfRangeException();
});
SharpDevelop converts this to:
Expect.Call(Function() Do
list.Add(0)
End Function).IgnoreArguments().Do(DirectCast(Function(item As Integer) Do
If item < 0 Then
Throw New ArgumentOutOfRangeException()
End If
End Function, Action(Of Integer)))
But that doesn't work either (it doesn't compile).
This is what I want to do: create a new object and call a method which sets some properties of that method. In real-life this method, will populate the properties with values found in the database. In test, I would like to mock this method with a custom method/delegate so that I can set the properties myself (without going to the database).
In pseudo-code, this is what I'm trying to do:
Dim _lookup As LookUp = MockRepository.GenerateMock(Of LookUp)()
_luvalue.Expect(Function(l As LookUp) l.GetLookUpByName("test")).Do(Function(l As LookUp) l.Property = "value")
Unfortunately you're attempting to do both a Sub lambda and a Statement Lambda. Neither are supported in VS2008 (but will be in the upcoming version of VS). Here is the expanded version that will work for VB
I'm guessing at the type of m_list
Class MockHelper
Dim m_list as new List(Of Object)
Public Sub New()
Expect(AddressOf CallHelper).IgnoreArguments().Do(AddressOf Do Hepler)
End Sub
Private Sub CallHelper()
m_list.Add(0)
End Sub
Private Sub DoHelper(ByVal item as Integer)
if item < 0 Then
Throw New ArgumentOutOfRangeException
End If
End Sub
End Class
I have never mocked something w/ both a delegate and a lambda so I can't give a full solution to this problem, but I did want to share some example code for the usual "AssertWasCalled" function in Rhino Mocks 3.5 for vb developers because I spent some time trying to grok this... (keep in mind the below is kept simple for brevity)
This is the method under test - might be found inside a service class for the user object
Public Sub DeleteUserByID(ByVal id As Integer) Implements Interfaces.IUserService.DeleteUserByID
mRepository.DeleteUserByID(id)
End Sub
This is the interactive test to assert the repository method gets called
<TestMethod()> _
Public Sub Should_Call_Into_Repository_For_DeleteProjectById()
Dim Repository As IUserRepository = MockRepository.GenerateStub(Of IUserRepository)()
Dim Service As IUserService = New UserService(Repository)
Service.DeleteUserByID(Nothing)
Repository.AssertWasCalled(Function(x) Wrap_DeleteUserByID(x))
End Sub
This is the wrap function used to ensure this works w/ vb
Function Wrap_DeleteUserByID(ByVal Repository As IUserRepository) As Object
Repository.DeleteUserByID(Nothing)
Return Nothing
End Function
I found this to be a very nasty solution, but if it helps someone w/ the same issues I had it was worth the time it took to post this ;)
Looking for help trying to figure out why this typecast is not working on my machine.
This code was provided as an answer to another question I had and it's not working for me. It works for the answer poster on their machine, but I'm get a an exception on the line trying to typecast from ShellBrowserWindow to ShellFolderView.
I am using Visual Studio Express 2013, running on Windows 7 Pro X64 Sp1. The target framework for the project is .Net Framework 4. I've added references to Microsoft Internet Controls and Microsoft Shell Controls and Automation and I've added the Imports statements for Shell32 and SHDocVw. DLL versions are as follows: shell32.dll = 6.1.7601.18517 and shdocvw.dll = 6.1.7601.1822 I'm not sure what I could be missing.
The code looks like this. (This code is in a form object)
Imports EdmLib
Imports Shell32
Imports SHDocVw
Public Class BlankForm
Private Sub BlankForm_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim bar As String() = GetExplorerSelectedFiles()
Exit Sub
'The rest of my program is below this line - I'm just trying to test this one function right now...
End Sub
'Uses the windows shell to get the files selected in explorer
Public Function GetExplorerSelectedFiles() As String()
Dim ExplorerFiles As New List(Of String)
Dim exShell As New Shell32.Shell
Dim SFV As Shell32.ShellFolderView
For Each window As SHDocVw.ShellBrowserWindow In DirectCast(exShell.Windows, SHDocVw.IShellWindows)
If (window.Document).GetType.Name <> "HTMLDocumentClass" Then
SFV = CType(window.Document, ShellFolderView) '<--This is where it fails!!
For Each fi As FolderItem In SFV.SelectedItems
ExplorerFiles.Add(fi.Path)
Next
End If
Next
Return ExplorerFiles.ToArray
End Function
End Class
The line SFV = CType(window.Document, ShellFolderView) results in the following message:
An unhandled exception of type 'System.InvalidCastException' occurred
in LaunchTemplateEPDM.exe
Additional information: Unable to cast COM object of type
'System.__ComObject' to interface type 'Shell32.ShellFolderView'. This
operation failed because the QueryInterface call on the COM component
for the interface with IID '{29EC8E6C-46D3-411F-BAAA-611A6C9CAC66}'
failed due to the following error: No such interface supported
(Exception from HRESULT: 0x80004002 (E_NOINTERFACE)).
I've taken a screenshot of a quickwatch on the window object. A quickwatch on the window.document object shows an error saying it's either undefined or inaccessible.
I ran the query Microsoft.VisualBasic.Information.TypeName(window.document) and it returns "IShellFolderViewDual3".
I fixed it.
Not sure why this happens on my system and not yours.
What I found was that GetType.Name always just returns "System.__ComObject", regardless of whether the object is of type ShellFolderView, HTMLDocumentClass or something else. So what was happening was no matter what the actual type of the object was, it was passing the <>"HTMLDocumentClass" test because it was always evaluating to "System.__ComObject". Then when we tried to run the CType function on an object that didn't implement the ShellFolderView interface, it would throw that exception.
I eventually stumbled upon this article which led me to experiment with the TypeName Function which seems to return the actual type, and so I ended up with the working code below:
Public Function GetExplorerSelectedFiles() As String()
Dim ExplorerFiles As New List(Of String)
Dim exShell As New Shell32.Shell
For Each window As SHDocVw.ShellBrowserWindow In DirectCast(exShell.Windows, SHDocVw.IShellWindows)
If TypeName(window.Document) Like "IShellFolderViewDual*" Then
For Each fi As FolderItem In DirectCast(window.Document, ShellFolderView).SelectedItems
ExplorerFiles.Add(fi.Path)
Next
End If
Next
Return ExplorerFiles.ToArray
End Function