Friday, February 29, 2008

Learning WPF with F# - TreeView and ListView

Working through Chapter 16 of Petzold's bookApplications = Code + Markup: A Guide to the Microsoft Windows Presentation Foundation.

The most interesting effort in working through these examples is converting the repeated if statements in the implementation of Convert method in MetadataToFlags to use zip,filter,map and combine. The column definitions in DependencyPropertyListView has also been refactored to define all the definitions in a list and iterate through the list to create each GridViewColumn.


ManuallyPopulateTreeView

#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 16 - ManuallyPopulateTreeView
//
//----------------------------------------------------------

let addSubItems items (branch:TreeViewItem) = items |> Seq.iter (fun item ->
item |> branch.Items.Add |> ignore)

let tree = new TreeView()

tree.Items.Add
(let animalBranch = new TreeViewItem(Header="Animal")

animalBranch.Items.Add
(let branch = new TreeViewItem(Header="Dog")
let dogs = ["Poodle";"Irish Setter";"German Shepherd"]
addSubItems dogs branch
branch) |>ignore

animalBranch.Items.Add
(let branch = new TreeViewItem(Header="Cat")
branch.Items.Add(new TreeViewItem(Header="Alley Cat")) |>ignore
branch.Items.Add(new Button(Content="Noodles")) |>ignore
branch.Items.Add("Siamese") |>ignore
branch) |> ignore

animalBranch.Items.Add
(let branch = new TreeViewItem(Header="Primate")
let primates = ["Chimpanzee";"Bonobo";"Human"]
addSubItems primates branch
branch) |> ignore
animalBranch) |> ignore

tree.Items.Add
(let branch = new TreeViewItem(Header="Mineral")
let minerals = ["Calcium";"Zinc";"Iron"]
addSubItems minerals branch
branch) |> ignore

tree.Items.Add
(let branch = new TreeViewItem(Header="Vegetable")
let vegetables = ["Carrot";"Asparagus";"Broccoli"]
addSubItems vegetables branch
branch) |> ignore

let window = new Window(Title="Manually Populate TreeView",
Content=tree)


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

RecurseDirectoriesInefficiently

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

open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
//
// From Chapter 16 - RecurseDirectoriesInefficiently
//
//----------------------------------------------------------

let rec GetSubDir (item:TreeViewItem) =
let dir = item.Tag :?> DirectoryInfo
try
dir.GetDirectories() |> Seq.iter (fun subdir ->
let subitem = new TreeViewItem(Header=subdir.Name,Tag=subdir)
subitem |> item.Items.Add |> ignore
// recursively obtain subdirectories
subitem |> GetSubDir)
with _ -> ()

let tree = new TreeView()

tree.Items.Add
(let item = new TreeViewItem(Header = Path.GetPathRoot(Environment.SystemDirectory))
item.Tag <- new DirectoryInfo(item.Header :?> string)
GetSubDir item
item)|>ignore


let window = new Window(Title="Recurse Directories Inefficiently",
Content=tree)


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

RecurseDirectoriesIncrementally

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

open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging
//----------------------------------------------------------
// From Chapter 16 RecurseDirectoriesIncrementally
//----------------------------------------------------------
let selectedImage = new BitmapImage(new Uri("file:///icons/OPENFOLD.BMP"))
let unselectedImage = new BitmapImage(new Uri("file:///icons/CLSDFOLD.BMP"))
let cddriveImage = new BitmapImage(new Uri("file:///icons/CDDRIVE.BMP"))
let driveImage = new BitmapImage(new Uri("file:///icons/DRIVE.BMP"))
let floppyImage = new BitmapImage(new Uri("file:///icons/35FLOPPY.BMP"))

//
// From Chapter 16 – ImagedTreeViewItem
//
type ImagedTreeViewItem() = class
inherit TreeViewItem() as base

let stack = new StackPanel(Orientation=Orientation.Horizontal)
let img = new Image(VerticalAlignment = VerticalAlignment.Center,
Margin = new Thickness(0.0, 0.0, 2.0, 0.0))
let text = new TextBlock(VerticalAlignment = VerticalAlignment.Center)
let mutable srcSelected:ImageSource = null
let mutable srcUnselected:ImageSource = null

do
base.Header <- stack
img |> stack.Children.Add |> ignore
text |> stack.Children.Add |> ignore

