Use ProvideProperty as object - vb.net

I would like to use a class that ProvideProperty as object inside the disigner but it seems I can't use it when the property is an Object. A string works well.
I can set and get within the code but not in the designer.
Big thx
My code :
Imports System.Windows.Forms
Imports System.ComponentModel
<ProvideProperty("Champ", GetType(Control))> _
<ProvideProperty("Valeur", GetType(Control))> _
<ProvideProperty("Comparaison", GetType(Control))> _
Public Class ProprietesEtendues
Implements IExtenderProvider
Public Enum CompareType
Egal
Different
PlusGrand
PlusGrandEgal
PlusPetit
PlusPetitEgal
End Enum
Private _champ As New Dictionary(Of IntPtr, String)
Private _val As New Dictionary(Of IntPtr, Object)
Private _comp As New Dictionary(Of IntPtr, CompareType)
'Propriété Comparaison
Public Function GetChamp(ByVal c As Control) As String
Dim strRetour As String = ""
_champ.TryGetValue(c.Handle, strRetour)
Return strRetour
End Function
<DefaultValue(""), Category("Data"), Description("Ajoute une propriété de type String")> _
Public Sub SetChamp(ByVal c As Control, ByVal value As String)
_champ(c.Handle) = value
End Sub
'Propriété Valeur
Public Function GetValeur(ByVal c As Control) As Object
Dim objRetour As Object = ""
_val.TryGetValue(c.Handle, objRetour)
Return objRetour
End Function
<DefaultValue(""), Category("Data"), Description("Ajoute une propriété de type Object")> _
Public Sub SetValeur(ByVal c As Control, ByVal value As Object)
_val(c.Handle) = value
End Sub
'Propriété Comparaison
Public Function GetComparaison(ByVal c As Control) As CompareType
Dim ctRetour As CompareType = CompareType.Egal
_comp.TryGetValue(c.Handle, ctRetour)
Return ctRetour
End Function
<DefaultValue(CompareType.Egal), Category("Data"), Description("Ajoute une propriété de type CompareType")> _
Public Sub SetComparaison(ByVal c As Control, ByVal value As CompareType)
_comp(c.Handle) = value
End Sub
Public Function CanExtend(ByVal target As [Object]) As Boolean Implements IExtenderProvider.CanExtend
Return True
End Function
End Class

Normaly, you can put at least a string like the Tag property
If a string is good enough then you can apply the [TypeConverter] attribute:
<TypeConverter(GetType(StringConverter))> _
Public Function GetValeur(ByVal c As Control) As Object
Dim objRetour As Object = ""
_val.TryGetValue(c.Handle, objRetour)
Return objRetour
End Function
<DefaultValue(""), Category("Data"), Description("Ajoute une propriété de type Object")> _
<TypeConverter(GetType(StringConverter))> _
Public Sub SetValeur(ByVal c As Control, ByVal value As Object)
_val(c.Handle) = value
End Sub

Related

String Enumeration Class with restricted set of values and special characters

