Mouse down time.

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.
LVL 2
-Karamja-Asked:
Who is Participating?

Improve company productivity with a Business Account.Sign Up

x
 
DavidBirch2dotComConnect With a Mentor Commented:
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
 
HypoviaxCommented:
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
 
HypoviaxCommented:
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
The 14th Annual Expert Award Winners

The results are in! Meet the top members of our 2017 Expert Awards. Congratulations to all who qualified!

 
robert_marquardtCommented:
A WM_LBUTTONDOWN and WM_LBUTTONUP message method and a call to GetMessageTime should be all what you need.
0
 
robert_marquardtCommented:
Opps, sorry missed the "global".
0
 
mokuleCommented:
Hi,
Just a little add on.
Timer resolution is 10ms on NT derivatives, or 55ms on other Wins, so QueryPerformanceCounter is much better.
0
 
DavidBirch2dotComCommented:
(isnt that what I just said ??? + coded?)  anyway why the difference in timer resolutions ?
0
 
mokuleCommented:
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
 
DavidBirch2dotComCommented:
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
 
-Karamja-Author Commented:
0
 
DavidBirch2dotComCommented:
ok - thanks for the points!!! :)
0
 
HypoviaxCommented:
Thanks,

Hypoviax
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.