member this.Text
with get() = text.Text
and set value =
text.Text <- value

member this.SelectedImage
with get() = srcSelected
and set value =
srcSelected <- value
if (this.IsSelected) then img.Source <- srcSelected

member this.UnselectedImage
with get() = srcUnselected
and set value =
srcUnselected <- value
if (this.IsSelected=false) then img.Source <- srcUnselected

override this.OnSelected (args:RoutedEventArgs ) =
base.OnSelected(args)
img.Source <- selectedImage

override this.OnUnselected (args:RoutedEventArgs ) =
base.OnUnselected(args)
img.Source <- unselectedImage

end

//
// From Chapter 16 – DirectoryTreeViewItem
//
type DirectoryTreeViewItem = class
inherit ImagedTreeViewItem as base

val mutable dir:DirectoryInfo

new (rootdir:DirectoryInfo) as this = {dir=rootdir} then
base.Text <- this.dir.Name

member this.DirectoryInfo
with get() = this.dir

member this.Populate () =
try
this.dir.GetDirectories()
|> Seq.iter (fun child ->
new DirectoryTreeViewItem(child)
|> this.Items.Add |> ignore)

with _ -> ()

override this.OnExpanded (args:RoutedEventArgs) =
base.OnExpanded(args)

this.Items |> Seq.untyped_to_typed
|> Seq.iter (fun (item:DirectoryTreeViewItem) ->
item.Populate())

end

//
// From Chapter 16 – DirectoryTreeView
//
type DirectoryTreeView() = class
inherit TreeView() as base

member this.RefreshTree() =
this.BeginInit()
this.Items.Clear()

DriveInfo.GetDrives() |> Seq.iter (fun (drive:DriveInfo) ->
let chDrive = String.get (drive.Name|> String.capitalize) 0
let item = new DirectoryTreeViewItem(drive.RootDirectory)
if (chDrive <> 'A' && chDrive <> 'B' && drive.IsReady && drive.VolumeLabel.Length > 0) then
item.Text <- String.Format("{0} ({1})",drive.VolumeLabel,drive.Name)
else
item.Text <- String.Format("{0} ({1})",drive.DriveType,drive.Name)

if (chDrive = 'A' || chDrive = 'B') then
item.SelectedImage <- floppyImage
item.UnselectedImage <- floppyImage
else if (drive.DriveType = DriveType.CDRom) then
item.SelectedImage <- cddriveImage
item.UnselectedImage <- cddriveImage
else
item.SelectedImage <- driveImage
item.UnselectedImage <- driveImage

//item.Selected.Add(fun _ -> ())

item |> this.Items.Add |> ignore
if (chDrive <> 'A' && chDrive <> 'B' && drive.IsReady) then
item.Populate()
this.EndInit()
)
end


//
// From Chapter 16 – RecurseDirectoriesIncrementally
//
let tree = new DirectoryTreeView()
tree.RefreshTree()
let stack = new StackPanel()

tree.SelectedItemChanged.Add(fun args ->
let item = args.NewValue :?> DirectoryTreeViewItem
stack.Children.Clear()

try
item.DirectoryInfo.GetFiles() |> Seq.iter (fun info ->
let text = new TextBlock(Text=info.Name)
text |> stack.Children.Add |> ignore)
with _ -> ()
)

let grid = new Grid()

[new ColumnDefinition(Width=new GridLength(50.0, GridUnitType.Star));
new ColumnDefinition(Width=GridLength.Auto);
new ColumnDefinition(Width=new GridLength(50.0, GridUnitType.Star))]
|> List.iter grid.ColumnDefinitions.Add

tree |> grid.Children.Add
Grid.SetColumn(tree,0)

let split = new GridSplitter(Width=6.0,
ResizeBehavior = GridResizeBehavior.PreviousAndNext)
split |> grid.Children.Add
Grid.SetColumn(split,1)

let scroll = new ScrollViewer(Content = stack)
scroll |> grid.Children.Add
Grid.SetColumn(scroll,2)

let window = new Window(Title="Recurse Directories Incrementally",
Content=grid)

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

TemplateTheTree & DiskDirectory

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

open System
open System.IO
open System.Windows
open System.Windows.Controls
open System.Windows.Data
open System.Windows.Input
open System.Windows.Media
open System.Windows.Media.Imaging
//
// From Chapter 16 TemplateTheTree & DiskDirectory
//
//----------------------------------------------------------

