6 people like it.

Drag and drop in WinForms with evReact

evReact is a library for recognition of events sequences. This snippet shows how to handle drag&drop in WinForms to drag a square into a bigger one without controls.

 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: 
39: 
40: 
41: 
42: 
43: 
44: 
45: 
46: 
47: 
48: 
49: 
50: 
51: 
52: 
53: 
54: 
55: 
56: 
57: 
58: 
59: 
60: 
61: 
62: 
63: 
64: 
open EvReact
open EvReact.Expr
open EvReact.Orchestrator

open System.Windows.Forms
open System.Drawing

let E (e:IEvent<'c,'a>) = 
  let evt = new Control.Event<'a>()
  e.Add(fun e -> evt.Trigger(e))
  evt.Publish

type MyForm() as this =
  inherit Form()

  do this.SetStyle(ControlStyles.AllPaintingInWmPaint ||| ControlStyles.OptimizedDoubleBuffer, true)

let f = new MyForm(Text="Drag&Drop test with evReact", Width=640, Height=600)

let rect = ref(new Rectangle(0, 0, 50, 50))
let target = ref(new Rectangle(300, 300, 200, 200))
let bgcol = ref(Brushes.Red)
let off = ref(new Point())

f.Paint.Add(fun e ->
  let g = e.Graphics
  g.DrawRectangle(Pens.Gray, !target)

  g.FillRectangle(!bgcol, !rect)
  g.DrawRectangle(Pens.Black, !rect)
)

let md = E f.MouseDown
let mm = E f.MouseMove
let mu = E f.MouseUp

// Utilities
let uc col = bgcol := col; f.Invalidate()
let dc col = !bgcol <> col
let inR (p:Point) = (!rect).Contains(p)
let placeR (p:Point) = let r = !rect in rect := new Rectangle(p.X, p.Y, r.Width, r.Height);f.Invalidate()
let inT () = (!target).Contains(!rect)

// Net recognizing hovering
let highlight =
  +(
        ((mm %- fun e -> dc Brushes.Yellow && inR(e.Location)) |-> fun _ -> uc Brushes.Yellow)
    ||| ((mm %- fun e -> dc Brushes.Red && not(inR(e.Location))) |-> fun _ -> uc Brushes.Red)
   )

// Net performing the drag
let drag = 
  +(
     ((md %- fun e -> (!rect).Contains(e.Location)) 
         |-> fun e -> let r = !rect in off := new Point(e.X - r.Left, e.Y - r.Top))
     - ((+(!!mm) |-> fun e -> placeR(new Point(e.X - (!off).X, e.Y - (!off).Y))) / [| mm; mu |])
     - (!!mu |-> fun e -> if not(inT()) then (placeR(new Point()); uc Brushes.Red))
   )

let orch = Orchestrator.create()
Expr.start null orch highlight
Expr.start null orch drag

f.Show()
namespace EvReact
Multiple items
module Expr

from EvReact