Have a class with a string attribute (usign vs 2005 here)
Private _foo As String
Public Property Foo() As String
Get
Return _foo
End Get
Set(ByVal value As String)
??
End Set
End Property
I want to restric the values of Foo into a set list of values.
Unfortunately those values include special characters:
"bar/bar", "smthing/smthing" etc..
so I dont think I can use a simple enumeration
Any ideas?
Does something like this help where it checks an arraylist for allowed values and returns an error if it doesnt. Obviously not a strict as an enum
Public Class footest
Private _foo As String
Private allowed_values As ArrayList
Public Sub New(ByVal text As String)
MyBase.New()
allowed_values.Add("bar/bar")
allowed_values.Add("smthing/smthing")
End Sub
Public Property Foo() As String
Get
Return _foo
End Get
Set(ByVal value As String)
If allowed_values.Contains(value) Then
_foo = value
Else
_foo = "NA#"
End If
End Set
End Property
End Class
Or you could create your enum without the special characters then look them up in a hashtable/sortedlist/dictionary that you create in the New sub
Private hashtable As Hashtable
Public Sub New(ByVal text As String)
MyBase.New()
hashtable.Add("barbar", "bar/bar")
hashtable.Add("smthingsmthing", "smthing/smthing")
End Sub
Found this at CodeProject and it allows me to return an enum with special characters to the console and will require you to create 3 classes. To avoid creating new arraylists etc. at every new foo you need to be a bit more elaborate
String Enumerations in VB.NET # CodeProject
Console
Module Module1
Sub Main()
Dim x As New _foo
x.Foo = FooString.barbar
Console.WriteLine(x.Foo)
End Sub
End Module
The foo class
Public Class _foo
Private _foo As String
Public Property Foo() As FooString
Get
Return _foo
End Get
Set(ByVal value As FooString)
_foo = value
End Set
End Property
End Class
A custom enumeration that outputs special characters
Public NotInheritable Class FooString
Inherits StringEnumeration(Of FooString)
''ADD YOUR ALLOWED VALUES HERE
Public Shared ReadOnly barbar As New FooString("Bar/Bar")
Public Shared ReadOnly smthingsmthing As New FooString("smthing/smthing")
Private Sub New(ByVal StringConstant As String)
MyBase.New(StringConstant)
End Sub
End Class
A String enumeration handling class
Public MustInherit Class StringEnumeration(Of TStringEnumeration _
As StringEnumeration(Of TStringEnumeration))
Implements IStringEnumeration
Private myString As String
Sub New(ByVal StringConstant As String)
myString = StringConstant
End Sub
#Region "Properties"
Public Class [Enum]
Public Shared Function GetValues() As String()
Dim myValues As New List(Of String)
For Each myFieldInfo As System.Reflection.FieldInfo _
In GetSharedFieldsInfo()
Dim myValue As StringEnumeration(Of TStringEnumeration) = _
CType(myFieldInfo.GetValue(Nothing), _
StringEnumeration(Of TStringEnumeration))
'Shared Fields use a Null object
myValues.Add(myValue)
Next
Return myValues.ToArray
End Function
Public Shared Function GetNames() As String()
Dim myNames As New List(Of String)
For Each myFieldInfo As System.Reflection.FieldInfo _
In GetSharedFieldsInfo()
myNames.Add(myFieldInfo.Name)
Next
Return myNames.ToArray
End Function
Public Shared Function GetName(ByVal myName As _
StringEnumeration(Of TStringEnumeration)) As String
Return myName
End Function
Public Shared Function isDefined(ByVal myName As String) As Boolean
If GetName(myName) Is Nothing Then Return False
Return True
End Function
Public Shared Function GetUnderlyingType() As Type
Return GetType(String)
End Function
Friend Shared Function GetSharedFieldsInfo() _
As System.Reflection.FieldInfo()
Return GetType(TStringEnumeration).GetFields
End Function
Friend Shared Function GetSharedFields() As _
StringEnumeration(Of TStringEnumeration)()
Dim myFields As New List(Of _
StringEnumeration(Of TStringEnumeration))
For Each myFieldInfo As System.Reflection.FieldInfo _
In GetSharedFieldsInfo()
Dim myField As StringEnumeration(Of TStringEnumeration) = _
CType(myFieldInfo.GetValue(Nothing), _
StringEnumeration(Of TStringEnumeration))
'Shared Fields use a Null object
myFields.Add(myField)
Next
Return myFields.ToArray
End Function
End Class
#End Region
#Region "Cast Operators"
'Downcast to String
Public Shared Widening Operator CType(ByVal myStringEnumeration _
As StringEnumeration(Of TStringEnumeration)) As String
If myStringEnumeration Is Nothing Then Return Nothing
Return myStringEnumeration.ToString
End Operator
'Upcast to StringEnumeration
Public Shared Widening Operator CType(ByVal myString As String) As _
StringEnumeration(Of TStringEnumeration)
For Each myElement As StringEnumeration(Of TStringEnumeration) In _
StringEnumeration(Of TStringEnumeration).Enum.GetSharedFields
'Found a Matching StringEnumeration - Return it
If myElement.ToString = myString Then Return myElement
Next
'Did not find a Match - return NOTHING
Return Nothing
End Operator
Overrides Function ToString() As String Implements IStringEnumeration.ToString
Return myString
End Function
#End Region
#Region "Concatenation Operators"
Public Shared Operator &(ByVal left As StringEnumeration(Of _
TStringEnumeration), ByVal right As StringEnumeration(Of _
TStringEnumeration)) As String
If left Is Nothing And right Is Nothing Then Return Nothing
If left Is Nothing Then Return right.ToString
If right Is Nothing Then Return left.ToString
Return left.ToString & right.ToString
End Operator
Public Shared Operator &(ByVal left As StringEnumeration(Of _
TStringEnumeration), ByVal right As IStringEnumeration) As String
If left Is Nothing And right Is Nothing Then Return Nothing
If left Is Nothing Then Return right.ToString
If right Is Nothing Then Return left.ToString
Return left.ToString & right.ToString
End Operator
#End Region
#Region "Operator Equals"
Public Shared Operator =(ByVal left As StringEnumeration(Of _
TStringEnumeration), ByVal right As _
StringEnumeration(Of TStringEnumeration)) As Boolean
If left Is Nothing Or right Is Nothing Then Return False
Return left.ToString.Equals(right.ToString)
End Operator
Public Overrides Function Equals(ByVal obj As Object) As Boolean
If TypeOf (obj) Is StringEnumeration(Of TStringEnumeration) Then
Return CType(obj, StringEnumeration(Of _
TStringEnumeration)).ToString = myString
ElseIf TypeOf (obj) Is String Then
Return CType(obj, String) = myString
End If
Return False
End Function
#End Region
#Region "Operator Not Equals"
Public Shared Operator <>(ByVal left As StringEnumeration(Of _
TStringEnumeration), ByVal right As StringEnumeration(Of _
TStringEnumeration)) As Boolean
Return Not left = right
End Operator
#End Region
End Class
'Base Interface without any Generics for StringEnumerations
Public Interface IStringEnumeration
Function ToString() As String
End Interface

LongListSelector not working (not navigating to other pages)