type DiskDirectory = class

val mutable dirinfo:DirectoryInfo

new (rootdir:DirectoryInfo) as this = {dirinfo=rootdir}

member this.Name
with get() = this.dirinfo

member this.Subdirectories
with get() =
let dirs = new ResizeArray<DiskDirectory>()
try
this.dirinfo.GetDirectories() |> Seq.iter (fun subdir ->
dirs.Add(new DiskDirectory(subdir)))
with _ -> ()
dirs


end

let treevue = new TreeView()

let window = new Window(Title="Template the Tree",
Content=treevue)

let template = new HierarchicalDataTemplate(typeof<DiskDirectory>)
template.ItemsSource <- new Binding("Subdirectories")
let factoryTextBlock = new FrameworkElementFactory(typeof<TextBlock>)

(TextBlock.TextProperty, new Binding("Name"))
|> factoryTextBlock.SetBinding

template.VisualTree <- factoryTextBlock

let dir = new DiskDirectory(new DirectoryInfo(Path.GetPathRoot(Environment.SystemDirectory)))

treevue.Items.Add
(let item = new TreeViewItem(Header=dir.Name,
IsExpanded=true,
ItemsSource=dir.Subdirectories,
ItemTemplate=template)
item)

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

ShowClassHierarchy

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

open System
open System.Collections.Generic
open System.Reflection
open System.Windows
open System.Windows.Controls
//
// From Chapter 16 - ShowClassHierarchy
//
//----------------------------------------------------------

type TypeTreeViewItem = class
inherit TreeViewItem as base

val mutable mytype:Type

new () as this = {mytype=null}

member this.Type
with get() = this.mytype
and set (value:Type) =
this.mytype <- value
if (this.mytype.IsAbstract) then
base.Header <- (this.mytype.Name + " (abstract)")
else
base.Header <- this.mytype.Name


end

type ClassHierarchyTreeView = class
inherit TreeView as base

new (typeRoot:Type) as this = {} then
let dummy = new UIElement()
let assemblies = new ResizeArray<Assembly>()
Assembly.GetExecutingAssembly().GetReferencedAssemblies()
|> Seq.iter (fun name -> assemblies.Add(Assembly.Load(name)))
let classes = new SortedList<string,Type>()
classes.Add(typeRoot.Name,typeRoot)

assemblies |> Seq.iter (fun assembly ->
assembly.GetTypes() |> Seq.iter (fun t ->
if (t.IsPublic && t.IsSubclassOf(typeRoot)) then
classes.Add(t.Name,t)))

// create root item
let item = new TypeTreeViewItem(Type=typeRoot)
item |> this.Items.Add |> ignore

// Add recursively
this.CreateLinkedItems item classes



member this.CreateLinkedItems (itemBase:TypeTreeViewItem) (list:SortedList<string,Type>) =
list |> Seq.iter (fun keypair ->
if (keypair.Value.BaseType = itemBase.Type) then
let item = new TypeTreeViewItem(Type=keypair.Value)
itemBase.Items.Add(item) |> ignore
this.CreateLinkedItems item list
)

end

let treevue = new ClassHierarchyTreeView(typeof<System.Windows.Threading.DispatcherObject>)

let window = new Window(Title="Show Class Hierarchy",
Content=treevue)


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

ListSystemParameters

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

open System
open System.Collections.Generic
open System.ComponentModel
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Data
open System.Windows.Input
open System.Windows.Media
//
// From Chapter 16 - ListSystemParameters
//
//----------------------------------------------------------
type SystemParam() = class
let mutable strName=""
let mutable objvalue = null

member this.Name
with get() = strName
and set (value:string) = strName <- value

member this.Value
with get() = objvalue
and set (value:obj) = objvalue <- value

override this.ToString() =
this.Name + "=" + this.Value.ToString()
end


let grdvue = new GridView()
let lstvue = new ListView(View=grdvue)

// Create two GridView columns.
new GridViewColumn(Header="Property Name",
Width=200.0,
DisplayMemberBinding = new Binding("Name"))
|> grdvue.Columns.Add

new GridViewColumn(Header="Value",
Width=200.0,
DisplayMemberBinding = new Binding("Value"))
|> grdvue.Columns.Add


