Solved

Mouse down time.

Posted on 2004-10-29
205 Views
Last Modified: 2010-04-05
Hey,

I need to detect how long the left mouse button is being held down for. ms or better would be nice.
Also this needs to be global not just in my application.

Thanks.
0
Question by:-Karamja-
    12 Comments
     
    LVL 5

    Expert Comment

    by:Hypoviax
    Try this sort of code:

    But at the position where the mouse is down start a timer (1 interval) adding  to a global integer 1 every ms (count:=count+1). And then when the mouse up  event occurs stop the timer and read the global count variable:

    Code orinally from:
    http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20429442.html

    unit MouseButton;

    interface

    uses
     Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
     StdCtrls, AppEvnts;

    type
     TForm1 = class(TForm)
       Button_StartJour: TButton;
       Button_StopJour: TButton;
       ListBox1: TListBox;
       ApplicationEvents1: TApplicationEvents;
       procedure Button_StartJourClick(Sender: TObject);
       procedure Button_StopJourClick(Sender: TObject);
       procedure ApplicationEvents1Message(var Msg: tagMSG;
         var Handled: Boolean);
       procedure FormClose(Sender: TObject; var Action: TCloseAction);
     private
       { Private declarations }
     public
       { Public declarations }
     end;

    var
     Form1: TForm1;
     JHook: THandle;
     Track: Boolean;

    implementation

    {$R *.DFM}

    function JournalProc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
    var
    Char1: PChar;
    begin
    {this is the JournalRecordProc}
    Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
    {the CallNextHookEX is not really needed for journal hook since it it not
    really in a hook chain, but it's standard for a Hook}
    if Code < 0 then Exit;

    {you should cancel operation if you get HC_SYSMODALON}
    if Code = HC_SYSMODALON then Exit;
    if Code = HC_ACTION then
     begin
    {the EventStrut record has the Information about the mouse or keyboard
    event. You said you just wanted the mouse button events so I get the
    mouse down and mouse up event messages}
       if EventStrut.message = WM_LBUTTONUP then  // stop the timer here (timer1.enabled:=false) and read the count
       Form1.ListBox1.Items.Add('Left Mouse UP at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
       if EventStrut.message = WM_LBUTTONDOWN then
       Form1.ListBox1.Items.Add('Left Mouse Down at X pos '+IntToStr(EventStrut.paramL) //start timer here
                                +' and Y pos '+IntToStr(EventStrut.paramH));
       if EventStrut.message = WM_RBUTTONDOWN then
       Form1.ListBox1.Items.Add('Right Mouse Down at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
       if (EventStrut.message = WM_RBUTTONUP) then
       Form1.ListBox1.Items.Add('Right Mouse Up at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
     end;
    end;

    procedure TForm1.Button_StartJourClick(Sender: TObject);
    begin
    if Track then
     begin
     ShowMessage('Mouse is already being Journaled, can not restart');
     Exit;
     end;

    JHook := SetWindowsHookEx(WH_JOURNALRECORD , @JournalProc, 0, 0);
    {SetWindowsHookEx starts the Hook}
    if JHook > 0 then
     begin
     Track := True;
     end else
     ShowMessage('No Journal Hook availible');
    end;

    procedure TForm1.Button_StopJourClick(Sender: TObject);
    begin
    Track := False;
    UnhookWindowsHookEx(JHook);
    JHook := 0;
    end;

    procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
     var Handled: Boolean);
    begin
    {the journal hook is automaticly camceled if the Task manager
    (Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it
    when the WM_CANCELJOURNAL is sent to the parent window, Application}
    Handled := False;
    if (Msg.message = WM_CANCELJOURNAL) and Track then
     JHook := SetWindowsHookEx(WH_JOURNALRECORD , @JournalProc, 0, 0);
    end;

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    {make sure you UN hook it if the app closes}
    UnhookWindowsHookEx(JHook);
    end;

    end.

    Regards,

    Hypoviax


    0
     
    LVL 5

    Expert Comment

    by:Hypoviax
    This is more precisely what i mean:

    unit Unit1;

    interface

    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, ExtCtrls, StdCtrls;

    type
      TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        Timer1: TTimer;
        ListBox1: TListBox;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Timer1Timer(Sender: TObject);
        procedure FormClose(Sender: TObject; var Action: TCloseAction);
         procedure ApplicationEvents1Message(var Msg: tagMSG;
         var Handled: Boolean);
      private

      public
       count:integer;
      end;

    var
      Form1: TForm1;
          JHook: THandle;
     Track: Boolean;
    implementation

    {$R *.dfm}
    function JournalProc(Code, wParam: Integer; var EventStrut: TEVENTMSG): Integer; stdcall;
    var
    Char1: PChar;
    begin
    {this is the JournalRecordProc}
    Result := CallNextHookEx(JHook, Code, wParam, Longint(@EventStrut));
    {the CallNextHookEX is not really needed for journal hook since it it not
    really in a hook chain, but it's standard for a Hook}
    if Code < 0 then Exit;

    {you should cancel operation if you get HC_SYSMODALON}
    if Code = HC_SYSMODALON then Exit;
    if Code = HC_ACTION then
     begin
    {the EventStrut record has the Information about the mouse or keyboard
    event. You said you just wanted the mouse button events so I get the
    mouse down and mouse up event messages}
       if EventStrut.message = WM_LBUTTONUP then  // stop the timer here (timer1.enabled:=false) and read the count
       begin
       Form1.ListBox1.Items.Add('Left Mouse UP at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
                                form1.Timer1.Enabled:=true;
                                showmessage(inttostr(form1.count));
                                end  ;
       if EventStrut.message = WM_LBUTTONDOWN then
       begin
       Form1.ListBox1.Items.Add('Left Mouse Down at X pos '+IntToStr(EventStrut.paramL) //start timer here
                                +' and Y pos '+IntToStr(EventStrut.paramH));
                                form1.timer1.enabled:=true;
                                end;
       if EventStrut.message = WM_RBUTTONDOWN then
       Form1.ListBox1.Items.Add('Right Mouse Down at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
       if (EventStrut.message = WM_RBUTTONUP) then
       Form1.ListBox1.Items.Add('Right Mouse Up at X pos '+IntToStr(EventStrut.paramL)
                                +' and Y pos '+IntToStr(EventStrut.paramH));
     end;
    end;

    procedure TForm1.ApplicationEvents1Message(var Msg: tagMSG;
     var Handled: Boolean);
    begin
    {the journal hook is automaticly camceled if the Task manager
    (Ctrl-Alt-Del) or the Ctrl-Esc keys are pressed, you restart it
    when the WM_CANCELJOURNAL is sent to the parent window, Application}
    Handled := False;
    if (Msg.message = WM_CANCELJOURNAL) and Track then
     JHook := SetWindowsHookEx(WH_JOURNALRECORD , @JournalProc, 0, 0);
    end;

    procedure TForm1.Button1Click(Sender: TObject); //start
    begin
    if Track then
     begin
     ShowMessage('Mouse is already being Journaled, can not restart');
     Exit;
     end;

    JHook := SetWindowsHookEx(WH_JOURNALRECORD , @JournalProc, 0, 0);
    {SetWindowsHookEx starts the Hook}
    if JHook > 0 then
     begin
     Track := True;
     end else
     ShowMessage('No Journal Hook availible');
    end;

    procedure TForm1.Button2Click(Sender: TObject); //end
    begin
    Track := False;
    UnhookWindowsHookEx(JHook);
    JHook := 0;
    end;

    procedure TForm1.Timer1Timer(Sender: TObject);
    begin
    count:=count+1;
    end;

    procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
    begin
    {make sure you UN hook it if the app closes}
    UnhookWindowsHookEx(JHook);
    end;

    end.

    Hypoviax
    0
     
    LVL 11

    Expert Comment

    by:robert_marquardt
    A WM_LBUTTONDOWN and WM_LBUTTONUP message method and a call to GetMessageTime should be all what you need.
    0
     
    LVL 11

    Expert Comment

    by:robert_marquardt
    Opps, sorry missed the "global".
    0
     
    LVL 7

    Accepted Solution

    by:
    As the length of time the mouse would be down for is likly to be extremely short - why not use the hardware timer in MMsystem ?  it can measure down to a millionth of a second ;-) you would need to replace the form1.Timer1.Enabled lines with a varient of the below code -


    // this code captures the time a key is held down for

    var
      start,stop1,freq:int64;
      TotalTicks,NumASec: int64;
      Ticksfor1,Timefor1: real;

    procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    begin

      QueryPerformanceFrequency(freq); {Get counts/second}
      QueryPerformanceCounter(start); {Get string count}
    end;

    procedure TForm1.Edit1KeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    begin
      QueryPerformanceCounter(Stop1); {Get end of loop2 count}
     TotalTicks:= (stop1-start);
      Timefor1:= TotalTicks / freq;
      NumASec:= Trunc(1{second} / Timefor1);


      If freq>0 then
         showmessage('Button held down for := '+
         inttostr(TotalTicks)+
         #13+'      Ticks for 1 Call:= '+FloatToStrF(Ticksfor1,ffNumber, 6,3)+
         #13+'      Ticks per second:= '+inttostr(freq)+
         #13+'      Time in micro seconds (millionths) for 1 call:= '+FloatToStrF(1e6*Timefor1,ffNumber, 4,8)+
         #13+'      Therefore you can call this procedure '+floattostr(NumASec)+' times a second')
      else showmessage('No hardware timer available');
    end;


    David
    0
     
    LVL 17

    Expert Comment

    by:mokule
    Hi,
    Just a little add on.
    Timer resolution is 10ms on NT derivatives, or 55ms on other Wins, so QueryPerformanceCounter is much better.
    0
     
    LVL 7

    Expert Comment

    by:DavidBirch2dotCom
    (isnt that what I just said ??? + coded?)  anyway why the difference in timer resolutions ?
    0
     
    LVL 17

    Expert Comment

    by:mokule
    Exactly David :)
    I wanted only to express in numbers what are advantages of Your solution.

    Delphi timer is based on Windows system timer which has different resolution on different systems.
    0
     
    LVL 7

    Expert Comment

    by:DavidBirch2dotCom
    thanks for the points , but surely you meant to give some to Hypoviax as well ??? if so post in community support and they will split it for you

    David
    0
     
    LVL 2

    Author Comment

    by:-Karamja-
    0
     
    LVL 7

    Expert Comment

    by:DavidBirch2dotCom
    ok - thanks for the points!!! :)
    0
     
    LVL 5

    Expert Comment

    by:Hypoviax
    Thanks,

    Hypoviax
    0

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    IT, Stop Being Called Into Every Meeting

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
    In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
    With the advent of Windows 10, Microsoft is pushing a Get Windows 10 icon into the notification area (system tray) of qualifying computers. There are many reasons for wanting to remove this icon. This two-part Experts Exchange video Micro Tutorial s…
    This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

    913 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    15 Experts available now in Live!

    Get 1:1 Help Now