Use WPF and inline XAML in your Fox, Excel or VB6 applications
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:
<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>