Partager via

Use WPF and inline XAML in your Fox, Excel or VB6 applications

  • Article

My prior post showed how to create XAML WPF and put it on your Winform App. We can go one step further: add XAML to a UserControl, which could then be made into an ActiveX control, which could be hosted by Fox, VB6, or Excel.

Start Visual Studio 2008 (as admin on Vista!! : (to register for COM interop, you need admin privileges))

Choose File->New Project->Visual Basic->Windows->Class Library. Call it WPFClass

From the Solution Explorer, delete Class1.vb, then right click on the WPFClass project (not the WPFClass solution), choose Add New Item, choose Windows Forms->User Control, call it WPFControl.vb

From Project->Properties->Application, make sure the Root Namespace is WPFClass and not ClassLibrary1. (If you don’t the ProgId for the control will be ClassLibrary1. WPFClass). Now the ProgId will be WPFClass. WPFControl

Also, choose Project->Properties->Compile->Register for COM Interop

You just created a control with a design surface.

Add references to

PresentationCore

PresentationFrameWork

WindowsBase

WindowsFormsIntegration

Choose View->Code. Paste in the Sample Code below, then hit F5. The UserControl is automatically instantiated and shown inside the UserControl TestContainer. The sample code is basically the same as the prior post, except that it is a UserControl and has another method called SetXAML, which allows a client to change the XAML on the fly of the instantiated control.

Change Project->Properties->Debug->Start Action->Start External Program and navigate to Excel.Exe or Visual Foxpro.(VFP9.EXE)

In Excel, (2003 or 2007) choose Developer->Visual Basic (2007) or Tools->Macros->VB Editor (2003). Same hotkey for both: Alt-F11. In the VB Editor, insert a User Form. Right click on the Toolbox-.Additional Controls. Check WPFClass.WPFControl. Drag it onto the form.

This Fox client code dynamically generates new XAML code for the control to use with inline XAML when you hit the button. It creates a listbox with the names of some pictures or movies. It has a single MediaElement which is databound to the ListBox. As you click on an item, it displays. Notice how we can use styles for the listbox by adding a Style resource to the Canvas that applies to all ListBoxItems for that Canvas.

Make sure you change the path to some pictures/movies

Try creating an error in your Fox XAML and you'll see a MessageBox showing the error.

<FoxClient Code>

PUBLIC ox

ox=CREATEOBJECT("myform")

ox.show

DEFINE CLASS myform AS form

      left=100

      allowoutput=.f.

      width=900

      height=700

      ADD OBJECT btn as commandbutton WITH caption="Change XAML"

      PROCEDURE Init

            this.AddObject("ocWPF","OleControl","WPFClass.WPFControl")

            this.ocWPF.visible=1

            this.ocWPF.Top=20

            this.ocWPF.width=thisform.Width-100

            this.ocWPF.height=thisform.Height-100

      PROCEDURE btn.Click

      *Use Fox inline TEXT function to create new XAML content

            TEXT TO xaml textmerge noshow

        <Canvas Name="MyPanel"

            xmlns="https://schemas.microsoft.com/winfx/2006/xaml/presentation"

            xmlns:x="https://schemas.microsoft.com/winfx/2006/xaml"

            Background="AliceBlue"

            >

                  <Canvas.Resources>

                        <Style

      TargetType="ListBoxItem">

      <Setter Property="Foreground" Value="Blue"/>

      <Style.Triggers>

      <Trigger Property="IsSelected" Value="True">

      <Setter Property="Foreground" Value="White"/>

      <Setter Property="Background" Value="Aquamarine"/>

      </Trigger>

      <Trigger Property="IsMouseOver" Value="True">

      <Setter Property="Foreground" Value="Red"/>

      </Trigger>

      </Style.Triggers>

                        </Style>

                  </Canvas.Resources>

                  <TextBlock Canvas.Top="5" Canvas.Left="300" Height="20" Foreground="Red" Background="LightGreen">

                        <TextBlock.Text>

                              <Binding ElementName="MyListBox" Path="SelectedItem.Content.Text"/>

                        </TextBlock.Text>

                  </TextBlock>

            <Grid Canvas.Top="25" >

      <Grid.ColumnDefinitions>

      <ColumnDefinition/>

      <ColumnDefinition/>

      </Grid.ColumnDefinitions>

      <Grid.RowDefinitions>

      <RowDefinition/>

      </Grid.RowDefinitions>

    <ListBox Name="MyListBox" Height="300" Grid.Column="0">

        ENDTEXT

        SET TEXTMERGE ON TO memvar xaml ADDITIVE

        cPath="e:\pictures\2007\12\02\" && Some path with pictures/movies

        nFiles=ADIR(aaFiles,cPath+"*.*")

        FOR i = 1 TO nFiles

        IF LOWER(JUSTEXT(aaFiles[i,1]))$"jpg avi"

      \<ListBoxItem Width="240"><TextBlock>

      \<<cPath+TRANSFORM(aaFiles(i,1))>>

      \</TextBlock>

      \</ListBoxItem>

      ENDIF

        ENDFOR

        SET TEXTMERGE to

            TEXT TO xaml textmerge NOSHOW ADDITIVE

                  </ListBox>

                  <MediaElement Grid.Column="1" Height="300">

                        <MediaElement.Source>

                              <Binding ElementName="MyListBox" Path="SelectedItem.Content.Text"/>

                        </MediaElement.Source>

                  </MediaElement>

                  </Grid>

        </Canvas>

            ENDTEXT

            ?xaml

            thisform.ocWPF.SetXAML(xaml)