typeof<SystemParameters>.GetProperties() |> Seq.iter (fun prop ->
if (prop.PropertyType <> typeof<ResourceKey>) then
new SystemParam(Name=prop.Name,
Value = prop.GetValue(null,null))
|> lstvue.Items.Add |> ignore
)

let window = new Window(Title="List System Parameters",
Content=lstvue)


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

ListSortedSystemParameters

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

open System
open System.Collections.Generic
open System.ComponentModel
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Data
open System.Windows.Input
open System.Windows.Media
//
// From Chapter 16 - ListSortedSystemParameters
//
//----------------------------------------------------------
type SystemParam() = class
let mutable strName=""
let mutable objvalue = null

member this.Name
with get() = strName
and set (value:string) = strName <- value

member this.Value
with get() = objvalue
and set (value:obj) = objvalue <- value

override this.ToString() =
this.Name + "=" + this.Value.ToString()
end


let grdvue = new GridView()
let lstvue = new ListView(View=grdvue)

// Create two GridView columns.
new GridViewColumn(Header="Property Name",
Width=200.0,
DisplayMemberBinding = new Binding("Name"))
|> grdvue.Columns.Add


// Create DataTemplate for second column
let template = new DataTemplate(typeof<string>)
let factoryTextBlock = new FrameworkElementFactory(typeof<TextBlock>)
(TextBlock.HorizontalAlignmentProperty, HorizontalAlignment.Right)
|> factoryTextBlock.SetValue

(TextBlock.TextProperty,new Binding("Value"))
|> factoryTextBlock.SetBinding

template.VisualTree <- factoryTextBlock

new GridViewColumn(Header="Value",
Width=200.0,
CellTemplate=template,
DisplayMemberBinding = new Binding("Value"))
|> grdvue.Columns.Add

let sortlist = new SortedList<string,SystemParam>()

typeof<SystemParameters>.GetProperties() |> Seq.iter (fun prop ->
if (prop.PropertyType <> typeof<ResourceKey>) then
(prop.Name,
new SystemParam(Name=prop.Name,
Value = prop.GetValue(null,null)))
|> sortlist.Add
)
lstvue.ItemsSource <- sortlist.Values

let window = new Window(Title="List Sorted System Parameters",
Content=lstvue)


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

ExploreDependencyProperties

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

open System
open System.Collections.Generic
open System.ComponentModel
open System.Globalization
open System.Reflection
open System.Windows
open System.Windows.Controls
open System.Windows.Data
open Chapter16 // for ClassHierarchyTreeView
//
// From Chapter 16 - ExploreDependencyProperties
//
//----------------------------------------------------------
type TypeToString() =
interface IValueConverter with
member v.Convert (o:obj,t:Type,param:obj,culture:CultureInfo) =
(o :?> Type).Name :> obj

member v.ConvertBack (o:obj,t:Type,param:obj,culture:CultureInfo) = null


type MetadataToFlags() =
interface IValueConverter with
member v.Convert (o:obj,t:Type,param:obj,culture:CultureInfo) =
// Need to wrap with try/with for those objects that
// only can cast downto PropertyMetadata
try
let metadata = o :?> FrameworkPropertyMetadata

let checks = [metadata.AffectsMeasure;
metadata.AffectsArrange;
metadata.AffectsParentMeasure;
metadata.AffectsParentArrange;
metadata.AffectsRender;
metadata.Inherits;
metadata.OverridesInheritanceBehavior;
metadata.IsNotDataBindable;
metadata.BindsTwoWayByDefault;
metadata.Journal]

let options = [FrameworkPropertyMetadataOptions.AffectsMeasure;
FrameworkPropertyMetadataOptions.AffectsArrange;
FrameworkPropertyMetadataOptions.AffectsParentMeasure;
FrameworkPropertyMetadataOptions.AffectsParentArrange;
FrameworkPropertyMetadataOptions.AffectsRender;
FrameworkPropertyMetadataOptions.Inherits;
FrameworkPropertyMetadataOptions.OverridesInheritanceBehavior;
FrameworkPropertyMetadataOptions.NotDataBindable;
FrameworkPropertyMetadataOptions.BindsTwoWayByDefault;
FrameworkPropertyMetadataOptions.Journal;]

// Instead of a bunch of if statements, I replaced it with
// zip, filter, map and combine...
let flags =
Seq.zip checks options
|> Seq.filter (fun (check,option) -> check)
|> Seq.map (fun (check,option) -> option)
|> Seq.to_list
|> Enum.combine

