4 people like it.

Still Mouse Click Event

Detects a mouse down then up event without a move.

 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: 
open System
open System.Windows
open System.Windows.Controls
open System.Windows.Input
open System.Windows.Media

[<AutoOpen>]
module Mouse =
    let clickedOn (control:UIElement) =
        let down = control.MouseLeftButtonDown |> Event.map (fun e -> box e, 1)
        let up = control.MouseLeftButtonUp |> Event.map (fun e -> box e, -1)
        let mouseButton = Event.merge up down
        let mouseMove = control.MouseMove |> Event.map (fun e -> box e, 0)  
        let mouseEvents = Event.merge mouseButton mouseMove     
        let clicked = Event<_>()   
        let rec loop last = async {
            let! e, n = Async.AwaitEvent mouseEvents
            if n = -1 && last = 1 then          
                e :?> MouseButtonEventArgs |> clicked.Trigger  
            return! loop n
        }
        loop 0 |> Async.StartImmediate
        clicked.Publish
    
type AppControl() as control =
  inherit UserControl(Width = 320.0, Height = 200.0)
  
  let canvas = Canvas(Background = SolidColorBrush Colors.Orange)
  let block = TextBlock(Text="Hit Me", FontSize = 20.0)

  let mutable clicks = 0
  let clicked = Mouse.clickedOn control
  do  clicked.Add (fun _ -> 
          clicks <- clicks + 1
          block.Text <- "Still Clicks " + clicks.ToString()
      )
    
  do canvas.Children.Add(block)   
     base.Content <- canvas

#if INTERACTIVE
open Microsoft.TryFSharp
App.Dispatch (fun() -> 
    App.Console.ClearCanvas()
    AppControl() |> App.Console.Canvas.Children.Add
    App.Console.CanvasPosition <- CanvasPosition.Right
)
#endif
namespace System
namespace System.Windows
namespace System.Media
Multiple items
type AutoOpenAttribute =
  inherit Attribute
  new : unit -> AutoOpenAttribute
  new : path:string -> AutoOpenAttribute
  member Path : string

Full name: Microsoft.FSharp.Core.AutoOpenAttribute

--------------------
new : unit -> AutoOpenAttribute
new : path:string -> AutoOpenAttribute
val clickedOn : control:'a -> IEvent<'b>

Full name: Script.Mouse.clickedOn
val control : 'a
val down : IEvent<obj * int>
Multiple items
module Event

from Microsoft.FSharp.Control

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

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

--------------------
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<_,_>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
val map : mapping:('T -> 'U) -> sourceEvent:IEvent<'Del,'T> -> IEvent<'U> (requires delegate and 'Del :> Delegate)

Full name: Microsoft.FSharp.Control.Event.map
val e : obj
val box : value:'T -> obj

Full name: Microsoft.FSharp.Core.Operators.box
val up : IEvent<obj * int>
val e : 'a
val mouseButton : IEvent<obj * int>
val merge : event1:IEvent<'Del1,'T> -> event2:IEvent<'Del2,'T> -> IEvent<'T> (requires delegate and 'Del1 :> Delegate and delegate and 'Del2 :> Delegate)

Full name: Microsoft.FSharp.Control.Event.merge
val mouseMove : IEvent<obj * int>
val mouseEvents : IEvent<obj * int>
val clicked : Event<'a>
val loop : (int -> Async<'a>)
val last : int
val async : AsyncBuilder

Full name: Microsoft.FSharp.Core.ExtraTopLevelOperators.async
val n : int
Multiple items
type Async
static member AsBeginEnd : computation:('Arg -> Async<'T>) -> ('Arg * AsyncCallback * obj -> IAsyncResult) * (IAsyncResult -> 'T) * (IAsyncResult -> unit)
static member AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
static member AwaitIAsyncResult : iar:IAsyncResult * ?millisecondsTimeout:int -> Async<bool>
static member AwaitTask : task:Task<'T> -> Async<'T>
static member AwaitWaitHandle : waitHandle:WaitHandle * ?millisecondsTimeout:int -> Async<bool>
static member CancelDefaultToken : unit -> unit
static member Catch : computation:Async<'T> -> Async<Choice<'T,exn>>
static member FromBeginEnd : beginAction:(AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg:'Arg1 * beginAction:('Arg1 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * beginAction:('Arg1 * 'Arg2 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromBeginEnd : arg1:'Arg1 * arg2:'Arg2 * arg3:'Arg3 * beginAction:('Arg1 * 'Arg2 * 'Arg3 * AsyncCallback * obj -> IAsyncResult) * endAction:(IAsyncResult -> 'T) * ?cancelAction:(unit -> unit) -> Async<'T>
static member FromContinuations : callback:(('T -> unit) * (exn -> unit) * (OperationCanceledException -> unit) -> unit) -> Async<'T>
static member Ignore : computation:Async<'T> -> Async<unit>
static member OnCancel : interruption:(unit -> unit) -> Async<IDisposable>
static member Parallel : computations:seq<Async<'T>> -> Async<'T []>
static member RunSynchronously : computation:Async<'T> * ?timeout:int * ?cancellationToken:CancellationToken -> 'T
static member Sleep : millisecondsDueTime:int -> Async<unit>
static member Start : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions * ?cancellationToken:CancellationToken -> Task<'T>
static member StartChild : computation:Async<'T> * ?millisecondsTimeout:int -> Async<Async<'T>>
static member StartChildAsTask : computation:Async<'T> * ?taskCreationOptions:TaskCreationOptions -> Async<Task<'T>>
static member StartImmediate : computation:Async<unit> * ?cancellationToken:CancellationToken -> unit
static member StartWithContinuations : computation:Async<'T> * continuation:('T -> unit) * exceptionContinuation:(exn -> unit) * cancellationContinuation:(OperationCanceledException -> unit) * ?cancellationToken:CancellationToken -> unit
static member SwitchToContext : syncContext:SynchronizationContext -> Async<unit>
static member SwitchToNewThread : unit -> Async<unit>
static member SwitchToThreadPool : unit -> Async<unit>
static member TryCancelled : computation:Async<'T> * compensation:(OperationCanceledException -> unit) -> Async<'T>
static member CancellationToken : Async<CancellationToken>
static member DefaultCancellationToken : CancellationToken

Full name: Microsoft.FSharp.Control.Async

--------------------
type Async<'T>

Full name: Microsoft.FSharp.Control.Async<_>
static member Async.AwaitEvent : event:IEvent<'Del,'T> * ?cancelAction:(unit -> unit) -> Async<'T> (requires delegate and 'Del :> Delegate)
member Event.Trigger : arg:'T -> unit
static member Async.StartImmediate : computation:Async<unit> * ?cancellationToken:Threading.CancellationToken -> unit
property Event.Publish: IEvent<'a>
Multiple items
type AppControl =
  inherit obj
  new : unit -> AppControl

Full name: Script.AppControl

--------------------
new : unit -> AppControl
val control : AppControl
namespace System.Text
module Mouse

from Script
Next Version Raw view Test code New version

More information

Link:http://fssnip.net/5Z
Posted:12 years ago
Author:Phillip Trelford
Tags: silverlight , async , events