I have implemented a LongListSelector for my Windows Phone 7 app. However when I tap an item it doesn't navigate to the desired page. Does anyone know why and how this can be fixed? Below is my code. Each page has it's own uri and I want to navigate to different pages.
All help would be very much appreciated.
Many thanks
Code:
Imports System.Linq
Imports Microsoft.Phone.Controls
Partial Public Class Victoria_line
Inherits PhoneApplicationPage
Public Sub New()
InitializeComponent()
Dim source As New List(Of JumpDemo)()
source.Add(New JumpDemo() With { _
.Name = "Blackhorse Road", _
.FareZone = "Fare zone 3", _
.GroupBy = "b", _
.Link = "/Lines and Stations/Victoria/Blackhorse_Road_(Victoria).xaml" _
})
source.Add(New JumpDemo() With { _
.Name = "Warren Street", _
.FareZone = "Fare zone 1", _
.GroupBy = "w", _
.Link = "/Lines and Stations/Victoria/Warren_Street_(Victoria).xaml" _
})
Dim MygroupBy = From jumpdemo In source _
Group jumpdemo By jumpdemo.GroupBy Into c = Group _
Order By GroupBy _
Select New _
Group(Of JumpDemo)(GroupBy, c)
Me.Victoria_line.ItemsSource = MygroupBy
End Sub
Private Sub Victoria_line_SelectionChanged(ByVal sender As Object, ByVal e As SelectionChangedEventArgs)
If Victoria_line.SelectedItem = Nothing Then
Return
End If
Dim addressString As String = "/StationPage.xaml"
Dim pageUri As Uri = New Uri(addressString, UriKind.Relative)
NavigationService.Navigate(pageUri)
' Reset selected item to -1 (no selection)
Victoria_line.SelectedItem = Nothing
End Sub
End Class
Public Class Group(Of T)
Implements IEnumerable(Of T)
Public Sub New(name As String, items As IEnumerable(Of T))
Me.Title = name
Me.Items = New List(Of T)(items)
End Sub
Public Overrides Function Equals(obj As Object) As Boolean
Dim that As Group(Of T) = TryCast(obj, Group(Of T))
Return (that IsNot Nothing) AndAlso (Me.Title.Equals(that.Title))
End Function
Public Property Title() As String
Get
Return m_Title
End Get
Set(value As String)
m_Title = value
End Set
End Property
Private m_Title As String
Public Property Items() As IList(Of T)
Get
Return m_Items
End Get
Set(value As IList(Of T))
m_Items = value
End Set
End Property
Private m_Items As IList(Of T)
Public Function GetEnumerator() As IEnumerator(Of T) Implements IEnumerable(Of T).GetEnumerator
Return Me.Items.GetEnumerator()
End Function
Private Function System_Collections_IEnumerable_GetEnumerator() As System.Collections.IEnumerator Implements System.Collections.IEnumerable.GetEnumerator
Return Me.Items.GetEnumerator()
End Function
End Class
Public Class Victoria
Public Property Name() As String
Get
Return m_Name
End Get
Set(value As String)
m_Name = value
End Set
End Property
Private m_Name As String
Public Property FareZone() As String
Get
Return m_FareZone
End Get
Set(value As String)
m_FareZone = value
End Set
End Property
Private m_FareZone As String
Public Property GroupBy() As String
Get
Return m_GroupBy
End Get
Set(value As String)
m_GroupBy = value
End Set
End Property
Private m_GroupBy As String
Public Property Link() As Uri
Get
Return m_Link
End Get
Set(value As Uri)
m_Link = value
End Set
End Property
Private m_Link As Uri
End Class
If what you are trying to achieve is navigate to another page when you tap on an item you should just register for the Tap event inside your Item DataTemplate and in the event handler do something like this:
Private Sub Item_Tap(sender As Object, e As GestureEventArgs)
Dim element As FrameworkElement = TryCast(sender, FrameworkElement)
Dim item As JumpDemo = TryCast(element.DataContext, JumpDemo)
Dim addressString As String = item.Link
Dim pageUri As Uri = New Uri(addressString, UriKind.Relative)
NavigationService.Navigate(pageUri)
End Sub

Vb.net app to track webbrowser popup

