Learning WPF with F# - Custom Elements

Examples from Chapter 10 of Petzold's book Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation.

 BetterEllipse & RenderTheBetterEllipse 
#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.Input
open System.Windows.Media  
//
// From Chapter 10 - BetterEllipse & RenderTheBetterEllipse
//
let mutable private initFillProperty : DependencyProperty = null
let mutable private initStrokeProperty : DependencyProperty = null

// From Chapter 10 - BetterEllipse             
type BetterEllipse() = class                    
   inherit FrameworkElement() as base 
   
   static member FillProperty =
      if initFillProperty = null then
         initFillProperty <- DependencyProperty.Register
            ("Fill", typeof<Brush>,typeof<BetterEllipse>, 
             new FrameworkPropertyMetadata
                (null, FrameworkPropertyMetadataOptions.AffectsRender))         
         initFillProperty
      else
         initFillProperty

   static member StrokeProperty  =
      if initStrokeProperty = null then
         initStrokeProperty <- DependencyProperty.Register
            ("Stroke", typeof<Pen>,typeof<BetterEllipse>, 
             new FrameworkPropertyMetadata
                (null, FrameworkPropertyMetadataOptions.AffectsMeasure))         
         initStrokeProperty
      else
         initStrokeProperty

   member this.Fill 
      with get() = (this.GetValue(BetterEllipse.FillProperty) :?> Brush)
      and set (value :Brush) =
         this.SetValue(BetterEllipse.FillProperty,value)
      
   member this.Stroke 
      with get() = (this.GetValue(BetterEllipse.StrokeProperty) :?> Pen )
      and set (value :Pen) =
         this.SetValue(BetterEllipse.StrokeProperty,value)

   // Override of MeasureOverride
   override this.MeasureOverride (sizeAvailable:Size) =     
      if this.Stroke <> null then
         new Size(this.Stroke.Thickness,this.Stroke.Thickness)
      else
         base.MeasureOverride(sizeAvailable)
         
   // Override of OnRender         
   override this.OnRender (dc:DrawingContext) =
      let drawEllipse width height = 
         dc.DrawEllipse
            (this.Fill, this.Stroke,
             new Point(this.RenderSize.Width /2.0, this.RenderSize.Height /2.0),
             width/2.0,height/2.0)

      if this.Stroke <> null then
         let width = Math.Max(0.0,this.RenderSize.Width - this.Stroke.Thickness)
         let height = Math.Max(0.0,this.RenderSize.Height - this.Stroke.Thickness)
         drawEllipse width height
      else
         drawEllipse this.RenderSize.Width this.RenderSize.Height
         
end   

// From Chapter 10 - RenderTheBetterEllipse             
type RenderTheBetterEllipse() as this =
   inherit Window() as base 
   
   do this.Title <- "Render the Better Ellipse"
      let elips = new BetterEllipse()
      elips.Fill <- Brushes.AliceBlue
      elips.Stroke <- new Pen
         (new LinearGradientBrush(Colors.CadetBlue, Colors.Chocolate,
                                  new Point(1.0, 0.0), new Point(0.0, 1.0)),24.0)
      this.Content <- elips

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

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

open System
open System.Globalization
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  

let mutable private initTextProperty : DependencyProperty = null
let mutable private initKnockEvent : RoutedEvent = null
let mutable private initPreviewKnockEvent : RoutedEvent = null

let condassign a b c = 
  match a with
  | true -> b
  | false -> c