ENDDEFINE

</FoxClient Code>

See also:

Create a .Net UserControl that calls a web service that acts as an ActiveX control to use in Excel, VB6, Foxpro

<Sample Code>

Imports System.Windows.Forms.Integration

Imports System.Windows.Controls

Imports System.Windows.Media

Imports System.Windows.Input

Imports Microsoft.Win32

Imports System.Windows.Forms

Imports System.Runtime.InteropServices

' the Guids are gen'd from UUIDGEN.

<Microsoft.VisualBasic.ComClass("2c8298fa-f4d2-4c18-9a99-280d83ac3f03", "397d45fd-4621-4278-ab5a-8d28f9120dc1")> _

Public Class WPFControl

    Sub New()

        ' This call is required by the Windows Form Designer.

        InitializeComponent()

        ' Add any initialization after the InitializeComponent() call.

        Me.Width = 800

        Me.Height = 600

        Me.BackColor = System.Drawing.Color.AliceBlue

        Dim elemHost As New ElementHost

        Me.Controls.Add(elemHost)

        elemHost.Top = 30 ' move down a little bit

        'see https://blogs.msdn.com/calvin\_hsia/archive/2007/11/29/6600915.aspx

        Dim xaml = _

        <Canvas Name="MyPanel"

            xmlns="https://schemas.microsoft.com/winfx/2006/xaml/presentation"

            xmlns:x="https://schemas.microsoft.com/winfx/2006/xaml"

            Background="LightGreen"

            >

            <TextBlock Name="MyTextBlock" Canvas.Top="10">WPF Embedded Hi there

                <TextBlock.Triggers>

                    <EventTrigger RoutedEvent="TextBlock.Loaded">

                        <BeginStoryboard>

                            <Storyboard>

                                <DoubleAnimation

                                    Storyboard.TargetName="MyTextBlock"

                             Storyboard.TargetProperty="(Opacity)"

                                    From="1.0" To=".10" Duration="0:0:1" AutoReverse="True" RepeatBehavior="Forever"/>

                            </Storyboard>

                        </BeginStoryboard>

       </EventTrigger>

                </TextBlock.Triggers>

            </TextBlock>

            <Ellipse Height="150" HorizontalAlignment="Left" Canvas.Top="30">

                <Ellipse.Fill>

                    <SolidColorBrush x:Name="ebrush" Color="Black"/>

                </Ellipse.Fill>

                <Ellipse.Triggers>

                    <EventTrigger RoutedEvent="Ellipse.Loaded">

                        <BeginStoryboard>

                            <Storyboard

                           TargetProperty="(Ellipse.Width)">

                                <DoubleAnimation From="20" To="200" Duration="0:0:5" AutoReverse="True" RepeatBehavior="Forever"/>

                                <ColorAnimation

                                    Storyboard.TargetName="ebrush"

                                    Storyboard.TargetProperty="Color"

                                    From="Red" To="Blue" Duration="0:0:3" AutoReverse="True" RepeatBehavior="Forever"/>

                            </Storyboard>

                        </BeginStoryboard>

                    </EventTrigger>

                </Ellipse.Triggers>

            </Ellipse>

        </Canvas>

        elemHost.Child = CType(System.Windows.Markup.XamlReader.Load(xaml.CreateReader), System.Windows.UIElement)

        Dim MyCanvas = CType(elemHost.Child, Canvas)

        elemHost.Height = 400

        elemHost.Width = 600

        Dim btn As New Windows.Forms.Button ' This is a WinForms button: not a wpf System.Windows.Controls.Button

  btn.Visible = True

        btn.Text = "Winform Btn to launch WPF form"

        btn.AutoSize = True

        btn.BackColor = System.Drawing.Color.Bisque

        Dim WinFormHost = New WindowsFormsHost

        WinFormHost.Child = btn

        AddHandler btn.Click, AddressOf btn_Click

        Canvas.SetTop(WinFormHost, 80)

        MyCanvas.Children.Add(WinFormHost)

        MyCanvas.RenderTransform = New ScaleTransform(1, 1)

        AddHandler MyCanvas.MouseWheel, AddressOf MyCanvas_MouseWheel

    End Sub

    Public Sub SetXAML(ByVal xaml As String)

        Try

            Dim tr As New IO.StringReader(xaml)

            Dim xml = XElement.Load(tr)

            Dim x = System.Windows.Markup.XamlReader.Load(xml.CreateReader)

            Dim elemHost = CType(Me.Controls(0), ElementHost)

            elemHost.Child = x

        Catch ex As Exception

            MessageBox.Show(ex.Message)

        End Try

    End Sub

    Sub btn_Click()

        Dim oWPFForm = New WPFForm

        oWPFForm.ShowDialog()

    End Sub

    Sub MyCanvas_MouseWheel(ByVal o As Canvas, ByVal e As MouseWheelEventArgs)

        Dim tr = CType(o.RenderTransform, ScaleTransform)

        If e.Delta > 0 Then

            tr.ScaleX *= 1.1

            tr.ScaleY *= 1.1

        Else

            tr.ScaleX /= 1.1

            tr.ScaleY /= 1.1

        End If

    End Sub

    <ComRegisterFunction()> _

        Public Shared Sub Register(ByVal t As Type)

        ComRegistration.RegisterControl(t)

    End Sub

    <ComUnregisterFunction()> _

    Public Shared Sub Unregister(ByVal t As Type)

        ComRegistration.UnregisterControl(t)

    End Sub

    Private Sub WPFControl_MouseDown(ByVal sender As Object, ByVal e As System.Windows.Forms.MouseEventArgs) Handles Me.MouseDown

        MsgBox("AA")

    End Sub