I have a webbrowser control on my form, when I navigate to a certain page it opens a popup which opens the page in the current default browser for windows, in this case IE. I would like to access the source code for this page. I dont want to close it, I just want to grab the html.
Thanks for your help.
Edit:
Slution:
eWebbrowser.vb :
Imports System
Imports System.Text
Imports System.Windows.Forms
Imports System.ComponentModel
Imports System.Collections.Generic
Imports System.Runtime.InteropServices
Imports System.Security.Permissions
<PermissionSet(SecurityAction.Demand, Name:="FullTrust")> _
<System.Runtime.InteropServices.ComVisibleAttribute(True)> _
Public Class eWebbrowser
Inherits System.Windows.Forms.WebBrowser
#Region " COM Imports Etc..."
<StructLayout(LayoutKind.Sequential)> _
Public Structure OLECMDTEXT
Public cmdtextf As UInt32
Public cwActual As UInt32
Public cwBuf As UInt32
Public rgwz As Char
End Structure
<StructLayout(LayoutKind.Sequential)> _
Public Structure OLECMD
Public cmdID As Long
Public cmdf As UInt64
End Structure
' Interop - IOleCommandTarget (See MSDN - http://support.microsoft.com/?kbid=311288)
<ComImport(), Guid("b722bccb-4e68-101b-a2bc-00aa00404770"), _
InterfaceType(ComInterfaceType.InterfaceIsIUnknown)> _
Public Interface IOleCommandTarget
Sub QueryStatus(ByRef pguidCmdGroup As Guid, ByVal cCmds As UInt32, _
<MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=1)> ByVal prgCmds As OLECMD, _
ByRef pCmdText As OLECMDTEXT)
Sub Exec(ByRef pguidCmdGroup As Guid, ByVal nCmdId As Long, _
ByVal nCmdExecOpt As Long, ByRef pvaIn As Object, _
ByRef pvaOut As Object)
End Interface
Private cmdGUID As New Guid(&HED016940, -17061, _
&H11CF, &HBA, &H4E, &H0, &HC0, &H4F, &HD7, &H8, &H16)
#Region " Commands Enumeration "
'There are a ton of ole commands, we are only using a couple, msdn research will
'allow you to figure out which ones you want to use.
Enum oCommands As Long
Options
Find = 1
ViewSource = 2
'////////////////////////////////////////
ID_FILE_SAVEAS = 32771
ID_FILE_PAGESETUP = 32772
ID_FILE_IMPORTEXPORT = 32774
ID_FILE_PRINTPREVIEW = 32776
ID_FILE_NEWIE = 32779
ID_FILE_NEWMAIL = 32780
PID_FILE_NEWINTERNETCALL = 32781
ID_FILE_ADDTRUST = 32782
ID_FILE_ADDLOCAL = 32783
DLCTL_BGSOUNDS = &H40
DLCTL_DLIMAGES = &H10
DLCTL_DOWNLOADONLY = &H800
DLCTL_FORCEOFFLINE = &H10000000
DLCTL_NO_BEHAVIORS = &H800
DLCTL_NO_CLIENTPULL = &H20000000
DLCTL_NO_DLACTIVEXCTLS = &H400
DLCTL_NO_FRAMEDOWNLOAD = &H1000
DLCTL_NO_JAVA = &H100
DLCTL_NO_METACHARSET = &H10000
DLCTL_NO_RUNACTIVEXCTLS = &H200
DLCTL_NO_SCRIPTS = &H80
'DLCTL_OFFLINE DLCTL_OFFLINEIFNOTCONNECTED
DLCTL_OFFLINEIFNOTCONNECTED = &H80000000
DLCTL_PRAGMA_NO_CACHE = &H4000
DLCTL_RESYNCHRONIZE = &H2000
DLCTL_SILENT = &H40000000
DLCTL_URL_ENCODING_DISABLE_UTF8 = &H20000
DLCTL_URL_ENCODING_ENABLE_UTF8 = &H40000
DLCTL_VIDEOS = &H20
End Enum
#End Region
#End Region
'Just a little easier way to get at it.
Public ReadOnly Property CurrentURL() As String
Get
Return Me.Document.Url.ToString
End Get
End Property
Public Sub New()
MyBase.New()
End Sub
#Region " Dialogs "
Public Sub ShowOpen()
Dim cdlOpen As New OpenFileDialog
Try
cdlOpen.Filter = "HTML Files (*.htm)|*.htm|HTML Files (*.html)|*.html|TextFiles" & _
"(*.txt)|*.txt|Gif Files (*.gif)|*.gif|JPEG Files (*.jpg)|*.jpeg|" & _
"PNG Files (*.png)|*.png|Art Files (*.art)|*.art|AU Fles (*.au)|*.au|" & _
"AIFF Files (*.aif|*.aiff|XBM Files (*.xbm)|*.xbm|All Files (*.*)|*.*"
cdlOpen.Title = " Open File "
cdlOpen.ShowDialog()
If cdlOpen.FileName > Nothing Then
Me.Navigate(cdlOpen.FileName)
End If
Catch ex As Exception
Throw New Exception(ex.Message.ToString)
End Try
End Sub
Public Sub ShowSource()
Dim cmdt As IOleCommandTarget
Dim o As Object = Nothing
Dim oIE As Object = Nothing
Try
cmdt = CType(Me.Document.DomDocument, IOleCommandTarget)
cmdt.Exec(cmdGUID, oCommands.ViewSource, 1, o, o)
Catch ex As Exception
Throw New Exception(ex.Message.ToString, ex.InnerException)
Finally
cmdt = Nothing
End Try
End Sub
Public Sub ShowFindDialog()
Dim cmdt As IOleCommandTarget
Dim o As Object = Nothing
Dim oIE As Object = Nothing
Try
cmdt = CType(Me.Document.DomDocument, IOleCommandTarget)
cmdt.Exec(cmdGUID, oCommands.Find, 0, o, o)
Catch ex As Exception
Throw New Exception(ex.Message.ToString, ex.InnerException)
Finally
cmdt = Nothing
End Try
End Sub
Public Sub AddToFavorites(Optional ByVal strURL As String = "", Optional ByVal strTitle As String = "")
Dim oHelper As Object = Nothing
Try
oHelper = New ShellUIHelper
oHelper.AddFavorite(Me.Document.Url.ToString, Me.DocumentTitle.ToString)
Catch ex As Exception
Throw New Exception(ex.Message.ToString)
End Try
If oHelper IsNot Nothing AndAlso Marshal.IsComObject(oHelper) Then
Marshal.ReleaseComObject(oHelper)
End If
End Sub
Public Sub ShowOrganizeFavorites()
'Organize Favorites
Dim helper As Object = Nothing
Try
helper = New ShellUIHelper()
helper.ShowBrowserUI("OrganizeFavorites", 0)
Finally
If helper IsNot Nothing AndAlso Marshal.IsComObject(helper) Then
Marshal.ReleaseComObject(helper)
End If
End Try
End Sub
Public Sub SendToDesktop()
'Shortcut to desktop
Dim helper As Object = Nothing
Try
helper = New ShellUIHelper()
helper.AddDesktopComponent(Me.Document.Url.ToString, "website")
Finally
If helper IsNot Nothing AndAlso Marshal.IsComObject(helper) Then
Marshal.ReleaseComObject(helper)
End If
End Try
End Sub
''' <summary>
''' This Will launch the internet option dialog.
''' </summary>
''' <remarks></remarks>
Public Sub ShowInternetOptions()
Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,0", vbNormalFocus)
End Sub
Public Sub ShowPrivacyReport()
Shell("rundll32.exe shell32.dll,Control_RunDLL inetcpl.cpl,,2", vbNormalFocus)
End Sub
#End Region
#Region " Extended "
<ComImport(), _
Guid("34A715A0-6587-11D0-924A-0020AFC7AC4D"), _
InterfaceTypeAttribute(ComInterfaceType.InterfaceIsIDispatch), _
TypeLibType(TypeLibTypeFlags.FHidden)> _
Public Interface DWebBrowserEvents2
<DispId(250)> _
Sub BeforeNavigate2(<[In](), MarshalAs(UnmanagedType.IDispatch)> ByVal pDisp As Object, _
<InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef URL As String, _
<InAttribute()> ByRef flags As Object, _
<InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef targetFrameName As String, _
<InAttribute()> ByRef postdata As Object, _
<InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef headers As String, _
<InAttribute(), OutAttribute()> ByRef cancel As Boolean)
'Note: Postdata is a SafeArray but for some reason, if I do a proper declaration, the event will not be raised:
'<[In](), MarshalAs(UnmanagedType.SafeArray, safearraysubtype:=VarEnum.VT_UI1)> ByRef postdata() As Byte, _
<DispId(273)> _
Sub NewWindow3(<InAttribute(), MarshalAs(UnmanagedType.IDispatch)> ByVal pDisp As Object, _
<InAttribute(), OutAttribute()> ByRef cancel As Boolean, _
<InAttribute()> ByRef Flags As Object, _
<InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef UrlContext As String, _
<InAttribute(), MarshalAs(UnmanagedType.BStr)> ByRef Url As String)
End Interface
Public Enum NWMF
NWMF_UNLOADING = &H1&
NWMF_USERINITED = &H2&
NWMF_FIRST_USERINITED = &H4&
NWMF_OVERRIDEKEY = &H8&
NWMF_SHOWHELP = &H10&
NWMF_HTMLDIALOG = &H20&
NWMF_FROMPROXY = &H40&
End Enum
Private cookie As AxHost.ConnectionPointCookie
Private wevents As WebBrowserExtendedEvents
'This method will be called to give you a chance to create your own event sink
Protected Overrides Sub CreateSink()
'MAKE SURE TO CALL THE BASE or the normal events won't fire
MyBase.CreateSink()
wevents = New WebBrowserExtendedEvents(Me)
cookie = New AxHost.ConnectionPointCookie(Me.ActiveXInstance, wevents, GetType(DWebBrowserEvents2))
End Sub
Protected Overrides Sub DetachSink()
If Not cookie Is Nothing Then
cookie.Disconnect()
cookie = Nothing
End If
MyBase.DetachSink()
End Sub
'This new event will fire when the page is navigating
Public Delegate Sub WebBrowserNavigatingExtendedEventHandler(ByVal sender As Object, ByVal e As WebBrowserNavigatingExtendedEventArgs)
Public Event NavigatingExtended As WebBrowserNavigatingExtendedEventHandler
'This event will fire when a new window is about to be opened
Public Delegate Sub WebBrowserNewWindowExtendedEventHandler(ByVal sender As Object, ByVal e As WebBrowserNewWindowExtendedEventArgs)
Public Event NewWindowExtended As WebBrowserNewWindowExtendedEventHandler
Protected Friend Sub OnNavigatingExtended(ByVal Url As String, ByVal Frame As String, ByVal Postdata As Byte(), ByVal Headers As String, ByRef Cancel As Boolean)
Dim e As WebBrowserNavigatingExtendedEventArgs = New WebBrowserNavigatingExtendedEventArgs(Url, Frame, Postdata, Headers)
RaiseEvent NavigatingExtended(Me, e)
Cancel = e.Cancel
End Sub
Protected Friend Sub OnNewWindowExtended(ByVal Url As String, ByRef Cancel As Boolean, ByVal Flags As NWMF, ByVal UrlContext As String)
Dim e As WebBrowserNewWindowExtendedEventArgs = New WebBrowserNewWindowExtendedEventArgs(Url, UrlContext, Flags)
RaiseEvent NewWindowExtended(Me, e)
Cancel = e.Cancel
End Sub
Public Overloads Sub Navigate2(ByVal URL As String)
MyBase.Navigate(URL)
End Sub
#End Region
#Region " Extended Event Classes "
'This class will capture events from the WebBrowser
Friend Class WebBrowserExtendedEvents
Inherits System.Runtime.InteropServices.StandardOleMarshalObject
Implements DWebBrowserEvents2
Private m_Browser As eWebbrowser
Public Sub New(ByVal browser As eWebbrowser)
m_Browser = browser
End Sub
'Implement whichever events you wish
Public Sub BeforeNavigate2(ByVal pDisp As Object, ByRef URL As String, ByRef flags As Object, ByRef targetFrameName As String, ByRef postData As Object, ByRef headers As String, ByRef cancel As Boolean) Implements DWebBrowserEvents2.BeforeNavigate2
m_Browser.OnNavigatingExtended(URL, targetFrameName, CType(postData, Byte()), headers, cancel)
End Sub
Public Sub NewWindow3(ByVal pDisp As Object, ByRef Cancel As Boolean, ByRef Flags As Object, ByRef UrlContext As String, ByRef Url As String) Implements DWebBrowserEvents2.NewWindow3
m_Browser.OnNewWindowExtended(Url, Cancel, CType(Flags, NWMF), UrlContext)
End Sub
End Class
Public Class WebBrowserNewWindowExtendedEventArgs
Inherits CancelEventArgs
Private m_Url As String
Private m_UrlContext As String
Private m_Flags As NWMF
Public ReadOnly Property Url() As String
Get
Return m_Url
End Get
End Property
Public ReadOnly Property UrlContext() As String
Get
Return m_UrlContext
End Get
End Property
Public ReadOnly Property Flags() As NWMF
Get
Return m_Flags
End Get
End Property
Public Sub New(ByVal url As String, ByVal urlcontext As String, ByVal flags As NWMF)
m_Url = url
m_UrlContext = urlcontext
m_Flags = flags
End Sub
End Class
'First define a new EventArgs class to contain the newly exposed data
Public Class WebBrowserNavigatingExtendedEventArgs
Inherits CancelEventArgs
Private m_Url As String
Private m_Frame As String
Private m_Postdata() As Byte
Private m_Headers As String
Public ReadOnly Property Url() As String
Get
Return m_Url
End Get
End Property
Public ReadOnly Property Frame() As String
Get
Return m_Frame
End Get
End Property
Public ReadOnly Property Headers() As String
Get
Return m_Headers
End Get
End Property
Public ReadOnly Property Postdata() As String
Get
Return PostdataToString(m_Postdata)
End Get
End Property
Public ReadOnly Property PostdataByte() As Byte()
Get
Return m_Postdata
End Get
End Property
Public Sub New(ByVal url As String, ByVal frame As String, ByVal postdata As Byte(), ByVal headers As String)
m_Url = url
m_Frame = frame
m_Postdata = postdata
m_Headers = headers
End Sub
Private Function PostdataToString(ByVal p() As Byte) As String
'not sexy but it works...
Dim tabpd() As Byte, bstop As Boolean = False, stmp As String = "", i As Integer = 0
tabpd = p
If tabpd Is Nothing OrElse tabpd.Length = 0 Then
Return ""
Else
For i = 0 To tabpd.Length - 1
stmp += ChrW(tabpd(i))
Next
stmp = Replace(stmp, ChrW(13), "")
stmp = Replace(stmp, ChrW(10), "")
stmp = Replace(stmp, ChrW(0), "")
End If
If stmp = Nothing Then
Return ""
Else
Return stmp
End If
End Function
End Class
#End Region
<ComImport(), Guid("64AB4BB7-111E-11D1-8F79-00C04FC2FBE1")> _
Public Class ShellUIHelper
'
End Class
End Class
form load:
Public WithEvents wb As eWebbrowser
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
Dim brws As New eWebbrowser
wb = brws
End Sub
Events:
Private Sub wb_NewWindow(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) Handles wb.NewWindow
e.Cancel = True
End Sub
The New Event:
Private Sub wb_NewWindowExtended(ByVal sender As Object, ByVal e As eWebbrowser.WebBrowserNewWindowExtendedEventArgs) Handles wb.NewWindowExtended
e.Cancel = True
Dim url As String = e.Url
msgbox(url) //This Is The Url!!
End Sub

