Learning WPF with F# - Routed Input Events

Examples from Chapter 9 of Petzold's book Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation. I thought I could leverage the flexible #types as described in Chapter 5 of Don Syme's Expert F# book to duplicate the Petzold's AllPurposeEventHandler. However, I do not how I can duplicate that without casting the RoutedEventArgs from the subtype to the supertype. I ended up creating the helper function handler that explicitly cast the input parameter to RoutedEventArgs

Flexible #type did work for me when I redefine addHandlers from

let addHandlers (el:UIElement) = ...

to

let addHandlers (el:#UIElement) = ...

then I can change the following block of code from

let els = [ (win :> UIElement); (grid :> UIElement); (btn :> UIElement); (text:> UIElement) ]
List.iter addHandlers els

to

      addHandlers win
      addHandlers grid
      addHandlers btn
      addHandlers text

I did not try the ShadowTheStylus because I do not have a Tablet PC to test out the code, but here are the rest:

ExamineRoutedEvents
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Documents
open System.Windows.Input
open System.Windows.Media  

let fontfam = new FontFamily("Lucida Console")

(* From Chap 9 -  ExamineRoutedEvents *)
type ExamineRoutedEvents()  = class
   inherit Application() as base 
   
   let stackOutput = new StackPanel()
   let mutable dtLast = DateTime.Now

   let TypeWithoutNamespace (obj:Object) =
      let astr = obj.GetType().ToString().Split([|'.'|])
      let retval = List.hd (List.rev (Array.to_list astr) )
      retval.ToString()

   let AllPurposeEventHandler sender (args : RoutedEventArgs) =
      // Add blank line if there's been a time gap
      let dtNow = DateTime.Now
      if ((dtNow - dtLast) > TimeSpan.FromMilliseconds(100.0)) then
         stackOutput.Children.Add(new TextBlock(new Run(" "))) |> ignore
      dtLast <- dtNow
      
      // Display event information
      let text = new TextBlock()
      text.FontFamily <- fontfam
      text.Text <- Printf.sprintf "%30s %15s %15s %15s"
                                  args.RoutedEvent.Name
                                  (TypeWithoutNamespace(sender))
                                  (TypeWithoutNamespace(args.Source))
                                  (TypeWithoutNamespace(args.OriginalSource))
      stackOutput.Children.Add(text) |> ignore
      let viewer = stackOutput.Parent :?> ScrollViewer
      viewer.ScrollToBottom()
   
   override this.OnStartup (args:StartupEventArgs ) =
      base.OnStartup(args)
      
      // Create the Window
      let win = new Window()
      win.Title <- "Examine Routed Events"
      
      // Create the Grid and make it Window content
      let grid = new Grid()
      win.Content <- grid
      
      // Make three rows
      let rowdef = new RowDefinition()
      rowdef.Height <- GridLength.Auto
      grid.RowDefinitions.Add(rowdef)
      
      let rowdef = new RowDefinition()
      rowdef.Height <- GridLength.Auto
      grid.RowDefinitions.Add(rowdef)
      
      let rowdef = new RowDefinition()
      rowdef.Height <- new GridLength(100.0,GridUnitType.Star)
      grid.RowDefinitions.Add(rowdef)
      
      // Create the Button & add it to the Grid
      let btn = new Button()
      btn.HorizontalAlignment <- HorizontalAlignment.Center
      btn.Margin <- new Thickness(24.0)
      btn.Padding <- new Thickness(24.0)
      grid.Children.Add(btn) |> ignore

      // Create the TextBlock & add it to the Button.
      let text = new TextBlock()
      text.FontSize <- 24.0
      text.Text <- win.Title
      btn.Content <- text
      
      // Create headings to display above the ScrollViewer.
      let textHeadings = new TextBlock()
      textHeadings.FontFamily <- fontfam
      let msg = Printf.sprintf "%30s %15s %15s %15s" "Routed Event"  "sender"  "Source"  "OriginalSource"
      textHeadings.Inlines.Add(new Underline(new Run(msg)))
      grid.Children.Add(textHeadings) |> ignore
      Grid.SetRow(textHeadings, 1)

      // Create the ScrollViewer.
      let scroll = new ScrollViewer()
      grid.Children.Add(scroll) |> ignore
      Grid.SetRow(scroll, 2)

      // Create the StackPanel for displaying events.
      scroll.Content <- stackOutput
      
      // add event handlers
      let addHandlers (el:UIElement) =

         // I could not get Flexible # Types to work..e.g. I was trying for
         // AllPurposeEventHandler sender (args : #RoutedEventArgs) = ...
         // and that did not seem to work      
         let handler sender args = AllPurposeEventHandler (box sender) (args:>RoutedEventArgs)
         
         //Keyboard
         el.PreviewKeyDown.Add(fun args -> handler el args)
         el.PreviewKeyUp.Add(fun args -> handler el args)
         el.PreviewKeyUp.Add(fun args -> handler el args)

         el.KeyDown.Add(fun args -> handler el args)
         el.KeyUp.Add(fun args -> handler el args)

         el.PreviewTextInput.Add(fun args -> handler el args)
         el.TextInput.Add(fun args -> handler el args)

         // Mouse
         el.MouseDown.Add(fun args -> handler el args)
         el.MouseUp.Add(fun args -> handler el args)
         el.PreviewMouseDown.Add(fun args -> handler el args)
         el.PreviewMouseUp.Add(fun args -> handler el args)

         // Stylus
         el.StylusDown.Add(fun args -> handler el args)
         el.StylusUp.Add(fun args -> handler el args)
         el.PreviewStylusDown.Add(fun args -> handler el args)
         el.PreviewStylusUp.Add(fun args -> handler el args)

 
         // Click
         el.AddHandler(Button.ClickEvent, new RoutedEventHandler(AllPurposeEventHandler))      

      
      let els = [ (win :> UIElement); (grid :> UIElement); (btn :> UIElement); (text:> UIElement) ]
      List.iter addHandlers els
      win.Show()
            
end


#if COMPILED
[<STAThread()>]
do 
    let app =  ExamineRoutedEvents() in
    app.Run() |> ignore
#endif

DrawCircles
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Documents
open System.Windows.Input
open System.Windows.Media  
open System.Windows.Shapes 

let fontfam = new FontFamily("Lucida Console")
let defaultPoint = new Point(0.0,0.0)

(* From Chap 9 -  DrawCircles *)
type DrawCircles  = class
   inherit Window as base 

   val canv : Canvas
   val mutable isDrawing : bool
   val mutable elips : Ellipse
   val mutable ptCenter : Point
   val mutable isDragging : bool
   val mutable elDragging : FrameworkElement
   val mutable ptMouseStart : Point
   val mutable ptElementStart : Point

   new () as this = {
        canv = new Canvas()
        isDrawing = false
        elips = null
        ptCenter = defaultPoint
        isDragging = false
        elDragging = null
        ptMouseStart = defaultPoint
        ptElementStart = defaultPoint } then
      this.Title <- "Draw Circles"
      this.Content <- this.canv

   override this.OnMouseLeftButtonDown (args:MouseButtonEventArgs) =
      base.OnMouseLeftButtonDown(args)
      
      if (this.isDragging) then
         ()
      else
         this.ptCenter <- args.GetPosition(this.canv) 
         this.elips <- new Ellipse()
         this.elips.Stroke <- SystemColors.WindowTextBrush
         this.elips.StrokeThickness <- 1.0
         this.elips.Width <- 0.0
         this.elips.Height <- 0.0
         this.canv.Children.Add(this.elips) |> ignore
         Canvas.SetLeft(this.elips, this.ptCenter.X)
         Canvas.SetTop(this.elips, this.ptCenter.Y)
         
         // Capture the mouse and prepare for future events
         this.CaptureMouse() |> ignore
         this.isDrawing <- true
         
   override this.OnMouseRightButtonDown (args:MouseButtonEventArgs) =
      base.OnMouseRightButtonDown(args)
      
      if this.isDrawing then
        ()
      else
        // Get the clicked element and prepare for future events
        this.ptMouseStart <- args.GetPosition(this.canv)
        this.elDragging <- (this.canv.InputHitTest(this.ptMouseStart) :?> FrameworkElement)
        
        if (this.elDragging <> null) then
          this.ptElementStart <- new Point(Canvas.GetLeft(this.elDragging),
                                           Canvas.GetTop(this.elDragging))
          this.isDragging <- true
        
   override this.OnMouseDown (args:MouseButtonEventArgs) =
      base.OnMouseDown(args)
      
      if (args.ChangedButton = MouseButton.Middle) then
        let shape = (this.canv.InputHitTest(args.GetPosition(this.canv)) :?> Shape)
        
        if (shape <> null) then
           if ((shape.Fill :?> SolidColorBrush) = Brushes.Red) then
              shape.Fill <- Brushes.Transparent
           else
              shape.Fill <- Brushes.Red
           
   override this.OnMouseMove (args:MouseEventArgs) =
      base.OnMouseMove(args)
      let ptMouse = args.GetPosition(this.canv)
      
      // Move and resize the Ellipse
      if this.isDrawing then
         let dRadius = sqrt (((this.ptCenter.X - ptMouse.X) ** 2.0) +
                             ((this.ptCenter.Y - ptMouse.Y) ** 2.0))
         Canvas.SetLeft(this.elips, this.ptCenter.X - dRadius)
         Canvas.SetTop(this.elips, this.ptCenter.Y - dRadius)
         this.elips.Width <- 2.0 * dRadius
         this.elips.Height <- 2.0 * dRadius
      elif this.isDragging then
         Canvas.SetLeft
            (this.elDragging,
             this.ptElementStart.X + 
             ptMouse.X - this.ptMouseStart.X)
             
         Canvas.SetTop
            (this.elDragging,
             this.ptElementStart.Y + ptMouse.Y - this.ptMouseStart.Y);
                         
   override this.OnMouseUp (args:MouseButtonEventArgs ) =
      base.OnMouseUp(args)
      
      if (this.isDrawing && (args.ChangedButton = MouseButton.Left)) then
         this.elips.Stroke <- Brushes.Red
         this.elips.StrokeThickness <- min 24.0 (this.elips.Width / 2.0)
         this.elips.Fill <- Brushes.Red
         
         this.isDrawing <- false
         this.ReleaseMouseCapture()
      else
        this.isDragging <- false

   override this.OnTextInput (args:TextCompositionEventArgs  ) =
      base.OnTextInput(args)
      
      // End drawing or dragging with press of Escape key
      if (args.Text.IndexOf('\x1B') <> 1) then
         if this.isDrawing then
            this.ReleaseMouseCapture()
         elif this.isDragging then
            Canvas.SetLeft(this.elDragging,this.ptElementStart.X)
            Canvas.SetTop(this.elDragging,this.ptElementStart.Y)


   override this.OnLostMouseCapture (args:MouseEventArgs   ) =
      base.OnLostMouseCapture(args)
      
      // Abnormal end of drawing: Remove child Ellipse
      if this.isDrawing then
         this.canv.Children.Remove(this.elips)
         this.isDrawing <- false

end


#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(new DrawCircles()) |> ignore
#endif

ExamineKeyStrokes
#light 
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"

open System
open System.Windows
open System.Windows.Controls
open System.Windows.Documents
open System.Windows.Input
open System.Windows.Media  
open System.Windows.Shapes 
//
(* From Chap 9 -  ExamineKeystrokes *)
let strHeader = "Event     Key                 Sys-Key   Text      " +
                "Ctrl-Text Sys-Text  Ime       KeyStates      " +
                "IsDown  IsUp   IsToggled IsRepeat "
let strFormatKey = "{0,-10}{1,-20}{2,-10}                          " +
                   "    {3,-10}{4,-15}{5,-8}{6,-7}{7,-10}{8,-10}"
let strFormatText = "{0,-10}                              " +
                    "{1,-10}{2,-10}{3,-10}"
                    
                    
type ExamineKeystrokes  = class

   inherit Window as base 

   val stack : StackPanel
   val scroll : ScrollViewer

   new () as this = {
        stack = new StackPanel()
        scroll = new ScrollViewer() } then
      this.Title <- "Examine Keystrokes"
      this.FontFamily <- new FontFamily("Courier New")
      
      let grid = new Grid()
      this.Content <- grid
      
      // Make one row "auto" and the other fill the remaining space.
      let rowdef = new RowDefinition()
      rowdef.Height <- GridLength.Auto;
      grid.RowDefinitions.Add(rowdef)
      grid.RowDefinitions.Add(new RowDefinition())

      // Display header text.
      let textHeader = new TextBlock();
      textHeader.FontWeight <- FontWeights.Bold;
      textHeader.Text <- strHeader;
      grid.Children.Add(textHeader) |>ignore

      // Create StackPanel as child of ScrollViewer for displaying events.
      grid.Children.Add(this.scroll) |>ignore
      Grid.SetRow(this.scroll, 1)
      
      this.scroll.Content <- this.stack
      
   override this.OnKeyDown (args:KeyEventArgs ) = 
      base.OnKeyDown(args)
      this.DisplayKeyInfo(args)

   override this.OnKeyUp (args:KeyEventArgs ) = 
      base.OnKeyUp(args)
      this.DisplayKeyInfo(args)

   override this.OnTextInput (args:TextCompositionEventArgs  ) = 
      base.OnTextInput(args)

      let output = [| args.RoutedEvent.Name; args.Text; 
                      args.ControlText; args.SystemText |]
      
      let str = String.Format(strFormatText, (Array.map box output))
          
      this.DisplayInfo(str);

   member this.DisplayKeyInfo (args:KeyEventArgs) =
   
      let test = args.RoutedEvent.Name
      let output = [| args.RoutedEvent.Name; args.Key.ToString();
                     args.SystemKey.ToString(); args.ImeProcessedKey.ToString();
                     args.KeyStates.ToString(); args.IsDown.ToString(); 
                     args.IsUp.ToString(); args.IsToggled.ToString(); 
                     args.IsRepeat.ToString() |]
      let str =  String.Format(strFormatKey, (Array.map box output))
      this.DisplayInfo(str)
            
   member this.DisplayInfo (str:string) =
      let text = new TextBlock();
      text.Text <- str;
      this.stack.Children.Add(text) |>ignore
      this.scroll.ScrollToBottom();
end

#if COMPILED
[<STAThread()>]
do 
    let app =  Application() in
    app.Run(new ExamineKeystrokes()) |> ignore
#endif