// From Chapter 10 - MedievalButton              
type MedievalButton() as this = class                    
   inherit Control() as base 
   
   let mutable isMouseReallyOver = false
   let mutable formtxt : FormattedText = null
   
   let triggerKnock,knockEvent = IEvent.create()
   let triggerPreviewKnock,previewKnockEvent = IEvent.create()

   // Public interface to routed events   
   member this.Knock = knockEvent
   member this.PreviewKnock = previewKnockEvent
      
   static member TextProperty =
      if initTextProperty = null then
         initTextProperty <- DependencyProperty.Register
            ("Text", typeof<string>,typeof<MedievalButton>, 
             new FrameworkPropertyMetadata
                (" ", FrameworkPropertyMetadataOptions.AffectsMeasure))         
         initTextProperty
      else
         initTextProperty

   // Register routed events.
   static member KnockEvent =
      if initKnockEvent = null then
         initKnockEvent <- EventManager.RegisterRoutedEvent
                  ("Knock", RoutingStrategy.Bubble,
                    typeof<RoutedEventHandler>, typeof<MedievalButton>)
         initKnockEvent
      else
         initKnockEvent

   static member PreviewKnockEvent =
      if initPreviewKnockEvent = null then
         initPreviewKnockEvent <- EventManager.RegisterRoutedEvent
                  ("PreviewKnock", RoutingStrategy.Tunnel,
                    typeof<RoutedEventHandler>, typeof<MedievalButton>)
         initPreviewKnockEvent
      else
         initPreviewKnockEvent
   
   // Public interface to dependency property
   member this.Text 
      with get() = (this.GetValue(MedievalButton.TextProperty) :?> string)
      and set (value :string) =
         this.SetValue(MedievalButton.TextProperty,(condassign (value=null) " " value))



   // Override of MeasureOverride
   override this.MeasureOverride (sizeAvailable:Size) =
      formtxt <- new FormattedText(this.Text, 
                                   CultureInfo.CurrentCulture, 
                                   this.FlowDirection,
                                   new Typeface(this.FontFamily,this.FontStyle,this.FontWeight,this.FontStretch),
                                   this.FontSize,this.Foreground)
      let width = Math.Max(48.0, formtxt.Width) + 4.0 + this.Padding.Left + this.Padding.Right
      let height = formtxt.Height + 4.0 + this.Padding.Top + this.Padding.Bottom
      new Size(width,height)
          
   // OnRender called to redraw the button
   override this.OnRender (dc:DrawingContext) =
      let brushBackground =
         match (isMouseReallyOver,this.IsMouseCaptured) with
         | (true,true) -> SystemColors.ControlDarkBrush
         | (_,_) -> SystemColors.ControlBrush
      
      let pen = new Pen(this.Foreground, (condassign (this.IsMouseOver) 2.0 1.0))
      
      dc.DrawRoundedRectangle(brushBackground,pen,
                              new Rect(new Point(0.0,0.0),this.RenderSize),4.0,4.0)
                              
      formtxt.SetForegroundBrush 
        (condassign (this.IsEnabled) this.Foreground (SystemColors.ControlDarkBrush:>Brush))
        
      let x = 
        2.0 + 
        match this.HorizontalAlignment with
        | HorizontalAlignment.Left -> this.Padding.Left
        | HorizontalAlignment.Right -> this.RenderSize.Width - formtxt.Width - this.Padding.Right
        | _ -> ((this.RenderSize.Width - formtxt.Width - this.Padding.Left - this.Padding.Right) / 2.0)
         
      let y = 
        2.0 +
        match this.VerticalContentAlignment with
        | VerticalAlignment.Top -> this.Padding.Top
        | VerticalAlignment.Bottom -> this.RenderSize.Height - formtxt.Height - this.Padding.Bottom
        | _ -> ((this.RenderSize.Height  - formtxt.Height  - this.Padding.Top  - this.Padding.Bottom) / 2.0)
        
      dc.DrawText(formtxt, new Point(x,y))
      
   override this.OnMouseEnter (args:MouseEventArgs ) =
      base.OnMouseEnter(args)
      this.InvalidateVisual()
                              
   override this.OnMouseLeave (args:MouseEventArgs ) =
      base.OnMouseLeave(args)
      this.InvalidateVisual()

   override this.OnLostMouseCapture (args:MouseEventArgs ) =
      base.OnLostMouseCapture(args)
      this.InvalidateVisual()
                              
   override this.OnMouseMove (args:MouseEventArgs ) =
      base.OnMouseMove(args)
      
      // Determine if mouse has really moved inside or out
      let pt = args.GetPosition(this)
      let isReallyOverNow = (pt.X >= 0.0 && 
                             pt.Y < this.ActualWidth &&
                             pt.Y >= 0.0 &&
                             pt.Y < this.ActualHeight)
      match isMouseReallyOver with
        | true -> ()
        | false -> isMouseReallyOver <- isReallyOverNow; this.InvalidateVisual()
        
   override this.OnMouseLeftButtonDown (args:MouseButtonEventArgs ) =
      base.OnMouseLeftButtonDown(args)
      this.CaptureMouse() |> ignore
      this.InvalidateVisual()
      args.Handled <- true
   
   // This event actually triggers the 'Knock' event
   override this.OnMouseLeftButtonUp (args:MouseButtonEventArgs ) =
      base.OnMouseLeftButtonUp(args)
      
      if this.IsMouseCaptured then
         if isMouseReallyOver then
            this.OnPreviewKnock()
            this.OnKnock()
         args.Handled <- true
         Mouse.Capture(null) |> ignore         
      
   override this.OnKeyDown (args:KeyEventArgs) =
      base.OnKeyDown(args)
      if args.Key = Key.Space || args.Key = Key.Enter then
         args.Handled <- true

   override this.OnKeyUp (args:KeyEventArgs) =
      base.OnKeyUp(args)
      if args.Key = Key.Space || args.Key = Key.Enter then
         this.OnPreviewKnock()
         this.OnKnock()
         args.Handled <- true

   // OnKnock method raised the 'Knock' event
   member this.OnKnock() =
      let argsEvent = new RoutedEventArgs()
      argsEvent.RoutedEvent <- MedievalButton.PreviewKnockEvent
      argsEvent.Source <- this
      triggerKnock(argsEvent)
   
   // OnPreviewKnock  method raised the 'PreviewKnock' event
   member this.OnPreviewKnock() =
      let argsEvent = new RoutedEventArgs()
      argsEvent.RoutedEvent <- MedievalButton.KnockEvent
      argsEvent.Source <- this
      triggerPreviewKnock(argsEvent)
         
