Wednesday, December 26, 2007

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

No comments: