Click here to Skip to main content
Click here to Skip to main content
Articles » Languages » VB6 Interop » General » Downloads
 
Add your own
alternative version

Interop Forms Toolkit 2.0 Tutorial

, 16 Jun 2007 CPOL
Interop Forms Toolkit 2.0 is a new bridging tool allowing developers to use .NET Forms and .NET UserControls in VB6. This tutorial demonstrates how to add webservices, multithreading, and XAML to VB6 projects. It also provides custom C# Interop UserControl templates for use with the Toolkit.
csharp_samples.zip
XamlUserControl
bin
Debug
XamlUserControl.dll
images
roundcornersheet.png
Star.png
obj
Debug
TempPE
UserControl1.baml
XamlUserControl.dll
Properties
Settings.settings
CSDailyDilbertControl
CSDailyDilbertControl
bin
Debug
CSDailyDilbertControl.dll
CSDailyDilbertControl.tlb
Dilbert.bmp
InteropUserControl.bmp
InteropUserControl.manifest
InteropUserControl.res
obj
Debug
CSDailyDilbertControl.dll
Refactor
TempPE
Web References.DDService.Reference.cs.dll
Properties
Settings.settings
Web References
DDService
DailyDiblert.disco
DailyDiblert.wsdl
Reference.map
CSMultithreadedControl
CSMultithreadedControl
bin
Debug
obj
Debug
Refactor
TempPE
Properties
CSXamlEmbeddedForm
CSXamlEmbeddedForm
bin
Debug
CSXamlEmbeddedForm.dll
CSXamlEmbeddedForm.tlb
PresentationCore.dll
System.Printing.dll
XamlUserControl.dll
InteropForm Wrapper Classes
obj
Debug
CSXamlEmbeddedForm.dll
Refactor
TempPE
Documents and Settings
jashley.CORPORATE
My Documents
Visual Studio 2005
Projects
CSMultithreadedControl
CSMultithreadedControl
bin
Debug
obj
Debug
Refactor
TempPE
Properties
bin
Debug
obj
Debug
Refactor
TempPE
Properties
InteropUserControl.bmp
InteropUserControl.manifest
InteropUserControl.res
csinteropusercontrolitemtemplate.zip
__TemplateIcon.ico
InteropUserControl.vstemplate
csinteropusercontrolprojecttemplate.zip
InteropUserControl.manifest
InteropUserControl.res
__TemplateIcon.ico
csinteropusercontrollibrary.vstemplate
InteropUserControl.bmp
source_code.zip
DailyDilbertControl
DailyDilbertControl
bin
Debug
DailyDilbertControl.dll
DailyDilbertControl.tlb
Dilbert.bmp
InteropUserControl.bmp
InteropUserControl.manifest
InteropUserControl.RES
My Project
Application.myapp
Settings.settings
obj
Debug
DailyDilbertControl.dll
TempPE
My Project.Resources.Designer.vb.dll
Web References.DDService.Reference.vb.dll
Resources
Web References
DDService
DailyDiblert.disco
DailyDiblert.wsdl
Reference.map
XamlUserControl.dll
roundcornersheet.png
Star.png
UserControl1.baml
XamlUserControl.dll
Settings.settings
MultithreadedControl
bin
Debug
MultithreadedControl.dll
MultithreadedControl.tlb
InteropUserControl.bmp
InteropUserControl.manifest
InteropUserControl.res
My Project
Application.myapp
obj
Debug
MultithreadedControl.dll
TempPE
VB6Project
Form1.frm
Project1.vbp
Project1.vbw
XamlEmbeddedForm
bin
Debug
PresentationCore.dll
System.Printing.dll
XamlEmbeddedForm.dll
XamlEmbeddedForm.tlb
XamlUserControl.dll
XamlUserControl.pdb
zh-CHS
PresentationCore.resources.dll
System.Printing.resources.dll
InteropForm Wrapper Classes
My Project
Application.myapp
Settings.settings
obj
Debug
TempPE
XamlEmbeddedForm.dll
VB6Project
Form1.frm
Project1.vbp
Project1.vbw
Imports Microsoft.InteropFormTools