Control VB.NET generation

I would like to fix a generation problem that happen with a new control within an interface.
My control is not visible in the interface but add new properties to existing controls.
Each time that I run the program it remove the object, compile then recreate it. Normally,
I lost nothing but it happened that one time I had an error and it did not recreate the control with all the stuff I had entered. So every single property that I had associated to other controls got lost and these are crucial for the application.
I tried to put my control in an other DLL but I had the same problem.
My control code :
Imports System.Windows.Forms
Imports System.ComponentModel
Imports Ministere.MQP.Commun.Enums
''' <summary>
''' Ajoute 3 nouvelles propriétés aux contrôles pour la recherche dynamique d'MQP
''' </summary>
<ProvideProperty("Champ", GetType(Control))> _
<ProvideProperty("Valeur", GetType(Control))> _
<ProvideProperty("Comparaison", GetType(Control))> _
Public Class ProprietesEtendues
Implements IExtenderProvider
Private _champ As New Dictionary(Of IntPtr, String)
Private _val As New Dictionary(Of IntPtr, Object)
Private _comp As New Dictionary(Of IntPtr, CompareType)
'Propriété champ de la base de donnée
Public Function GetChamp(ByVal c As Control) As String
Dim strRetour As String = ""
_champ.TryGetValue(c.Handle, strRetour)
Return strRetour
End Function
<DefaultValue("")> _
Public Sub SetChamp(ByVal c As Control, ByVal value As String)
_champ(c.Handle) = value
End Sub
'Propriété Valeur
<TypeConverter(GetType(StringConverter))> _
Public Function GetValeur(ByVal c As Control) As Object
Dim objRetour As Object = Nothing
_val.TryGetValue(c.Handle, objRetour)
Return objRetour
End Function
<DefaultValue("")> _
<TypeConverter(GetType(StringConverter))> _
Public Sub SetValeur(ByVal c As Control, ByVal value As Object)
_val(c.Handle) = value
End Sub
'Propriété Comparaison
Public Function GetComparaison(ByVal c As Control) As CompareType
Dim ctRetour As CompareType = CompareType.Egal
_comp.TryGetValue(c.Handle, ctRetour)
Return ctRetour
End Function
<DefaultValue(CompareType.Egal)> _
Public Sub SetComparaison(ByVal c As Control, ByVal value As CompareType)
_comp(c.Handle) = value
End Sub
Public Function CanExtend(ByVal target As [Object]) As Boolean Implements IExtenderProvider.CanExtend
Return True
End Function
End Class

DirectCast(False, Nullable(Of Boolean)) error

I took some code from a C# project and put it into a converter. The original code was:
(Nullable<bool>)false
and the converter said the VB equivalent is:
DirectCast(False, Nullable(Of Boolean))
I even compiled the C# project and looked at it in Reflector. It gave the same VB code as above, but this generates the error:
Value of type 'Boolean' cannot be converted to 'Boolean?'
How do I cast this properly?
More Code as requested:
Imports System.Windows
Imports System.Windows.Controls.Primitives
Imports System.Windows.Input
Public Class VirtualToggleButton
Public Shared ReadOnly IsCheckedProperty As DependencyProperty = DependencyProperty.RegisterAttached("IsChecked", _
GetType(Nullable(Of Boolean)), _
GetType(VirtualToggleButton), _
New FrameworkPropertyMetadata(DirectCast(False, Nullable(Of Boolean)), _
FrameworkPropertyMetadataOptions.BindsTwoWayByDefault Or _
FrameworkPropertyMetadataOptions.Journal, _
New PropertyChangedCallback(AddressOf OnIsCheckedChanged)))
Public Shared Function GetIsChecked(ByVal d As DependencyObject) As Nullable(Of Boolean)
Return DirectCast(d.GetValue(IsCheckedProperty), Nullable(Of Boolean))
End Function
Public Shared Sub SetIsChecked(ByVal d As DependencyObject, ByVal value As Nullable(Of Boolean))
d.SetValue(IsCheckedProperty, value)
End Sub
Private Shared Sub OnIsCheckedChanged(ByVal d As DependencyObject, ByVal e As DependencyPropertyChangedEventArgs)
Dim pseudobutton As UIElement = TryCast(d, UIElement)
If pseudobutton IsNot Nothing Then
Dim newValue As Nullable(Of Boolean) = DirectCast(e.NewValue, Nullable(Of Boolean))
If newValue = True Then
RaiseCheckedEvent(pseudobutton)
ElseIf newValue = False Then
RaiseUncheckedEvent(pseudobutton)
Else
RaiseIndeterminateEvent(pseudobutton)
End If
End If
End Sub
Public Shared ReadOnly IsThreeStateProperty As DependencyProperty = DependencyProperty.RegisterAttached("IsThreeState", _
GetType(Boolean), _
GetType(VirtualToggleButton), _
New FrameworkPropertyMetadata(CBool(False)))
Public Shared Function GetIsThreeState(ByVal d As DependencyObject) As Boolean
Return CBool(d.GetValue(IsThreeStateProperty))
End Function
Public Shared Sub SetIsThreeState(ByVal d As DependencyObject, ByVal value As Boolean)
d.SetValue(IsThreeStateProperty, value)
End Sub
Public Shared ReadOnly IsVirtualToggleButtonProperty As DependencyProperty = DependencyProperty.RegisterAttached("IsVirtualToggleButton", _
GetType(Boolean), _
GetType(VirtualToggleButton), _
New FrameworkPropertyMetadata(CBool(False), _
New PropertyChangedCallback(AddressOf OnIsVirtualToggleButtonChanged)))
Public Shared Function GetIsVirtualToggleButton(ByVal d As DependencyObject) As Boolean
Return CBool(d.GetValue(IsVirtualToggleButtonProperty))
End Function
Public Shared Sub SetIsVirtualToggleButton(ByVal d As DependencyObject, ByVal value As Boolean)
d.SetValue(IsVirtualToggleButtonProperty, value)
End Sub
Private Shared Sub OnIsVirtualToggleButtonChanged(ByVal d As DependencyObject, ByVal e As DependencyPropertyChangedEventArgs)
Dim element As IInputElement = TryCast(d, IInputElement)
If element IsNot Nothing Then
If CBool(e.NewValue) Then
AddHandler element.MouseLeftButtonDown, New MouseButtonEventHandler(AddressOf VirtualToggleButton.OnMouseLeftButtonDown)
AddHandler element.KeyDown, New KeyEventHandler(AddressOf VirtualToggleButton.OnKeyDown)
Else
RemoveHandler element.MouseLeftButtonDown, New MouseButtonEventHandler(AddressOf VirtualToggleButton.OnMouseLeftButtonDown)
RemoveHandler element.KeyDown, New KeyEventHandler(AddressOf VirtualToggleButton.OnKeyDown)
End If
End If
End Sub
Friend Shared Function RaiseCheckedEvent(ByVal target As UIElement) As RoutedEventArgs
If target Is Nothing Then
Return Nothing
End If
Dim args As New RoutedEventArgs()
args.RoutedEvent = ToggleButton.CheckedEvent
[RaiseEvent](target, args)
Return args
End Function
Friend Shared Function RaiseUncheckedEvent(ByVal target As UIElement) As RoutedEventArgs
If target Is Nothing Then
Return Nothing
End If
Dim args As New RoutedEventArgs()
args.RoutedEvent = ToggleButton.UncheckedEvent
[RaiseEvent](target, args)
Return args
End Function
Friend Shared Function RaiseIndeterminateEvent(ByVal target As UIElement) As RoutedEventArgs
If target Is Nothing Then
Return Nothing
End If
Dim args As New RoutedEventArgs()
args.RoutedEvent = ToggleButton.IndeterminateEvent
[RaiseEvent](target, args)
Return args
End Function
Private Shared Sub OnMouseLeftButtonDown(ByVal sender As Object, ByVal e As MouseButtonEventArgs)
e.Handled = True
UpdateIsChecked(TryCast(sender, DependencyObject))
End Sub
Private Shared Sub OnKeyDown(ByVal sender As Object, ByVal e As KeyEventArgs)
If e.OriginalSource Is sender Then
If e.Key = Key.Space Then
If (Keyboard.Modifiers And ModifierKeys.Alt) = ModifierKeys.Alt Then
Return
End If
UpdateIsChecked(TryCast(sender, DependencyObject))
e.Handled = True
ElseIf e.Key = Key.Enter AndAlso CBool(TryCast(sender, DependencyObject).GetValue(KeyboardNavigation.AcceptsReturnProperty)) Then
UpdateIsChecked(TryCast(sender, DependencyObject))
e.Handled = True
End If
End If
End Sub
Private Shared Sub UpdateIsChecked(ByVal d As DependencyObject)
Dim isChecked As Nullable(Of Boolean) = GetIsChecked(d)
If isChecked = True Then
SetIsChecked(d, If(GetIsThreeState(d), DirectCast(Nothing, Nullable(Of Boolean)), DirectCast(False, Nullable(Of Boolean))))
Else
SetIsChecked(d, isChecked.HasValue)
End If
End Sub
Private Shared Sub [RaiseEvent](ByVal target As DependencyObject, ByVal args As RoutedEventArgs)
If TypeOf target Is UIElement Then
TryCast(target, UIElement).[RaiseEvent](args)
ElseIf TypeOf target Is ContentElement Then
TryCast(target, ContentElement).[RaiseEvent](args)
End If
End Sub
End Class
It looks like you can just remove the DirectCast. From what I see you are passing a false into a function/method that has a Boolean? (or Nullable(of Boolean)) as a parameter. VB does not need the explicit casting that C# requires (although it's not a bad idea in some cases). For a simple example,
Private Function DoSomething(byval param as Boolean?) as Boolean?
'do something and return a Nullable(of Boolean)
End Function
DoSomething(false) 'is just fine, no DirectCast needed
DoSomething(nothing) 'is also fine
DoSomething(true) 'fine
DoSomething(DirectCast(false, Nullable(of Boolean)) 'will give you the error you described
Just as a side note, in case it is confusing Nullable(of Boolean) and Boolean? mean the same thing which is that it is a boolean variable that can have a value of true, false or nothing.
TKTS is correct that VB normally doesn't need the explicit cast, but, for completeness, the "correct" conversion would be:
New Boolean?(False)