43 people like it.

WinForms layout combinators

A domain specific language for creating layout using Windows Forms. The snippet implements combinators for creating controls and simple automatic arrangement of them.

Layout combinators

 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: 
35: 
36: 
37: 
38: 

  /// Add single control to the layout
  let (!!) (ctrl:#Control) (x, y) =
    ctrl.Left <- x
    ctrl.Top <- y
    x + ctrl.Width, y + ctrl.Height, [ctrl :> Control]

  /// Add border around the specified layout
  let margin (sizew, sizeh) f (x, y) = 
    let w, h, ctrls = f (x + sizew, y + sizeh)
    w + sizew, h + sizeh, ctrls

  /// Add controls in the layout to a control or form
  let createLayout layout = 
    layout (0, 0) |> ignore

  /// Place two layouts beside each other horizontally
  let ( <||> ) f1 f2 (x, y) = 
    let w1, h1, ctrls1 = f1 (x, y)
    let w2, h2, ctrls2 = f2 (w1, y)
    max w1 w2, max h1 h2, ctrls1 @ ctrls2

  (Other composition combinators omitted)

  /// Creates a rectangle control filled with the specified color
  let rectangle (w, h) clr = 
    !! (new Control(BackColor = clr, Width = w, Height = h))
          
  /// Create label using the specified font         
  let label (w, h) fnt s = 
    !!(new Label(Text = s, Font = fnt, Width = w, Height = h, 
                 TextAlign = ContentAlignment.MiddleLeft))
  
  /// Normal system font
  let normal = SystemFonts.DefaultFont
  /// Bold version of normal font
  let title = new Font(SystemFonts.DialogFont, FontStyle.Bold)
  /// Larger and bold version of normal font
  let head = new Font(SystemFonts.DialogFont.FontFamily, 10.0f, FontStyle.Bold)

Sample dialog window

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 

  let form = new Form(TopMost = true, Visible = true, Width = 500)
  let name = new TextBox()
  let msg = new TextBox()
  !! form <//> 
  ( ( rectangle (500, 40) Color.White <//>
      margin (10, 10) ( label (500, 20) head "Hello world!") ) <=>
    margin (10, 15)
      ( label (450, 36) normal 
          ("This sample demonstrates how to create a simple layout using combinators" +
           "in F#. Please enter some information to these two boxes:") <=>
        margin (10, 5)
          ( ( label (100, 22) title "Name: " <||> !!name) <=> 
            ( label (100, 22) title "Message: " <||> !!msg) ) ) )
  |> createLayout
val ctrl : #Control
Multiple items
type Control =
  inherit Component
  new : unit -> Control + 4 overloads
  member AccessibilityObject : AccessibleObject
  member AccessibleDefaultActionDescription : string with get, set
  member AccessibleDescription : string with get, set
  member AccessibleName : string with get, set
  member AccessibleRole : AccessibleRole with get, set
  member AllowDrop : bool with get, set
  member Anchor : AnchorStyles with get, set
  member AutoScrollOffset : Point with get, set
  member AutoSize : bool with get, set
  ...
  nested type ControlAccessibleObject
  nested type ControlCollection

Full name: System.Windows.Forms.Control

--------------------
Control() : unit
Control(text: string) : unit
Control(parent: Control, text: string) : unit
Control(text: string, left: int, top: int, width: int, height: int) : unit
Control(parent: Control, text: string, left: int, top: int, width: int, height: int) : unit
val x : int
val y : int
property Control.Left: int
property Control.Top: int
property Control.Width: int
property Control.Height: int
val margin : sizew:int * sizeh:int -> f:(int * int -> int * int * 'a) -> x:int * y:int -> int * int * 'a

Full name: Script.Layout.margin


 Add border around the specified layout
val sizew : int
val sizeh : int
val f : (int * int -> int * int * 'a)
val w : int
val h : int
val ctrls : 'a
val createLayout : layout:(int * int -> 'a) -> unit

Full name: Script.Layout.createLayout


 Add controls in the layout to a control or form
val layout : (int * int -> 'a)
val ignore : value:'T -> unit

Full name: Microsoft.FSharp.Core.Operators.ignore
val f1 : ('a * 'b -> 'c * 'd * 'e list) (requires comparison and comparison)
val f2 : ('c * 'b -> 'c * 'd * 'e list) (requires comparison and comparison)
val x : 'a
val y : 'b
val w1 : 'c (requires comparison)
val h1 : 'd (requires comparison)
val ctrls1 : 'e list
val w2 : 'c (requires comparison)
val h2 : 'd (requires comparison)
val ctrls2 : 'e list
val max : e1:'T -> e2:'T -> 'T (requires comparison)

Full name: Microsoft.FSharp.Core.Operators.max
/// Place two layouts beside each other vertically
  let ( <=> ) f1 f2 (x, y) =
    let w1, h1, ctrls1 = f1 (x, y)
    let w2, h2, ctrls2 = f2 (x, h1)
    max w1 w2, max h1 h2, ctrls1 @ ctrls2

  /// Place two layouts over each other
  let ( <//> ) f1 f2 (x, y) =
    let w, h, ctrls1 = f1 (x, y)
    let _, _, ctrls2 = f2 (0, 0)
    match ctrls1 with
    | [single:Control] -> single.Controls.AddRange(Array.ofSeq ctrls2)
    | _ -> failwith "Children can be added on a single control layout only"
    w, h, ctrls1
val rectangle : w:int * h:int -> clr:Color -> (int * int -> int * int * Control list)

Full name: Script.Layout.rectangle


 Creates a rectangle control filled with the specified color
val clr : Color
val label : w:int * h:int -> fnt:Font -> s:string -> (int * int -> int * int * Control list)

Full name: Script.Layout.label


 Create label using the specified font
val fnt : Font
val s : string
Multiple items
type Label =
  inherit Control
  new : unit -> Label
  member AutoEllipsis : bool with get, set
  member AutoSize : bool with get, set
  member BackgroundImage : Image with get, set
  member BackgroundImageLayout : ImageLayout with get, set
  member BorderStyle : BorderStyle with get, set
  member FlatStyle : FlatStyle with get, set
  member GetPreferredSize : proposedSize:Size -> Size
  member Image : Image with get, set
  member ImageAlign : ContentAlignment with get, set
  ...

Full name: System.Windows.Forms.Label

--------------------
Label() : unit
Multiple items
namespace System.Drawing.Text

--------------------
namespace System.Text
Multiple items
type Font =
  inherit MarshalByRefObject
  new : prototype:Font * newStyle:FontStyle -> Font + 12 overloads
  member Bold : bool
  member Clone : unit -> obj
  member Dispose : unit -> unit
  member Equals : obj:obj -> bool
  member FontFamily : FontFamily
  member GdiCharSet : byte
  member GdiVerticalFont : bool
  member GetHashCode : unit -> int
  member GetHeight : unit -> float32 + 2 overloads
  ...

Full name: System.Drawing.Font

--------------------
Font(prototype: Font, newStyle: FontStyle) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, style: FontStyle) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(familyName: string, emSize: float32, style: FontStyle, unit: GraphicsUnit) : unit
   (+0 other overloads)
Font(family: FontFamily, emSize: float32, style: FontStyle, unit: GraphicsUnit, gdiCharSet: byte) : unit
   (+0 other overloads)
type ContentAlignment =
  | TopLeft = 1
  | TopCenter = 2
  | TopRight = 4
  | MiddleLeft = 16
  | MiddleCenter = 32
  | MiddleRight = 64
  | BottomLeft = 256
  | BottomCenter = 512
  | BottomRight = 1024

Full name: System.Drawing.ContentAlignment
field ContentAlignment.MiddleLeft = 16
val normal : Font

Full name: Script.Layout.normal


 Normal system font
type SystemFonts =
  static member CaptionFont : Font
  static member DefaultFont : Font
  static member DialogFont : Font
  static member GetFontByName : systemFontName:string -> Font
  static member IconTitleFont : Font
  static member MenuFont : Font
  static member MessageBoxFont : Font
  static member SmallCaptionFont : Font
  static member StatusFont : Font

Full name: System.Drawing.SystemFonts
property SystemFonts.DefaultFont: Font
val title : Font

Full name: Script.Layout.title


 Bold version of normal font
property SystemFonts.DialogFont: Font
type FontStyle =
  | Regular = 0
  | Bold = 1
  | Italic = 2
  | Underline = 4
  | Strikeout = 8

Full name: System.Drawing.FontStyle
field FontStyle.Bold = 1
val head : Font

Full name: Script.Layout.head


 Larger and bold version of normal font
property Font.FontFamily: FontFamily
val form : Form
Multiple items
type Form =
  inherit ContainerControl
  new : unit -> Form
  member AcceptButton : IButtonControl with get, set
  member Activate : unit -> unit
  member ActiveMdiChild : Form
  member AddOwnedForm : ownedForm:Form -> unit
  member AllowTransparency : bool with get, set
  member AutoScale : bool with get, set
  member AutoScaleBaseSize : Size with get, set
  member AutoScroll : bool with get, set
  member AutoSize : bool with get, set
  ...
  nested type ControlCollection

Full name: System.Windows.Forms.Form

--------------------
Form() : unit
val name : TextBox
Multiple items
type TextBox =
  inherit TextBoxBase
  new : unit -> TextBox
  member AcceptsReturn : bool with get, set
  member AutoCompleteCustomSource : AutoCompleteStringCollection with get, set
  member AutoCompleteMode : AutoCompleteMode with get, set
  member AutoCompleteSource : AutoCompleteSource with get, set
  member CharacterCasing : CharacterCasing with get, set
  member Multiline : bool with get, set
  member PasswordChar : char with get, set
  member Paste : text:string -> unit
  member ScrollBars : ScrollBars with get, set
  ...

Full name: System.Windows.Forms.TextBox

--------------------
TextBox() : unit
val msg : TextBox
type Color =
  struct
    member A : byte
    member B : byte
    member Equals : obj:obj -> bool
    member G : byte
    member GetBrightness : unit -> float32
    member GetHashCode : unit -> int
    member GetHue : unit -> float32
    member GetSaturation : unit -> float32
    member IsEmpty : bool
    member IsKnownColor : bool
    ...
  end

Full name: System.Drawing.Color
property Color.White: Color
Raw view Test code New version

More information

Link:http://fssnip.net/1b
Posted:13 years ago
Author:Tomas Petricek
Tags: dsl , combinators , winforms , layout

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.