3 people like it.
Like the snippet!

Union Editor for WinForms PropertyGrid

A quick-and-dirty editor for discriminated unions in a property grid. I use this for editing trees of F# records and unions. Note that any records must have a "Default" static property which returns a default instance.

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34:

open System.Drawing.Design
open System.Windows.Forms.Design
open System.Windows.Forms


module private EditorInternals =
    let buildDefaultType (cType: Type) = 
        if cType.IsValueType then Activator.CreateInstance(cType)
        elif FSharpType.IsRecord cType then
            let pi : PropertyInfo = cType.GetProperty("Default", cType) in               
                pi.GetValue(null, null)
        else failwith (sprintf "Unsupported Type: %s" cType.Name)

type UnionEditor () =
    inherit System.Drawing.Design.UITypeEditor () 
    override t.GetEditStyle (context) = UITypeEditorEditStyle.DropDown
    override t.EditValue (context, provider, value) =
        let wfes = provider.GetService(typeof<IWindowsFormsEditorService>) :?> IWindowsFormsEditorService 
        if wfes <> null && FSharpType.IsUnion( context.PropertyDescriptor.PropertyType ) then
            let lb = new ListBox()
            lb.SelectionMode <- SelectionMode.One
            lb.Click.Add (fun _ -> wfes.CloseDropDown())
            let currentCase, args = FSharpValue.GetUnionFields(value,context.PropertyDescriptor.PropertyType)
            let cases = FSharpType.GetUnionCases context.PropertyDescriptor.PropertyType 
            for case in cases do 
                lb.Items.Add(case.Name) |> ignore
                if case = currentCase then lb.SelectedItem <- case.Name
            wfes.DropDownControl(lb)
            if lb.SelectedItem <> null && lb.SelectedIndices.Count = 1 && (lb.SelectedItem :?> string) <> currentCase.Name then 
                let newCase = cases |> Array.find (fun case -> case.Name = (lb.SelectedItem :?> string))
                let newargs = newCase.GetFields() |> Array.map (fun pi -> EditorInternals.buildDefaultType pi.PropertyType)
                FSharpValue.MakeUnion(newCase, newargs)
            else value
        else value

namespace System

namespace System.Drawing

namespace System.Drawing.Design

namespace System.Windows

namespace System.Windows.Forms

namespace System.Windows.Forms.Design

val private buildDefaultType : cType:'a -> 'b

Full name: Script.EditorInternals.buildDefaultType

val cType : 'a

val pi : obj

val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith

val sprintf : format:Printf.StringFormat<'T> -> 'T

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.sprintf

Multiple items
type UnionEditor =
  inherit UITypeEditor
  new : unit -> UnionEditor
  override EditValue : context:ITypeDescriptorContext * provider:IServiceProvider * value:obj -> obj
  override GetEditStyle : context:ITypeDescriptorContext -> UITypeEditorEditStyle

Full name: Script.UnionEditor

--------------------
new : unit -> UnionEditor

Multiple items
type UITypeEditor =
  new : unit -> UITypeEditor
  member EditValue : provider:IServiceProvider * value:obj -> obj + 1 overload
  member GetEditStyle : unit -> UITypeEditorEditStyle + 1 overload
  member GetPaintValueSupported : unit -> bool + 1 overload
  member IsDropDownResizable : bool
  member PaintValue : e:PaintValueEventArgs -> unit + 1 overload

Full name: System.Drawing.Design.UITypeEditor

--------------------
UITypeEditor() : unit

val t : UnionEditor

override UnionEditor.GetEditStyle : context:System.ComponentModel.ITypeDescriptorContext -> UITypeEditorEditStyle

Full name: Script.UnionEditor.GetEditStyle

val context : System.ComponentModel.ITypeDescriptorContext

type UITypeEditorEditStyle =
  | None = 1
  | Modal = 2
  | DropDown = 3

Full name: System.Drawing.Design.UITypeEditorEditStyle

field UITypeEditorEditStyle.DropDown = 3

override UnionEditor.EditValue : context:System.ComponentModel.ITypeDescriptorContext * provider:System.IServiceProvider * value:obj -> obj

Full name: Script.UnionEditor.EditValue

val provider : System.IServiceProvider

val value : obj

val wfes : IWindowsFormsEditorService

System.IServiceProvider.GetService(serviceType: System.Type) : obj

val typeof<'T> : System.Type

Full name: Microsoft.FSharp.Core.Operators.typeof

type IWindowsFormsEditorService =
  member CloseDropDown : unit -> unit
  member DropDownControl : control:Control -> unit
  member ShowDialog : dialog:Form -> DialogResult

Full name: System.Windows.Forms.Design.IWindowsFormsEditorService

property System.ComponentModel.ITypeDescriptorContext.PropertyDescriptor: System.ComponentModel.PropertyDescriptor

property System.ComponentModel.PropertyDescriptor.PropertyType: System.Type

val lb : ListBox

Multiple items
type ListBox =
  inherit ListControl
  new : unit -> ListBox
  member BackColor : Color with get, set
  member BackgroundImage : Image with get, set
  member BackgroundImageLayout : ImageLayout with get, set
  member BeginUpdate : unit -> unit
  member BorderStyle : BorderStyle with get, set
  member ClearSelected : unit -> unit
  member ColumnWidth : int with get, set
  member CustomTabOffsets : IntegerCollection
  member DrawMode : DrawMode with get, set
  ...
  nested type IntegerCollection
  nested type ObjectCollection
  nested type SelectedIndexCollection
  nested type SelectedObjectCollection

Full name: System.Windows.Forms.ListBox

--------------------
ListBox() : unit

property ListBox.SelectionMode: SelectionMode

type SelectionMode =
  | None = 0
  | One = 1
  | MultiSimple = 2
  | MultiExtended = 3

Full name: System.Windows.Forms.SelectionMode

field SelectionMode.One = 1

Multiple items
event ListBox.Click: IEvent<System.EventHandler,System.EventArgs>

--------------------
event Control.Click: IEvent<System.EventHandler,System.EventArgs>

member System.IObservable.Add : callback:('T -> unit) -> unit

IWindowsFormsEditorService.CloseDropDown() : unit

val currentCase : obj

val args : obj

val cases : obj []

val case : obj

property ListBox.Items: ListBox.ObjectCollection

ListBox.ObjectCollection.Add(item: obj) : int

val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore

property ListBox.SelectedItem: obj

IWindowsFormsEditorService.DropDownControl(control: Control) : unit

property ListBox.SelectedIndices: ListBox.SelectedIndexCollection

property ListBox.SelectedIndexCollection.Count: int

Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string

val newCase : obj

module Array

from Microsoft.FSharp.Collections

val find : predicate:('T -> bool) -> array:'T [] -> 'T

Full name: Microsoft.FSharp.Collections.Array.find

val newargs : obj []

val map : mapping:('T -> 'U) -> array:'T [] -> 'U []

Full name: Microsoft.FSharp.Collections.Array.map

module EditorInternals

from Script

Raw view Test code New version

More information

Link:	http://fssnip.net/9u
Posted:	13 years ago
Author:	Rick Minerich
Tags:	winforms , propertygrid , discriminated unions