Subject Re: Programmatically Adding An Event
From Mervyn Bick <invalid@invalid.invald>
Date Thu, 6 Dec 2018 16:09:12 +0200
Newsgroups dbase.getting-started
Attachment(s) WhileMouseDownButton.cc

On 2018-12-06 3:56 PM, rich@autotraker.com wrote:
> We have "rotational power shedding" but it’s a little different. Its
> called "storms" here.
> If not for UPSs on everything and a backup generator I'd be spending
> more quality time away from the computer.
> I recall WhileMouseDown but don't seem to have a copy although I used
> the same basic principal in a few controls.
> Wasn't it called WhileDownVCR or something like that?  I believe it used
> PeekMessage() instead of GetAsyncKeyState() and navigated the rowset?
> If anyone has a copy, send me a copy please....
> Rich...

Done. :-)

Mervyn.



/*

        Filename:   WhileMouseDownButton.cc
   Version:    1.00
   Date:       2000 07 14

   For:        VdBase 7.x / Win9x

   Author:     Ronnie MacGregor
   Contact:    ronnie@high-lugtonridgeKILLSPAM.co.uk
        
  
   Revisions:
   **********
      None.
        
   Description:
   ************
      A custom PushButton which provides whileLeftMouseDown capability.


   Methods:
   ********
   CheckMouse(hWND)

      Used to establish if the left mouse button is still down, as in
      the following general example:

.     function PUSHBUTTON1_onLeftMouseDown(flags, col, row)
      
      // onLeftMouseDown code goes here
        
      // Initial pause
      sleep 0.1

      do while true
         if not this.Checkmouse(this.hwnd)
            
            // whileLeftMouseDown code goes here
            
            // repaint() goes here if required
            
            // Control loop speed
            sleep 0.1

         else
                                
            // onLeftMouseUp code can go here if desired
            
            exit
            
         endif

      enddo

      return


   Repaint()

           This is a copy of the repaint() function from the dUFLP, which
      is often needed to force an update of the screen while
      processing in a loop.


   Dependancies:
   *************
      None.


   Acknowledgements:
   *****************
      Thanks to Romain Strieff for the method, which has simply been
      turned into a custom control.
        
*/


class WhileMouseDownButton(parentObj) of PUSHBUTTON(parentObj) custom

   #ifndef    PM_NOYIELD
     #define PM_NOYIELD 2
   #endif
   #ifndef    WM_LBUTTONDOWN
     #define WM_LBUTTONDOWN 513
   #endif
   #ifndef    WM_LBUTTONUP
     #define WM_LBUTTONUP 514
   #endif


   if type("PeekMessage");
     # "FP"
     extern cLogical ;
        PeekMessage(;
           CSTRING,;
           CHANDLE,;
           CLONG,;
           CLONG,;
           CLONG;
           );
        User32;
     From "PeekMessageA"
   endif


   function CheckMouse(hWND)
   local cMsg
   cMsg = Space(14)//Buffer
     return PeekMessage(cMsg,;
     hWND,;          
     WM_LBUTTONDOWN,;
     WM_LBUTTONUP,;  
     PM_NOYIELD)      
    

   function Repaint()
      // from the dUFLP
      parameter oForm
      if type( "oForm" ) == "U" or empty( oForm )
         oForm = form
      endif
      //
      if type( "UpdateWindow" ) # "FP"
         extern CLOGICAL UpdateWindow( CHANDLE ) USER32
      endif
      return UpdateWindow( oForm.hWnd )


endclass