#If COM_INTEROP_ENABLED Then

'Adds the InteropToolbox to the My namespace
Namespace My
    'The HideModuleNameAttribute hides the module name MyInteropToolbox so the syntax becomes My.InteropToolbox.   
    <Global.Microsoft.VisualBasic.HideModuleName()> _
    Module MyInteropToolbox

        Private _toolbox As New InteropToolbox

        Public ReadOnly Property InteropToolbox() As InteropToolbox
            Get
                Return _toolbox
            End Get
        End Property
    End Module
End Namespace

'Helper routines to do additional registration needed by ActiveX controls.
Friend Module ComRegistration

    Const OLEMISC_RECOMPOSEONRESIZE As Integer = 1
    Const OLEMISC_CANTLINKINSIDE As Integer = 16
    Const OLEMISC_INSIDEOUT As Integer = 128
    Const OLEMISC_ACTIVATEWHENVISIBLE As Integer = 256
    Const OLEMISC_SETCLIENTSITEFIRST As Integer = 131072

    Public Sub RegisterControl(ByVal t As Type)

        Try
            GuardNullType(t, "t")
            GuardTypeIsControl(t)

            'CLSID
            Dim key As String = "CLSID\" & t.GUID.ToString("B")

            Using subkey As RegistryKey = Registry.ClassesRoot.OpenSubKey(key, True)

                'InProcServer32
                Dim InprocKey As RegistryKey = subkey.OpenSubKey("InprocServer32", True)
                If InprocKey IsNot Nothing Then
                    InprocKey.SetValue(Nothing, Environment.SystemDirectory & "\mscoree.dll")
                End If

                'Control
                Using controlKey As RegistryKey = subkey.CreateSubKey("Control")
                End Using

                'Misc
                Using miscKey As RegistryKey = subkey.CreateSubKey("MiscStatus")
                    Dim MiscStatusValue As Integer = OLEMISC_RECOMPOSEONRESIZE + _
                        OLEMISC_CANTLINKINSIDE + OLEMISC_INSIDEOUT + _
                        OLEMISC_ACTIVATEWHENVISIBLE + OLEMISC_SETCLIENTSITEFIRST

                    miscKey.SetValue("", MiscStatusValue.ToString, RegistryValueKind.String)
                End Using

                'ToolBoxBitmap32
                Using bitmapKey As RegistryKey = subkey.CreateSubKey("ToolBoxBitmap32")

                    'If you want to have different icons for each control in this assembly
                    'you can modify this section to specify a different icon each time.
                    'Each specified icon must be embedded as a win32resource in the
                    'assembly; the default one is at index 101, but you can additional ones.
                    bitmapKey.SetValue("", Assembly.GetExecutingAssembly.Location & ", 101", _
                                       RegistryValueKind.String)
                End Using

                'TypeLib
                Using typeLibKey As RegistryKey = subkey.CreateSubKey("TypeLib")
                    Dim libId As Guid = Marshal.GetTypeLibGuidForAssembly(t.Assembly)
                    typeLibKey.SetValue("", libId.ToString("B"), RegistryValueKind.String)
                End Using

                'Version
                Using versionKey As RegistryKey = subkey.CreateSubKey("Version")
                    Dim major, minor As Integer
                    Marshal.GetTypeLibVersionForAssembly(t.Assembly, major, minor)
                    versionKey.SetValue("", String.Format("{0}.{1}", major, minor))
                End Using

            End Using

        Catch ex As Exception
            LogAndRethrowException("ComRegisterFunction failed.", t, ex)
        End Try

    End Sub

    Public Sub UnregisterControl(ByVal t As Type)
        Try
            GuardNullType(t, "t")
            GuardTypeIsControl(t)

            'CLSID
            Dim key As String = "CLSID\" & t.GUID.ToString("B")
            Registry.ClassesRoot.DeleteSubKeyTree(key)

        Catch ex As Exception
            LogAndRethrowException("ComUnregisterFunction failed.", t, ex)
        End Try

    End Sub

    Private Sub GuardNullType(ByVal t As Type, ByVal param As String)
        If t Is Nothing Then
            Throw New ArgumentException("The CLR type must be specified.", param)
        End If
    End Sub

    Private Sub GuardTypeIsControl(ByVal t As Type)
        If Not GetType(Control).IsAssignableFrom(t) Then
            Throw New ArgumentException("Type argument must be a Windows Forms control.")
        End If
    End Sub

    Private Sub LogAndRethrowException(ByVal message As String, ByVal t As Type, ByVal ex As Exception)
        Try
            If t IsNot Nothing Then
                message &= vbCrLf & String.Format("CLR class '{0}'", t.FullName)
            End If

            Throw New ComRegistrationException(message, ex)

        Catch ex2 As Exception
            My.Application.Log.WriteException(ex2)
        End Try

    End Sub