end   

// From Chapter 10 - GetMedieval             
type GetMedieval() as this =
   inherit Window() as base 
   
   do this.Title <- "Get Medieval"
      let btn = new MedievalButton(Text="Click this button",
                                   FontSize=24.0,
                                   HorizontalAlignment = HorizontalAlignment.Center,
                                   VerticalAlignment = VerticalAlignment.Center,
                                   Padding = new Thickness(5.0, 20.0, 5.0, 20.0))
      btn.Knock.Add( fun args ->
         MessageBox.Show("The button labeled \"" + btn.Text +
                         "\" has been knocked.", this.Title) |>ignore )
      this.Content <- btn

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

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

Working with F# - DependencyProperty and static readonly field workaround

In my last blog entry, I talked about how I had problems implementing the DependencyProperty in both SpaceButton and SpaceWindow class. After sleeping on it, I figured out a way to workaround that. I was about to post my workaround to my blog only to find that Dr. Don Syme has already posted a comment with the workaround to my blog already! Thanks! I am honored that he's even taken the time to read my blog.

By the way, I recently purchased a copy of Expert F# (I'm kind of surprised that Expert F# is published by Apress instead of Microsoft Press) and slowly reading through the book. While I only finished the first couple chapters, I heartily recommend this book for anyone who wants to learn F#. It certainly made clearer many fuzzy notions that I have of the F# language and introduce me to features that I did not know exist such as option values.

I'm reposting Don Syme's solutions below adding color syntax highlighting...

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

open System
open System.Text
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
//  Workaround solution from Don Syme!
(* From Chap 8 - SetSpaceProperty example with DependencyProperty *)
//
(* From Chap 8 - SpaceButton.cs *)
// Workaround solution 
let mutable private initSpaceButtonSpaceProperty : DependencyProperty = null
let mutable private initSpaceWindowSpaceProperty : DependencyProperty = null
//
// Switched to implicit construction for classes
type SpaceButton() =
  inherit Button() as base

  let mutable txt = null

  static member SpaceProperty =
    if initSpaceButtonSpaceProperty = null then
       let metadata = new FrameworkPropertyMetadata(DefaultValue=1, 
                                                    AffectsMeasure=true, 
                                                    Inherits=true)
       metadata.PropertyChangedCallback <- new PropertyChangedCallback
         (SpaceButton.OnSpacePropertyChanged)
         
       initSpaceButtonSpaceProperty <-
          DependencyProperty.Register
            ("Space",
             typeof<int>,
             typeof<SpaceButton>,
             metadata,
             // callback method for value validation
             (fun obj -> let i = (obj :?> int) in (i >= 0)))

    initSpaceButtonSpaceProperty

  static member OnSpacePropertyChanged (obj:DependencyObject) (args:DependencyPropertyChangedEventArgs) =
    let btn = obj :?> SpaceButton
    btn.Content <- btn.SpaceOutText btn.Text

  member this.Text
    with get() = txt
    and set value =
      txt <- value
      this.Content <- this.SpaceOutText(txt)

  member this.Space
    with get() =
      let value = this.GetValue(SpaceButton.SpaceProperty)
      (value :?> int)
    and set (value:int) = this.SetValue(SpaceButton.SpaceProperty,value)

  member this.SpaceOutText (str:string) =
    if (str <> null) then
      let appendSpace c = String.of_char(c) + new string(' ',this.Space)
      let build = String.map_concat appendSpace str
      build
    else
      null


(* From Chap 8 - SpaceWindow.cs *)
// Switched to implicit construction for classes
type SpaceWindow() =
  inherit Window() as base

  // A static DependencyProperty
  static member SpaceProperty =
    if initSpaceWindowSpaceProperty = null then
      let metadata = new FrameworkPropertyMetadata()
      metadata.Inherits <- true

      // Add owner to SpaceProperty & override metadata
      initSpaceWindowSpaceProperty <- SpaceButton.SpaceProperty.AddOwner(typeof<SpaceWindow>)
      initSpaceWindowSpaceProperty.OverrideMetadata(typeof<SpaceWindow>,metadata)
    // returns the SpaceProperty value  
    initSpaceWindowSpaceProperty

  member this.Space
    with get() = (this.GetValue(SpaceWindow.SpaceProperty) :?> int)
    and set (value:int) = this.SetValue(SpaceWindow.SpaceProperty,value)


(* From Chap 8 - SetSpaceProperty.cs *)
// Switched to implicit construction for classes
type SetSpaceProperty() as this =
  inherit SpaceWindow() as base

  // I did not know you can do this until Don Syme showed me this...
  do this.Title <- "Set Space Property"
     this.SizeToContent <- SizeToContent.WidthAndHeight
     this.ResizeMode <- ResizeMode.CanMinimize
     let iSpaces = [|0;1;2|]

     let grid = new Grid()
     this.Content <- grid

     for i in [0..2] do
       let row = new RowDefinition()
       row.Height <- GridLength.Auto
       grid.RowDefinitions.Add(row)

     for i in [0..(iSpaces.Length-1)] do
       let col = new ColumnDefinition()
       col.Width <- GridLength.Auto
       grid.ColumnDefinitions.Add(col)

     for i in [0..(iSpaces.Length-1)] do 
       let btn = new SpaceButton(Text="Set window Space to " + Int32.to_string(iSpaces.[i]),
                                 Tag=iSpaces.[i],
                                 HorizontalAlignment=HorizontalAlignment.Center,
                                 VerticalAlignment=VerticalAlignment.Center)

       //btn.Click += WindowPropertyOnClick;
       btn.Click.Add(fun _ -> this.Space <- (btn.Tag :?> int))
       grid.Children.Add(btn)|>ignore
       Grid.SetRow(btn, 0)
       Grid.SetColumn(btn, i)


       let btn = new SpaceButton(Text= "Set button Space to " + Int32.to_string(iSpaces.[i]),
                                 Tag=iSpaces.[i],
                                 HorizontalAlignment=HorizontalAlignment.Center,
                                 VerticalAlignment=VerticalAlignment.Center)

       //btn.Click += ButtonPropertyOnClick
       btn.Click.Add(fun _ -> btn.Space <- (btn.Tag :?> int))
       grid.Children.Add(btn) |> ignore
       Grid.SetRow(btn, 1)
       Grid.SetColumn(btn, i)


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

Learning WPF with F# - The Dock and the Grid and Problems with Static Readonly Fields

