3 people like it.

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 New version

More information

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