End Module

<Serializable()> _
Public Class ComRegistrationException
    Inherits Exception

    Public Sub New()

    End Sub

    Public Sub New(ByVal message As String, ByVal inner As Exception)
        MyBase.New(message, inner)
    End Sub

End Class

'Helper functions to convert common COM types to their .NET equivalents
<ComVisible(False)> _
Friend Class ActiveXControlHelpers
    Inherits System.Windows.Forms.AxHost

    Friend Sub New()
        MyBase.New(Nothing)
    End Sub

    Friend Shared Shadows Function GetColorFromOleColor(ByVal oleColor As Integer) As Color
        Return AxHost.GetColorFromOleColor(CIntToUInt(oleColor))
    End Function

    Friend Shared Shadows Function GetOleColorFromColor(ByVal color As Color) As Integer
        Return CUIntToInt(AxHost.GetOleColorFromColor(color))
    End Function

    Friend Shared Function CUIntToInt(ByVal uiArg As UInteger) As Integer
        If uiArg <= Integer.MaxValue Then
            Return CInt(uiArg)
        End If
        Return CInt(uiArg - 2 * (CUInt(Integer.MaxValue) + 1))
    End Function

    Friend Shared Function CIntToUInt(ByVal iArg As Integer) As UInteger
        If iArg < 0 Then
            Return CUInt(UInteger.MaxValue + iArg + 1)
        End If
        Return CUInt(iArg)
    End Function

    Private Const KEY_PRESSED As Integer = &H1000
    Private Declare Function GetKeyState Lib "user32" Alias "GetKeyState" (ByVal ByValnVirtKey As Integer) As Short

    Private Shared Function CheckForAccessorKey() As Integer
        If My.Computer.Keyboard.AltKeyDown Then

            For i As Integer = Keys.A To Keys.Z
                If (GetKeyState(i) And KEY_PRESSED) <> 0 Then
                    Return i
                End If
            Next
        End If

        Return -1
    End Function

    <ComVisible(False)> _
    Friend Shared Sub HandleFocus(ByVal f As UserControl)
        If My.Computer.Keyboard.AltKeyDown Then
            HandleAccessorKey(f.GetNextControl(Nothing, True), f)
        Else
            'Move to the first control that can receive focus, taking into account
            'the possibility that the user pressed <Shift>+<Tab>, in which case we
            'need to start at the end and work backwards.
            Dim ctl As Control = f.GetNextControl(Nothing, Not My.Computer.Keyboard.ShiftKeyDown)
            While ctl IsNot Nothing
                If ctl.Enabled AndAlso ctl.CanSelect Then
                    ctl.Focus()
                    Exit While
                Else
                    ctl = f.GetNextControl(ctl, Not My.Computer.Keyboard.ShiftKeyDown)
                End If
            End While

        End If
    End Sub

    Private Shared Sub HandleAccessorKey(ByVal sender As Object, ByVal f As UserControl)
        Dim key As Integer = CheckForAccessorKey()
        If key = -1 Then Return

        Dim ctlCurrent As Control = f.GetNextControl(CType(sender, Control), False)

        Do
            ctlCurrent = f.GetNextControl(ctlCurrent, True)
            If ctlCurrent IsNot Nothing AndAlso Control.IsMnemonic(ChrW(key), ctlCurrent.Text) Then

                'VB6 handles conflicts correctly already, so if we handle it also we'll end up 
                'one control past where the focus should be
                If Not KeyConflict(ChrW(key), f) Then

                    'If we land on a label or other non-selectable control then go to the next 
                    'control in the tab order
                    If Not ctlCurrent.CanSelect Then
                        Dim ctlAfterLabel As Control = f.GetNextControl(ctlCurrent, True)
                        If ctlAfterLabel IsNot Nothing AndAlso ctlAfterLabel.CanFocus Then
                            ctlAfterLabel.Focus()
                        End If
                    Else
                        ctlCurrent.Focus()
                    End If
                    Exit Do
                End If
            End If

            'Loop until we hit the end of the tab order
            'If we've hit the end of the tab order we don't want to loop back because the
            'parent form's controls come next in the tab order.
        Loop Until ctlCurrent Is Nothing
    End Sub

    Private Shared Function KeyConflict(ByVal key As Char, ByVal u As UserControl) As Boolean
        Dim flag As Boolean = False

        For Each ctl As Control In u.Controls
            If Control.IsMnemonic(key, ctl.Text) Then
                If flag Then Return True
                flag = True
            End If
        Next
        Return False
    End Function

    'Handles <Tab> and <Shift>+<Tab>
    Friend Shared Sub TabHandler(ByVal sender As Object, ByVal e As KeyEventArgs)
        If e.KeyCode = Keys.Tab Then
            Dim ctl As Control = CType(sender, Control)

            Dim userCtl As UserControl = GetParentUserControl(ctl)

            Dim firstCtl As Control = userCtl.GetNextControl(Nothing, True)
            Do Until (firstCtl Is Nothing OrElse firstCtl.CanSelect)
                firstCtl = userCtl.GetNextControl(firstCtl, True)
            Loop

            Dim lastCtl As Control = userCtl.GetNextControl(Nothing, False)
            Do Until (lastCtl Is Nothing OrElse lastCtl.CanSelect)
                lastCtl = userCtl.GetNextControl(lastCtl, False)
            Loop

            If ctl Is lastCtl OrElse ctl Is firstCtl OrElse _
                lastCtl.Contains(ctl) OrElse firstCtl.Contains(ctl) Then

                userCtl.SelectNextControl(CType(sender, Control), lastCtl Is userCtl.ActiveControl, _
                                          True, True, True)
            End If
        End If
    End Sub

    Private Shared Function GetParentUserControl(ByVal ctl As Control) As UserControl
        If ctl Is Nothing Then Return Nothing

        Do Until ctl.Parent Is Nothing
            ctl = ctl.Parent
        Loop
        If ctl IsNot Nothing Then
            Return DirectCast(ctl, UserControl)
        End If

        Return Nothing
    End Function

    Friend Shared Sub WireUpHandlers(ByVal ctl As Control, ByVal ValidationHandler As EventHandler)
        If ctl IsNot Nothing Then
            AddHandler ctl.KeyDown, AddressOf ActiveXControlHelpers.TabHandler
            AddHandler ctl.LostFocus, ValidationHandler

            If ctl.HasChildren Then
                For Each child As Control In ctl.Controls
                    WireUpHandlers(child, ValidationHandler)
                Next
            End If
        End If
    End Sub

End Class

#End If

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Share

About the Author

James Ashley
Software Developer (Senior)
United States United States
James is a program writer for a respectable software company. He is also a Microsoft MVP.

| Advertise | Privacy | Terms of Use | Mobile
Web02 | 2.8.141223.1 | Last Updated 16 Jun 2007
Article Copyright 2007 by James Ashley
Everything else Copyright © CodeProject, 1999-2014
Layout: fixed | fluid