--------------------
type Expr<'T>
static member ( |=> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
static member ( |-> ) : Expr<'a> * ('a -> unit) -> Expr<'a>
static member ( &&& ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( ||| ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( / ) : Expr<'a> * IEvent<'a> [] -> Expr<'a>
static member ( - ) : Expr<'a> * Expr<'a> -> Expr<'a>
static member ( ~+ ) : Expr<'a> -> Expr<'a>

Full name: EvReact.Expr<_>
Multiple items
module Orchestrator

from EvReact

--------------------
type Orchestrator<'T>

Full name: EvReact.Orchestrator<_>
namespace System
namespace System.Windows
namespace System.Windows.Forms
namespace System.Drawing
val E : e:IEvent<'c,'a> -> IEvent<'a> (requires delegate and 'c :> System.Delegate)

Full name: Script.E
val e : IEvent<'c,'a> (requires delegate and 'c :> System.Delegate)
type IEvent<'T> = IEvent<Handler<'T>,'T>

Full name: Microsoft.FSharp.Control.IEvent<_>
val evt : Event<'a>
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
Multiple items
module Event

from Microsoft.FSharp.Control

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

Full name: Microsoft.FSharp.Control.Event<_,_>

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

Full name: Microsoft.FSharp.Control.Event<_>

--------------------
new : unit -> Event<'Delegate,'Args>

--------------------
new : unit -> Event<'T>
member System.IObservable.Add : callback:('T -> unit) -> unit
val e : 'a
member Event.Trigger : arg:'T -> unit
property Event.Publish: IEvent<'a>
Multiple items
type MyForm =
  inherit Form
  new : unit -> MyForm

Full name: Script.MyForm

--------------------
new : unit -> MyForm
val this : MyForm
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
type ControlStyles =
  | ContainerControl = 1
  | UserPaint = 2
  | Opaque = 4
  | ResizeRedraw = 16
  | FixedWidth = 32
  | FixedHeight = 64
  | StandardClick = 256
  | Selectable = 512
  | UserMouse = 1024
  | SupportsTransparentBackColor = 2048
  ...

Full name: System.Windows.Forms.ControlStyles
field ControlStyles.AllPaintingInWmPaint = 8192
field ControlStyles.OptimizedDoubleBuffer = 131072
val f : MyForm

Full name: Script.f
namespace System.Drawing.Text
val rect : Rectangle ref

Full name: Script.rect
Multiple items
val ref : value:'T -> 'T ref

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

--------------------
type 'T ref = Ref<'T>

Full name: Microsoft.FSharp.Core.ref<_>
Multiple items
type Rectangle =
  struct
    new : location:Point * size:Size -> Rectangle + 1 overload
    member Bottom : int
    member Contains : pt:Point -> bool + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member Height : int with get, set
    member Inflate : size:Size -> unit + 1 overload
    member Intersect : rect:Rectangle -> unit
    member IntersectsWith : rect:Rectangle -> bool
    member IsEmpty : bool
    ...
  end

Full name: System.Drawing.Rectangle

--------------------
Rectangle()
Rectangle(location: Point, size: Size) : unit
Rectangle(x: int, y: int, width: int, height: int) : unit
val target : Rectangle ref

Full name: Script.target
val bgcol : Brush ref

Full name: Script.bgcol
type Brushes =
  static member AliceBlue : Brush
  static member AntiqueWhite : Brush
  static member Aqua : Brush
  static member Aquamarine : Brush
  static member Azure : Brush
  static member Beige : Brush
  static member Bisque : Brush
  static member Black : Brush
  static member BlanchedAlmond : Brush
  static member Blue : Brush
  ...

Full name: System.Drawing.Brushes
property Brushes.Red: Brush
val off : Point ref

Full name: Script.off
Multiple items
type Point =
  struct
    new : sz:Size -> Point + 2 overloads
    member Equals : obj:obj -> bool
    member GetHashCode : unit -> int
    member IsEmpty : bool
    member Offset : p:Point -> unit + 1 overload
    member ToString : unit -> string
    member X : int with get, set
    member Y : int with get, set
    static val Empty : Point
    static member Add : pt:Point * sz:Size -> Point
    ...
  end

Full name: System.Drawing.Point

--------------------
Point()
Point(sz: Size) : unit
Point(dw: int) : unit
Point(x: int, y: int) : unit
event Control.Paint: IEvent<PaintEventHandler,PaintEventArgs>
val e : PaintEventArgs
val g : Graphics
property PaintEventArgs.Graphics: Graphics
Graphics.DrawRectangle(pen: Pen, rect: Rectangle) : unit
Graphics.DrawRectangle(pen: Pen, x: int, y: int, width: int, height: int) : unit
Graphics.DrawRectangle(pen: Pen, x: float32, y: float32, width: float32, height: float32) : unit
type Pens =
  static member AliceBlue : Pen
  static member AntiqueWhite : Pen
  static member Aqua : Pen
  static member Aquamarine : Pen
  static member Azure : Pen
  static member Beige : Pen
  static member Bisque : Pen
  static member Black : Pen
  static member BlanchedAlmond : Pen
  static member Blue : Pen
  ...

Full name: System.Drawing.Pens
property Pens.Gray: Pen
Graphics.FillRectangle(brush: Brush, rect: Rectangle) : unit
Graphics.FillRectangle(brush: Brush, rect: RectangleF) : unit
Graphics.FillRectangle(brush: Brush, x: int, y: int, width: int, height: int) : unit
Graphics.FillRectangle(brush: Brush, x: float32, y: float32, width: float32, height: float32) : unit
property Pens.Black: Pen
val md : IEvent<MouseEventArgs>

Full name: Script.md
event Control.MouseDown: IEvent<MouseEventHandler,MouseEventArgs>
val mm : IEvent<MouseEventArgs>

Full name: Script.mm
event Control.MouseMove: IEvent<MouseEventHandler,MouseEventArgs>
val mu : IEvent<MouseEventArgs>

Full name: Script.mu
event Control.MouseUp: IEvent<MouseEventHandler,MouseEventArgs>
val uc : col:Brush -> unit

Full name: Script.uc
val col : Brush
Control.Invalidate() : unit
Control.Invalidate(rc: Rectangle) : unit
Control.Invalidate(invalidateChildren: bool) : unit
Control.Invalidate(region: Region) : unit
Control.Invalidate(rc: Rectangle, invalidateChildren: bool) : unit
Control.Invalidate(region: Region, invalidateChildren: bool) : unit
val dc : col:Brush -> bool

Full name: Script.dc
val inR : p:Point -> bool

Full name: Script.inR
val p : Point
val placeR : p:Point -> unit

Full name: Script.placeR
val r : Rectangle
property Point.X: int
property Point.Y: int
property Rectangle.Width: int
property Rectangle.Height: int
val inT : unit -> bool

Full name: Script.inT
val highlight : Expr<MouseEventArgs>

Full name: Script.highlight
val e : MouseEventArgs
property Brushes.Yellow: Brush
property MouseEventArgs.Location: Point
val not : value:bool -> bool

Full name: Microsoft.FSharp.Core.Operators.not
val drag : Expr<MouseEventArgs>

Full name: Script.drag
property MouseEventArgs.X: int
property Rectangle.Left: int
property MouseEventArgs.Y: int
property Rectangle.Top: int
val orch : Orchestrator<MouseEventArgs>

Full name: Script.orch
val create : unit -> Orchestrator<'a>

Full name: EvReact.Orchestrator.create
val start : 'a -> Orchestrator<'a> -> Expr<'a> -> System.IDisposable

Full name: EvReact.Expr.start
Control.Show() : unit
Form.Show(owner: IWin32Window) : unit
Raw view Test code New version

More information

Link:http://fssnip.net/rz
Posted:8 years ago
Author:Antonio Cisternino
Tags: evreact , event processing