Selection Rectangle in VBA

How can I draw a selection rectangle on a spesific window ?
Like clicking the left mouse button and drawing a rectangle while keeping it pressed.

I tried the following code on desktop (in order to see if it is working)
It drew a dotted rectangle around the icons that are inside the rectangle, but didn't select (delete) them.

What am I doing wrong ?

PS. I'm using VBA.


Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Declare Function DrawFocusRect Lib "user32" (ByVal hdc As Long, lpRect As RECT) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" (ByVal hwnd As Long, ByVal hdc As Long) As Long

Sub SelectOnScreen()

    Dim I As Integer
    Dim rctPosition As RECT
    Dim hdc As Long
 
    With rctPosition
        .Left = 5
        .Top = 4
        .Right = 80
        .Bottom = 135
    End With

    'get the desktop hDc
    hdc = GetDC(ByVal 0)

    Call DrawFocusRect(hdc, rctPosition)
    Call ReleaseDC(0, hdc)
    
    For I = 1 To 2000
    DoEvents
    Next
    
    SendKeys ("{DEL}")

End Sub

Open in new window

Crawler77Asked:
Who is Participating?
 
Crawler77Connect With a Mentor Author Commented:
Thanks atom, I solved it by myself.
It's just a matter of timing and giving some lag.
If the mouse movements are made very fast, no selection box is drawn and nothing is selected.
But if you simulate the real move pixel by pixel it works !
So we were both right at the beginning, but just skipped the pixel by pixel movement.
Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
                ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)
                

Sub AutomateABYY()
    
    Dim I As Integer
    Dim J As Integer
    
    Dim startPos As POINTAPI
    GetCursorPos startPos
    
    'Clicking the capture button at 843, 103
    SetCursorPos 843, 103
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    
    'Giving some time for initialize
    For J = 1 To 500
        DoEvents
    Next
    
    'Placing the cursor at the top left of the rectangle
    SetCursorPos 230, 350
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
    
    'Moving pixel by pixel to right
    For I = 1 To 153
        SetCursorPos 230 + I, 350
    Next
    
    'Moving pixel by pixel to down
    For I = 1 To 23
        SetCursorPos 383, 350 + I
    Next
    
    'Release the mouse button to finish selection
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
    
End Sub

Open in new window

0
 
John EarnshawCommented:
What exactly are you trying to accomplish here? It seems like you are trying to programatically remove files/shortcuts and if so why not use system.io?
0
 
atomsheepConnect With a Mentor Commented:
Sounds like you are trying to simulate a click-and-drag-a-rectangle function. In which case, drawing a rectangle in code won't do it - your code literally only draws a rectangle, not a selection rectangle. If you are wanting to do what I think you want to do, you need to programmatically control the mouse. This website (http://social.msdn.microsoft.com/forums/en-US/vbgeneral/thread/e79d4501-b3d9-4e37-9b70-966105e09ab1) has a good summary. You basically want to set the cursor position, send a MOUSEEVENTF_LEFTDOWN, set the new cursor position (at the other corner of the rectangle), and send a MOUSEEVENTF_LEFTUP.
0
Keep up with what's happening at Experts Exchange!

Sign up to receive Decoded, a new monthly digest with product updates, feature release info, continuing education opportunities, and more.

 
John EarnshawCommented:
still if you are wanting to move/delete files why not just use the system shell file.move() etc...
0
 
atomsheepCommented:
Yes you're right, it all depends on what exactly the asker wants to do. If they want to perform file operations then going straight to those functions would be the best way. But if they want to draw a selection rectangle (for some other reason) in some window, then the mouse_event API call would be used.
0
 
Crawler77Author Commented:
No. I'm trying to use ABYY Fine Reader's Screen Shot Reader (a screen OCR program) automatically.

I couldn't find any API to use it directly from VBA and I don't have their SDK kit so I plan to use it indirectly by controlling the mouse through VBA.

To use ABYY Fine Reader's Screen Reader application, you first click on capture button, which I can easily accomplish with mouse_event function from vba, then select the area you wish to capture.
That's the point where I'm stuck. I couldn't simulate the rectangular selection event.

The desktop thing is just a simple example to see if the code is working.

After the selection it saves the text to clipboard so it won't be much trouble for me to get it.
0
 
atomsheepCommented:
Try something like:

SetCursorPos(5,4)
mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0)
SetCursorPos(80,135)
mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0)

You'll need to declare both SetCursorPos and mouse_event.
0
 
Crawler77Author Commented:
Atomsheep;
You are right. As I explained above "simulating a click-and-drag-a-rectangle function" is what I'm trying to do. I'm not very unfamiliar with mouse_event functions so what you explained was the first thing I tried.
(As seen by the following code) But unfortunatelly by some reason it doesn't work.
Option Explicit

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4

Private Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, _
                ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Sub TestSelect()
    
    Dim I As Integer
    
    Dim startPos As POINTAPI
    GetCursorPos startPos
    
    SetCursorPos 2, 9
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0

    SetCursorPos 71, 136
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0

    For I = 1 To 2000
        DoEvents
    Next

    SendKeys ("{DEL}")
    
End Sub

Open in new window

0
 
atomsheepCommented:
Hmm, interesting. A convoluted way to send mouse clicks is to use SendMessage to the hWnd of the target window (http://social.msdn.microsoft.com/Forums/en/vbgeneral/thread/fa167c14-280a-4075-9680-4165ade308d1). Perhaps this would work better if the scanning software isn't accepting the mouse_event?
0
 
Crawler77Author Commented:
atomsheep;

Thanks for your interest but the scanning software has nothing to do with the above code. The code just tries to delete 2 icons from the desktop to check whether the selection method is working. And thread you have given has no solution in the end.
0
 
atomsheepCommented:
Sorry, I should have been a bit clearer. May I suggest you try the SendMessage API function to send the mouse click events, instead of mouse_event. That is what that thread was suggesting. You'll need to obtain the handle for the window you're sending to but I get the feeling this will be very easy for you.
0
 
Crawler77Author Commented:
Thanks for the comment. Well I may look like an advanced coder but unfortunately I am not. I just try to put together the pieces of codes I obtain from the net and I'm fairly new at API calls.

For the SendMessage API function, if you meant "Chao Kuo"'s post at the end, he stated that "But for dragging, I haven’t found a way to do so." As what I try to do is rather pressing left button and dragging, this will not also work.

And for the code, it rather looks like something else than VBA cuz formatting didn't make any sense for me. C maybe ?
0
 
atomsheepCommented:
Nice one, glad you got it figured out.
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.