Working through Chapter 8 of Petzold's "Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation" book.

Working on the SpaceButton examples forced me to work with static members and static constructors in F#. Unfortunately, I'm completely stumped. In the SpaceButton example, I don't know how to setup a static readonly field in F# and I don't know how to initialize SpaceProperty outside of SpaceButton class due to initialization dependency with SpaceButton. The closest thing that I can find on the web is the following blog entry by Lewis Bruck which indicates that F# and SQL2005 CLR has problems because F# does not generate static readonly fields. Don Syme apparently has thought about this subject as he has published an article An Alternative Approach to Initializing Mutually Referential Objects". But it wasn't obvious to me how to resolve my problem with initializing SpaceProperty field. I post the code I have so far, but it's nonfunctional. If anyone else knows a solution, please let me know!

SetFontSizeProperty
#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  


(* From Chap 8 - SetFontSizeProperty.cs *)
type SetFontSizeProperty = class
   inherit Window as base 

   
   new () as this = {} then
      this.Title <- "Set FontSize Property";
      this.SizeToContent <- SizeToContent.WidthAndHeight;
      this.ResizeMode <- ResizeMode.CanMinimize;
      this.FontSize <- 16.0
      let fntsizes = [|8.0;16.0;32.0|]
      
      // Create Grid Panel
      let grid = new Grid()
      this.Content <- grid
      
      // Define row and columns
      for i in [0..1] do
         let row = new RowDefinition()
         row.Height <- GridLength.Auto
         grid.RowDefinitions.Add(row)
      
      for i in [0..(fntsizes.Length-1)] do
         let col = new ColumnDefinition()
         col.Width <- GridLength.Auto
         grid.ColumnDefinitions.Add(col)
         
      // Create six buttons
      for i in [0..(fntsizes.Length-1)] do
         let btn = new Button()
         btn.Content <- new TextBlock
            (new Run("Set window FontSize to " + Float.to_string(fntsizes.[i])))
         btn.Tag <- fntsizes.[i]
         btn.HorizontalAlignment <- HorizontalAlignment.Center
         btn.VerticalAlignment <- VerticalAlignment.Center
         // Implement WindowFontSizeOnClick
         btn.Click.Add
            (fun _ -> this.FontSize <- (btn.Tag :?> double))
         grid.Children.Add(btn) |> ignore
         Grid.SetRow(btn,0)
         Grid.SetColumn(btn,i)
         
         let btn = new Button()
         btn.Content <- new TextBlock
            (new Run("Set button FontSize to " + Float.to_string(fntsizes.[i])))
         btn.Tag <- fntsizes.[i]
         btn.HorizontalAlignment <- HorizontalAlignment.Center
         btn.VerticalAlignment <- VerticalAlignment.Center
         // Implement ButtonFontSizeOnClick
         btn.Click.Add
            (fun _ -> btn.FontSize <- (btn.Tag :?> double))
         grid.Children.Add(btn) |> ignore
         Grid.SetRow(btn,1)
         Grid.SetColumn(btn,i)
      ()
end

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

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