flags :> obj
with _ ->
FrameworkPropertyMetadataOptions.None :> obj


member v.ConvertBack (o:obj,t:Type,param:obj,culture:CultureInfo) =
let options = o :?> FrameworkPropertyMetadataOptions
new FrameworkPropertyMetadata(null,options) :> obj


let mutable private initTypeProperty : DependencyProperty = null

type DependencyPropertyListView () = class
inherit ListView() as base

do
let grdvue = new GridView()
base.View <- grdvue

let buildTemplate (bind:Binding) converter =
let elTextBlock =new FrameworkElementFactory(typeof<TextBlock>)
let template = new DataTemplate(VisualTree=elTextBlock)
bind.Converter <- converter
(TextBlock.TextProperty,bind) |> elTextBlock.SetBinding
template


let ownerTemplate = buildTemplate (new Binding("OwnerType")) (new TypeToString())
let flagsTemplate = buildTemplate (new Binding("DefaultMetadata")) (new MetadataToFlags())

let coldefs =
[("Name",Some("Name"),None,150.0);
("Owner",None,Some(ownerTemplate),150.0);
("Default",Some("DefaultMetadata.DefaultValue"),None,75.0);
("Read-Only",Some("DefaultMetadata.ReadOnly"),None,75.0);
("Usage",Some("DefaultMetadata.AttachedPropertyUsage"),None,75.0);
("Flags",None,Some(flagsTemplate),250.0);]

coldefs |> Seq.iter (fun (header,bindingOption,templateOption,width) ->
match bindingOption with
| Some binding ->
new GridViewColumn(Header=header,
DisplayMemberBinding = new Binding(binding),
Width=width)
|> grdvue.Columns.Add

| None -> ()

match templateOption with
| Some template ->
new GridViewColumn(Header=header,
CellTemplate = template,
Width=width)
|> grdvue.Columns.Add
| None -> ())

static member TypeProperty =
if initTypeProperty = null then
let metadata =
new PropertyMetadata(null, new PropertyChangedCallback(DependencyPropertyListView.OnTypePropertyChanged))

initTypeProperty <-
DependencyProperty.Register
("Type",
typeof<Type>,
typeof<DependencyPropertyListView>,
metadata)

initTypeProperty

static member OnTypePropertyChanged (obj:DependencyObject) (args:DependencyPropertyChangedEventArgs) =
let lstvue = obj :?> DependencyPropertyListView
let t = args.NewValue :?> Type
lstvue.ItemsSource <- null
if t <> null then
let list = new SortedList<string,DependencyProperty>()
t.GetFields() |> Seq.iter (fun info ->
if info.FieldType = typeof<DependencyProperty> then
(info.Name,(info.GetValue(null) :?> DependencyProperty))
|> list.Add)
lstvue.ItemsSource <- list.Values

member this.Type
with get() =
let value = this.GetValue(DependencyPropertyListView.TypeProperty)
(value :?> DependencyProperty)
and set (value:DependencyProperty) = this.SetValue(DependencyPropertyListView.TypeProperty,value)

end


let treevue = new Chapter16.ClassHierarchyTreeView(typeof<DependencyObject>)
let grid = new Grid()

// create 3 column definitions for Grid
[new GridLength(1.0,GridUnitType.Star);
GridLength.Auto;
new GridLength(3.0,GridUnitType.Star)]
|> Seq.iter (fun width ->
new ColumnDefinition(Width=width) |> grid.ColumnDefinitions.Add)

treevue |> grid.Children.Add
Grid.SetColumn(treevue,0)

let split = new GridSplitter(HorizontalAlignment = HorizontalAlignment.Center,
VerticalAlignment = VerticalAlignment.Stretch,
Width = 6.0)
split |> grid.Children.Add
Grid.SetColumn(split,1)

let lstvue = new DependencyPropertyListView(DataContext=treevue)
lstvue |> grid.Children.Add
Grid.SetColumn(lstvue,2)

(DependencyPropertyListView.TypeProperty, "SelectedItem.Type")
|> lstvue.SetBinding

let window = new Window(Title="Explore Dependency Properties",
Content=grid)


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

Wednesday, February 13, 2008

Learning WPF with F# - Toolbars and Status Bars

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

MoveTheToolbar

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

FormatRichText (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