I've been working through Chapter 15 of Petzold's book,Applications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation. FormatRichText is probably the largest and most complete example that I've written so far with F#. For that reason, I decided to logically organize the code into modules. According to the book Expert F#, a module is just a simple container for values and type definitions. While I did not physically separate the modules into different file, but there's no reason why it cannot be done.
For the most part, FormatRichText functions just like Petzold's C# version. However, example code looks significantly different than the C# version and may be more difficult to understand compared with the first WPF examples that I wrote. I can see that a C# developer probably would not have much of a problem with the first few WPF examples but may have more problems reading later examples. Does this make the code less readable? Probably to those who are just jumping into F# from C# but not, I think or hope, to those who are familiar with F#.
One final comment on the published example. I first implemented seqdrop function based on Haskell's drop function. Later, I ran a timing test against that implementation of seqdrop with the following implementation:
let seqdrop2 n list = Seq.to_list list |> List.rev |> List.to_seq |> Seq.truncate n |> Seq.to_list |> List.rev |> List.to_seq
I erroneously thought this version of the drop would be slower because of all the list reversal. When I did a timing test with seqdrop and seqdrop2, seqdrop2 was a lot faster. Basically, running seqdrop on a list of 10000 integers on my machine took almost 9 seconds while it ran in 0.1 seconds with the second version. The lesson learned is always use F# standard library functions whenever possible.
Below are the example codes with the slow version of seqdrop implemented.
CraftTheToolbar
#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
open System.Windows.Media.Imaging
//
// From Chapter 15 - CraftTheToolbar
//
// Defining drop function...couldn't find a Seq equivalent
// I see Seq.take and Seq.truncate but no Seq.drop
let rec seqdrop n (list:seq<'a>) =
if n<=0 then list
else
match (List.of_seq list) with
| _ :: [] -> seq []
| _ :: t -> seqdrop (n-1) (List.to_seq t)
| _ -> failwith "Error in seqdrop - never should get here"
// I think if F# has Haskell's type classes, I can avoid
// these awkward type conversion expressions such as (List.to_seq t)
let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Craft the Toolbar",
Content=dock)
let toolbar = new ToolBar()
dock.Children.Add(toolbar) |>ignore
DockPanel.SetDock(toolbar,Dock.Top)
let commands =
seq [ApplicationCommands.New;
ApplicationCommands.Open;
ApplicationCommands.Save;
ApplicationCommands.Print;
ApplicationCommands.Cut;
ApplicationCommands.Copy;
ApplicationCommands.Paste;
ApplicationCommands.Delete]
let images =
seq ["new.gif"; "open.gif"; "save.gif";
"print.gif"; "cut.gif"; "copy.gif";
"paste.gif"; "delete.gif"]
// Bind the commands outside toolbar creation
let show (msg:string) (label:string) = MessageBox.Show(msg,label) |>ignore
commands |> Seq.iter (fun cmd ->
new CommandBinding(cmd,(fun _ _ ->
show (cmd.Name + " command not yet implemented") window.Title))
|> window.CommandBindings.Add |>ignore)
// Create toolbar given the command and image file
let addToolbarButtons list =
list |> Seq.iter (fun (cmd:RoutedUICommand,imgFile) ->
let img = new Image(Stretch=Stretch.None)
img.Source <- new BitmapImage(new Uri(@"file:///icons/" + imgFile))
let tip = new ToolTip(Content=cmd.Text)
let btn = new Button(Command=cmd,Content=img,ToolTip=tip)
toolbar.Items.Add(btn) |>ignore)
// Create a separator at the every nth element
let rec addToolbarButtonsWithSeparator list n=
if (Seq.length list) > n then
addToolbarButtons (Seq.take n list)
toolbar.Items.Add(new Separator()) |>ignore
addToolbarButtonsWithSeparator (seqdrop n list) n
else
addToolbarButtons list
// Create the toolbar with separators
let list = Seq.zip commands images
addToolbarButtonsWithSeparator list 4
#if COMPILED
[<STAThread()>]
do
let app = Application() in
app.Run(window) |> ignore
#endifMoveTheToolbar
#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 15 - MoveTheToolbar
//
let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Move the Toolbar",
Content=dock)
let trayTop = new ToolBarTray()
dock.Children.Add(trayTop) |> ignore
DockPanel.SetDock(trayTop,Dock.Top)
let trayLeft = new ToolBarTray(Orientation = Orientation.Vertical)
dock.Children.Add(trayLeft) |> ignore
DockPanel.SetDock(trayLeft,Dock.Left)
dock.Children.Add(new TextBox())
// Create six toolbars
[1..6] |> Seq.iter (fun i ->
let toolbar = new ToolBar(Header= "Toolbar " + Int32.to_string i)
if i<4 then trayTop.ToolBars.Add(toolbar)
else trayLeft.ToolBars.Add(toolbar)
// Add six buttons to each toolbar
[0..5] |> Seq.iter (fun j ->
toolbar.Items.Add(new Button(FontSize=16.0,
Content=(Char.chr (Char.code 'A' + j))))
|>ignore
)
)
#if COMPILED
[<STAThread()>]
do
let app = Application() in
app.Run(window) |> ignore
#endifFormatRichText (combined)
#light
#I @"C:\Program Files\Reference Assemblies\Microsoft\Framework\v3.0"
#r @"WindowsBase.dll"
#r @"PresentationCore.dll"
#r @"PresentationFramework.dll"
#r @"selectcolorfromgrid.dll" // Compiled from Chap13 example
open Microsoft.Win32
open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Controls.Primitives
open System.Windows.Documents
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging
open System.Windows.Shapes
open System.Windows.Threading
open Chapter13;
//
// From Chapter 15 - FormatRichText (combined)
//
//----------------------------------------------------------
// Using this chapter as an opportunity to play around with F# packaging
// Defining some utilities functions...normally I should package this elsewhere
// Nullable utilities for F# - Copied from FLinq sample code
let (=?!) (x: Nullable<'a>) (y:'a) =
x.HasValue && x.Value = y
// Defining drop function...I need this for adding toobar buttons with Separator
let rec seqdrop n (list:seq<'a>) =
if n<=0 then list
else
match (List.of_seq list) with
| _ :: [] -> seq []
| _ :: t -> seqdrop (n-1) (List.to_seq t)
| _ -> failwith "Error in seqdrop - never should get here"
//----------------------------------------------------------------------------
// This module could be physically packaged in a different file if desired.
//----------------------------------------------------------------------------
module Command =
let fileFilter =
"XAML Document Files (*.xaml)|*.xaml|" +
"XAML Package Files (*.zip)|*.zip|" +
"Rich Text Format Files (*.rtf)|*.rtf|" +
"Text Files (*.txt)|*.txt|" +
"All files (*.*)|*.*"
let formats =
seq [DataFormats.Xaml; DataFormats.XamlPackage; DataFormats.Rtf;
DataFormats.Text; DataFormats.Text]
// OnNew, OnOpen, OnSave - from FormatRichText.File.cs example
let OnNew (doc:FlowDocument)(win:Window) =
let range =new TextRange(doc.ContentStart,doc.ContentEnd)
range.Text <- ""
let OnOpen (doc:FlowDocument) (win:Window) =
let range = new TextRange(doc.ContentStart,doc.ContentEnd)
let dlg = new OpenFileDialog(CheckFileExists=true,Filter=fileFilter)
if (dlg.ShowDialog(win) =?! true) then
try
use strm = new FileStream(dlg.FileName,FileMode.Open)
range.Load(strm,(Seq.nth dlg.FilterIndex formats))
with e -> MessageBox.Show(e.Message,win.Title) |>ignore
let OnSave (doc:FlowDocument) (win:Window) =
let range = new TextRange(doc.ContentStart,doc.ContentEnd)
let dlg = new OpenFileDialog(CheckFileExists=true,Filter=fileFilter)
if (dlg.ShowDialog(win) =?! true) then
try
use strm = new FileStream(dlg.FileName,FileMode.Create)
range.Save(strm, (Seq.nth dlg.FilterIndex formats))
with e -> MessageBox.Show(e.Message,win.Title) |>ignore
// CanDelete, OnOpenOnDelete - from FormatRichText.Edit.cs example
let CanDelete (args:CanExecuteRoutedEventArgs) (rtbox:RichTextBox) =
args.CanExecute <- not rtbox.Selection.IsEmpty
let OnDelete (args:ExecutedRoutedEventArgs) (rtbox:RichTextBox) =
rtbox.Selection.Text <- ""
//----------------------------------------------------------------------------
// This module could be physically packaged in a different file if desired.
//----------------------------------------------------------------------------
module ToolbarFactory =
// I'm not sure how to handle this. Seems kind of ugly to
// have this mutable variable out here. The alternatives that I
// can think of aren't any better.
let mutable originalFontSize:String = "12"
let addButtons (toolbar:ToolBar) list =
list |> Seq.iter (fun (cmd:RoutedUICommand,imgFile) ->
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + imgFile))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let tip = new ToolTip(Content=cmd.Text)
let btn = new Button(Command=cmd,Content=img,ToolTip=tip)
ignore(toolbar.Items.Add(btn)))
// Create a separator at the every nth element
let rec addButtonsWithSeparator (toolbar:ToolBar) n list =
if (Seq.length list) > n then
addButtons toolbar (Seq.take n list)
toolbar.Items.Add(new Separator()) |>ignore
addButtonsWithSeparator toolbar n (seqdrop n list)
else
addButtons toolbar list
// Create command bindings
// from FormatRichText.File.cs example
let createFileToolbar (doc:FlowDocument) (win:Window) =
let commands = seq [ ApplicationCommands.New; ApplicationCommands.Open; ApplicationCommands.Save]
let handlers = seq [new ExecutedRoutedEventHandler(fun _ _ -> Command.OnNew doc win);
new ExecutedRoutedEventHandler(fun _ _ -> Command.OnOpen doc win);
new ExecutedRoutedEventHandler(fun _ _ -> Command.OnSave doc win); ]
let images = seq ["new.gif"; "open.gif"; "save.gif" ]
let toolbar = new ToolBar()
Seq.zip commands images |> addButtons toolbar
// Add the command bindings
let addBind cmd = ignore(win.CommandBindings.Add cmd)
Seq.zip commands handlers |> Seq.iter (fun (cmd,handler) ->
new CommandBinding(cmd,handler) |> addBind)
toolbar
// from FormatRichText.Edit.cs example - create edit toolbar
let createEditToolbar (text:RichTextBox) (win:Window) =
let commands = seq [ ApplicationCommands.Cut;
ApplicationCommands.Copy;
ApplicationCommands.Paste;
ApplicationCommands.Delete;
ApplicationCommands.Undo;
ApplicationCommands.Redo]
// Use option type to handle the exceptions
let handlers = seq [None;None;None;
Some(((new ExecutedRoutedEventHandler(fun _ args ->
Command.OnDelete args text)),
(new CanExecuteRoutedEventHandler(fun _ args ->
Command.CanDelete args text))));
None; None]
let images = seq ["cut.gif"; "copy.gif"; "paste.gif";
"delete.gif"; "undo.gif"; "redo.gif"; ]
let toolbar = new ToolBar()
Seq.zip commands images |> addButtonsWithSeparator toolbar 4
// Add the command bindings
let addBind cmd = ignore(win.CommandBindings.Add cmd)
// exe - ExecutionRoutedEventHandler
// can - CanExecuteRoutedEventHandler
Seq.zip commands handlers |> Seq.iter (fun (cmd,optHandler) ->
match optHandler with
| Some((exe,can)) -> new CommandBinding(cmd,exe,can) |> addBind
| None -> new CommandBinding(cmd) |> addBind)
toolbar
// from FormatRichText.Char.cs example
let createCharToolbar (text:RichTextBox) =
// Some utility function so we can apply DRY principles
// Utility code use to build toggle buttons for FontWeight & FontStyle
let buildToggleButton tip image (property:DependencyProperty) checkedprop uncheckedprop =
let tip = new ToolTip(Content="tip")
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + image))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let button = new ToggleButton(Content=img,ToolTip=tip)
button.Checked.Add(fun args ->
(property,checkedprop)
|> text.Selection.ApplyPropertyValue)
button.Unchecked.Add(fun args ->
(property,uncheckedprop)
|> text.Selection.ApplyPropertyValue)
button
// Utility code use to build menu items for Foreground/Background color
let buildColorMenuItems tip image (property:DependencyProperty) =
let tip = new ToolTip(Content="tip")
let bitmap = new BitmapImage(new Uri(@"file:///icons/" + image))
let img = new Image(Source=bitmap,Stretch=Stretch.None)
let item = new MenuItem(Header=img,ToolTip=tip)
let colorgrid = new ColorGridBox()
colorgrid.SelectionChanged.Add(fun _ ->
(property,colorgrid.SelectedValue)
|> text.Selection.ApplyPropertyValue)
item.Items.Add(colorgrid) |> ignore
item
let toolbar = new ToolBar()
// Create ComboBox for font families
toolbar.Items.Add
(let tip = new ToolTip(Content="Font Family")
let combo = new ComboBox(Width = 144.0,
ItemsSource = Fonts.SystemFontFamilies,
ToolTip = tip,
SelectedItem = text.FontFamily)
// Implement FamilyComboOnSelection - notice that
// control properties and behavior are a define and not
// separated in the code as in Petzold's example.
combo.SelectionChanged.Add(fun args ->
let family = combo.SelectedItem :?> FontFamily
if (family <> null) then
(FlowDocument.FontFamilyProperty,family)
|> text.Selection.ApplyPropertyValue
text.Focus() |>ignore)
combo) |>ignore
// Create ComboBox for font size
toolbar.Items.Add
(let fontsizes = seq [8.0; 9.0; 10.0; 11.0; 12.0; 14.0; 16.0; 18.0;
20.0; 22.0; 24.0; 26.0; 28.0; 36.0; 48.0; 72.0]
let tip = new ToolTip(Content="Font Size")
let combo = new ComboBox(Width = 48.0,
ItemsSource = fontsizes,
ToolTip = tip,
IsEditable = true,
IsReadOnly=false,
Text = (text.FontSize).ToString())
// Implement SizeComboOnSelection
combo.SelectionChanged.Add( fun args ->
if (combo.SelectedIndex <> -1) then
let size = (combo.SelectedValue :?> double)
text.Selection.ApplyPropertyValue(FlowDocument.FontSizeProperty, size)
originalFontSize <- Float.to_string size
text.Focus() |>ignore)
// Implement SizeComboOnGotFocus
combo.GotKeyboardFocus.Add(fun _ ->
originalFontSize <- combo.Text)
// Implement SizeComboOnLostFocus
combo.LostKeyboardFocus.Add(fun _ ->
let (valid,size) = Double.TryParse(combo.Text)
// Needed to add the addition filter (combo.SelectedIndex = -1)
// or font size drop down doesn't work properly.
if valid && (combo.SelectedIndex = -1) then
text.Selection.ApplyPropertyValue (FlowDocument.FontSizeProperty,size)
else
combo.Text <- originalFontSize
)
// Implement SizeComboOnKeyDown
combo.PreviewKeyDown.Add(fun args ->
match args.Key with
| Key.Escape ->
combo.Text <- originalFontSize
args.Handled <- true
text.Focus() |> ignore
| Key.Enter ->
args.Handled <- true
text.Focus() |> ignore
| _ -> ())
combo) |>ignore
// Create Bold Button
toolbar.Items.Add
(let prop = FlowDocument.FontWeightProperty
let bold = FontWeights.Bold
let normal =FontWeights.Normal
let button = buildToggleButton "Bold" "bold.png" prop bold normal
// Petzold's original implementation with text.SelectionChanged
// didn't do anything, I changed to using TextChanged event,
// which occurs when any content or format changes
text.TextChanged.Add(fun _ ->
let font = text.Selection.GetPropertyValue(FlowDocument.FontWeightProperty)
:?> FontWeight
button.IsChecked <-
if font = FontWeights.Bold then
new Nullable<bool>(true)
else new Nullable<bool>(false)
)
button) |>ignore
// Create Italic Button
toolbar.Items.Add
(let prop = FlowDocument.FontStyleProperty
let italic = FontStyles.Italic
let normal = FontStyles.Normal
let button = buildToggleButton "Italic" "italic.png" prop italic normal
text.TextChanged.Add(fun _ ->
let style = text.Selection.GetPropertyValue(FlowDocument.FontStyleProperty)
:?> FontStyle
button.IsChecked <-
if style = FontStyles.Italic then
new Nullable<bool>(true)
else new Nullable<bool>(false)
)
button
) |>ignore
// Create Background and Foreground Color Menus
toolbar.Items.Add
(let menu = new Menu()
// Add background color menu
let item = (buildColorMenuItems "Background Color" "bgcolor.png" FlowDocument.BackgroundProperty)
ignore(menu.Items.Add(item))
// Add foreground color menu
let item = (buildColorMenuItems "Foreground Color" "fgcolor.png" FlowDocument.ForegroundProperty)
ignore(menu.Items.Add(item))
menu) |> ignore
// Petzold also implemented a bunch of other RichTextBox Selection Changed events
// I elected to skip those as I could not see how you can change those other properties
// without going through the toolbar controls. If you had separate menu controls, then
// it would make sense to implement them. In any case, the implementation for
// FontStyle and FontWeight are illustrative examples of how to implement TextChanged
// events.
toolbar
// from FormatRichText.Para.cs example
let createParagraphToolbar (text:RichTextBox) =
let createbutton (align:TextAlignment) (btntip:string) (offsetLeft:float) (offsetRight:float) =
let canv = new Canvas(Width=16.0,Height=16.0)
[0..4] |> Seq.iter( fun i ->
let poly = new Polyline(Stroke=SystemColors.WindowTextBrush,
StrokeThickness = 1.0)
match i with
| 1 | 3 ->
poly.Points <-
new PointCollection([|new Point (2.0+ offsetLeft,
2.0+3.0*Int32.to_float i);
new Point (14.0+ offsetRight,
2.0+3.0*Int32.to_float i)|])
| _ ->
poly.Points <-
new PointCollection([|new Point (2.0,2.0+3.0*Int32.to_float i);
new Point (14.0,2.0+3.0*Int32.to_float i)|])
canv.Children.Add(poly)|>ignore)
let tip = new ToolTip(Content=btntip)
let btn = new ToggleButton(Tag=align,Content=canv,ToolTip=tip)
// Checked the button when clicked on
btn.Click.Add(fun args ->
btn.IsChecked <- new Nullable<bool>(true)
text.Selection.ApplyPropertyValue(Paragraph.TextAlignmentProperty,align))
// Uncheck all the other text alignment buttons
text.TextChanged.Add( fun _ ->
let checkAlignment = text.Selection.GetPropertyValue(Paragraph.TextAlignmentProperty)
:?> TextAlignment
if align <> checkAlignment then
btn.IsChecked <- new Nullable<bool>(false))
btn
let toolbar = new ToolBar()
toolbar.Items.Add(createbutton TextAlignment.Left "Align Left" 0.0 4.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Center "" 2.0 2.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Right "Align Right" 4.0 0.0) |>ignore
toolbar.Items.Add(createbutton TextAlignment.Justify "Justify" 0.0 0.0) |>ignore
toolbar
// Not really a toolbar - but packaging it under ToolbarFactory
// From FormatRichText.Status.cs example
let createStatusbar () =
let status = new StatusBar()
let itemDateTime = new StatusBarItem(HorizontalAlignment = HorizontalAlignment.Right)
status.Items.Add(itemDateTime) |> ignore
let tmr = new DispatcherTimer(Interval = TimeSpan.FromSeconds(1.0))
tmr.Tick.Add( fun e ->
let dt = DateTime.Now
itemDateTime.Content <- dt.ToLongDateString() + " " + dt.ToLongTimeString())
tmr.Start()
status
//----------------------------------------------------------------------------
// Main section where we compose our WPF components
//----------------------------------------------------------------------------
let dock = new DockPanel(LastChildFill=false)
let window = new Window(Title="Format Rich Text",
Content=dock)
let tray = new ToolBarTray()
dock.Children.Add(tray) |> ignore
DockPanel.SetDock(tray,Dock.Top)
let txtbox = new RichTextBox (VerticalScrollBarVisibility = ScrollBarVisibility.Auto)
dock.Children.Add(txtbox)
// Create all the toolbars and add to ToolBarTray
// Add file toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createFileToolbar txtbox.Document window
toolbar.Band <- 0
toolbar.BandIndex <- 0
toolbar)
// Add edit toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createEditToolbar txtbox window
toolbar.Band <- 1
toolbar.BandIndex <- 0
toolbar)
// Add char toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createCharToolbar txtbox
toolbar.Band <- 2
toolbar.BandIndex <- 1
toolbar)
// Add paragraph toolbar
tray.ToolBars.Add
(let toolbar = ToolbarFactory.createParagraphToolbar txtbox
toolbar.Band <- 2
toolbar.BandIndex <- 0
toolbar)
// Add Status Bar
let status = ToolbarFactory.createStatusbar()
dock.Children.Add(status)
DockPanel.SetDock(status,Dock.Bottom)
#if COMPILED
[<STAThread()>]
do
let app = Application() in
app.Run(window) |> ignore
#endif
Posts
1 comment:
Are you looking to earn money from your websites or blogs by popup advertisments?
If so, have you ever used ExoClick?
Post a Comment