End Class

Class WPFForm : Inherits Windows.Window

    Sub New()

        Dim xaml = _

        <StackPanel

            xmlns="https://schemas.microsoft.com/winfx/2006/xaml/presentation"

            xmlns:x="https://schemas.microsoft.com/winfx/2006/xaml"

         Orientation="Vertical"

            >

            <TextBlock>WPFForm Hi there</TextBlock>

        </StackPanel>

        Me.Content = System.Windows.Markup.XamlReader.Load(xaml.CreateReader)

    End Sub

End Class

Friend Module ComRegistration

    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)

                ' Control

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

                End Using

                ' Misc

                Using miscKey As RegistryKey = subkey.CreateSubKey("MiscStatus")

                    miscKey.SetValue("", "131457", RegistryValueKind.String)

                End Using

                ' TypeLib

                Using typeLibKey As RegistryKey = subkey.CreateSubKey("TypeLib")

            Dim libId As Guid = System.Runtime.InteropServices.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

                    System.Runtime.InteropServices.Marshal.GetTypeLibVersionForAssembly(t.Assembly, major, minor)

                    versionKey.SetValue("", String.Format("{0}.{1}", major, minor))

                End Using

            End Using

        Catch ex As Exception

            HandleException("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

            HandleException("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(System.Windows.Forms.Control).IsAssignableFrom(t) Then

            Throw New ArgumentException("Type argument must be a Windows Forms control.")

        End If

    End Sub

    Private Sub HandleException(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 Exception(message, ex) ' replace with custom exception type

        Catch ex2 As Exception

            My.Application.Log.WriteException(ex2)

        End Try

  End Sub

End Module

</Sample Code>

Comments