open System
open System.Text
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media  
// 
(* From Chap 8 - SetSpaceProperty example with DependencyProperty *)
// 
(* From Chap 8 - SpaceButton.cs *)
type SpaceButton =   class
   inherit Button as base 

   val mutable txt: string

   new () as this = {txt = null}

   
   static member initSpaceProperty =
      let metadata = new FrameworkPropertyMetadata()
      metadata.DefaultValue <- 1
      metadata.AffectsMeasure <- true
      metadata.Inherits <- true
      metadata.PropertyChangedCallback <- new PropertyChangedCallback(SpaceButton.OnSpacePropertyChanged)
      DependencyProperty.Register("Space", 
                                   typeof<int>,
                                   typeof<SpaceButton>, 
                                   metadata, 
                                   // callback method for value validation
                                   (fun obj -> let i = (obj :?> int) in (i >= 0)))
   
   // I'm completely stumped...I don't know how to setup a static readonly property
   // in F# and I don't know how to initialize SpaceProperty outside of SpaceButton
   // class due to initialization dependency with SpaceButton.
   // The closest thing I can find on the web is the following blog by Lewis Bruck
   // http://blogs.msdn.com/lbruck/archive/2006/05/24/606653.aspx which also indicates
   // that F# and SQL2005 CLR has problems because F# does not generate static readonly
   // fields.  Don Syme apparently has thought about this subject as he has published an
   // article "An Alternative Approach to Initializing Mutually Referential Objects"
   // to be found http://research.microsoft.com/~dsyme/papers/valrec-tr.pdf
   static member SpaceProperty = SpaceButton.initSpaceProperty
     
   static member OnSpacePropertyChanged (obj:DependencyObject) (args:DependencyPropertyChangedEventArgs) =
      let btn = obj :?> SpaceButton
      btn.Content <- btn.SpaceOutText btn.txt
      
   member this.Text 
      with get() = this.txt
      and set value = 
         this.txt <- value
         this.Content <- this.SpaceOutText(this.txt)
         
   member this.Space
      with get() = 
        let value = this.GetValue(SpaceButton.SpaceProperty)
        (value :?> int)
      and set (value:int) = this.SetValue(SpaceButton.SpaceProperty,value)
         
   member this.SpaceOutText (str:string) =
     
     if (str <> null) then
        let appendSpace c = String.of_char(c) + new string(' ',this.Space)
        let build = String.map_concat  appendSpace str
        build
     else 
       null
   
end   

   
(* From Chap 8 - SpaceWindow.cs *)

type SpaceWindow = class
   inherit Window as base 
   
   new () as this = {}

   // A static DependencyProperty 
   static member SpaceProperty = 
      let metadata = new FrameworkPropertyMetadata()
      metadata.Inherits <- true
      
      // Add owner to SpaceProeprty & override metadata
      let prop = SpaceButton.SpaceProperty.AddOwner(typeof<SpaceWindow>)
      prop.OverrideMetadata(typeof<SpaceWindow>,metadata)
      prop      
   
   member this.Space
      with get() = (this.GetValue(SpaceWindow.SpaceProperty) :?> int)
      and set (value:int) = this.SetValue(SpaceWindow.SpaceProperty,value)
   
end

(* From Chap 8 - SetSpaceProperty.cs *)

type SetSpaceProperty  = class
   inherit SpaceWindow as base 

   new () as this = {} then
      this.Title <- "Set Space Property"
      this.SizeToContent <- SizeToContent.WidthAndHeight
      this.ResizeMode <- ResizeMode.CanMinimize
      let iSpaces = [|0;1;2|]
      
      let grid = new Grid()
      this.Content <- grid
      
      for i in [0..2] do
         let row = new RowDefinition()
         row.Height <- GridLength.Auto
         grid.RowDefinitions.Add(row)
      
      for i in [0..(iSpaces.Length-1)] do
         let col = new ColumnDefinition()
         col.Width <- GridLength.Auto
         grid.ColumnDefinitions.Add(col)
         
      for i in [0..(iSpaces.Length-1)] do
         let btn = new SpaceButton();
         btn.Text <- "Set window Space to " + Int32.to_string(iSpaces.[i])
         btn.Tag <- iSpaces.[i];
         btn.HorizontalAlignment <- HorizontalAlignment.Center
         btn.VerticalAlignment <- VerticalAlignment.Center

         //btn.Click += WindowPropertyOnClick;         
         btn.Click.Add(fun _ -> this.Space <- (btn.Tag :?> int))
         grid.Children.Add(btn)|>ignore
         Grid.SetRow(btn, 0)
         Grid.SetColumn(btn, i)
         

         let btn = new SpaceButton()
         btn.Text <- "Set button Space to " + Int32.to_string(iSpaces.[i])
         btn.Tag <- iSpaces.[i];
         btn.HorizontalAlignment <- HorizontalAlignment.Center
         btn.VerticalAlignment <- VerticalAlignment.Center
         
         //btn.Click += ButtonPropertyOnClick
         btn.Click.Add(fun _ -> btn.Space <- (btn.Tag :?> int))
         grid.Children.Add(btn) |> ignore
         Grid.SetRow(btn, 1)
         Grid.SetColumn(btn, i)

end


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