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