PtInRect در کنترل Edit مربوط به پنجره InputBox

کار سختی نیست از منبعی که در  انتهای صفحه آمده استفاده شده که تابع ویندوزی است 

Declare PtrSafe Function PtInRect Lib "user32" (lpRect As RECT, pt As POINTAPI) As Long'

Use Belows Only

Declare PtrSafe Function PtInRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

 _  ,  Public Function EditSubclass(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr

                            ByVal lParam As LongPtr, ByVal Uid As LongPtr, ByVal dwData As LongPtr) As Long

Static r As RECT

در پیام Paint  

      DefSubclassProc hwnd, Msg, wParam, ByVal lParam

      

       GetWindowRect hwnd, r

       OffsetRect r, -r.left, -r.top

       r.left = r.right - 20

       r.right = r.right

       r.bottom = r.bottom - 0.9

       r.top = r.top + 0.9

wm-lbuttondown'

 Case WM_LBUTTONDOWN

      Dim p As POINTAPI

       Dim  nn As RECT

(p.x = CLng(lParam And 65535)  'LoWord(lParam

        (p.y = CLng(lParam \ 65535)  'HiWord(lParam

        GetClientRect hwnd, nn

        

        nn.left = r.left - 2

        nn.right = r.right + 2 

If  PtInRect(nn, p.x, p.y) Then 

    "  ... MsgBox "You Clicked Me

      End If

  .....RedrawWindow 

مورد بالا تست شده 

---

در 32 بیت 

Declare Function PtInRect Lib "user32.dll" (lpRect As RECT, ByVal x As Long, ByVal y As Long) As Long

Example

مثال زیر چک میکند کرسر ماوس داخل یا خارج از پنجره ی فرم یک است 

 Determine if the mouse cursor is inside or outside 

of  window Form1

که اینکار بوسیله ی چک کردن موقعیت کرسر ماوس به واحد Point در صفحه با مستطیل پنجره انجام شده.

This is done by checking the point of the mouse

.cursor with the rectangle of the window

دریافت مختصات ماوس در صفحه

Dim mousept As POINT_TYPE ' receives mouse 

coordinate

دریافت مستطیل فرم یک 

Dim winrect As RECT ' receives rectangle of Form1

دریافت عدد یک اگر داخل مستطیل باشد و صفر اگر در آن نباشد

Dim isinside As Long ' receives 1 if inside or 0 if outside

Dim retval As Long ' return value for other functions

تعیین موقعیت کرسر ماوس

retval = GetCursorPos(mousept) ' determine the  mouse cursor's position

گرفتن مختصات بالایی سمت چپ و مختصات پایینی سمت راست مستطیل فرم یک اگر کلاین رکت استفاده شود left و topرا صفرمی دهد.

retval = GetWindowRect(Form1.hWnd, winrect) ' determine Form1's rectangle

چک می کند تا ببینیم آیا کرسر ماوس داخل مستطیل فرم یک قرار دارد.

 Check to see if the mouse cursor is located inside'

of the Form1 rectangle

(isinside = (winrect, mousept.x, mousept.y

اگر کرسر ماوس داخل آن مستطیل باشد در پنجره ی دیباک یا  Ctrl+G چاپ میکند که کرسر ماوس در حال حاضر داخل فرم ۱ است و اگر داخل آن مختصات نباشد چاپ میکند کرسر ماوس هم اکنون بیرون از فرم یک است 

If isinside = 1 Then

Debug.Print "The mouse cursor is currently inside 

".of  Form1

Else

Debug.Print "The mouse cursor is currently outside of 

".Form1

End If

---

در کل PtInRect  چک میکند Point در داخل Rectangle هست یاخیر اگر باشد جوابش عدد غیر صفر است طبق داکیونت --->> ptinrect

منبع 

ptinrect

محصور کردن کرسر به منطقه مستطیل شکل در صفحه

ClipCurSor 

.Confines the cursor to a rectangular area on the screen

Parameters

lpRect

Type: const RECT*

A pointer to the structure that contains the screen coordinates of the upper-left and lower-right corners of the confining rectangle. If this parameter is NULL, 

.the cursor is free to move anywhere on the screen

rectangle

setrect

createpen

clienttoscreen

ptinrect

stretchblt

Dim ptClientUL As POINTAPI  'client area upper lef corner 

Dim ptClientLR As POINTAPI 'client area lower right corner 

Static rcBmp As RECT 

WM_CREATE

(hdc=GetDC(hwnd

(hdcCompat=CreateCompatibleDC(hdc

SelectObject hdcCompat, hbmp

((hpenDot=CreatePen(PS_DOT,1,RGB(0, 0, 0

SetRect rcBmp, 1, 1, 34, 34

WM_PAINT

BeginPaint hwnd,ps

Rectangle ps.hdc,rcBmp.left,rcBmp.top,rcBmp.right, rcBmp.bottom

StretchBlt ps.hdc,rcBmp.left+1,rcBmp.top+1,(rcBmp.right-rcBmp.left)-2,(rcBmp.bottom-rcBmp.top)-2, hdcCompat,0,0,32,32,SRCCOPY

EndPaint hwnd,ps

WM_MOVE,WM_SIZE

'Convert the client coordinates of the client-area rectangle to screen coordinates and save them in a rectangle.The rectangle is passed to the ClipCursor function during WM_LBUTTONDOWN processing. 

GetClientRect hwnd,rcClient

ptClientUL.x = rcClient.left

ptClientUL.y = rcClient.top

ptClientLR.x = rcClient.right

ptClientLR.y = rcClient.bottom ClientToScreen hwnd,ptClientUL ClientToScreen hwnd,ptClientLR

SetRect rcClient,ptClientUL.x, ptClientUL.y,ptClientLR.x,ptClientLR.y)

WM_LBUTTONDOWN

ClipCursor rcClient

pt.x = (LONG) LOWORD(lParam) 

pt.y = (LONG) HIWORD(lParam)

if (PtInRect(&rcBmp, pt)) Then 

hdc=GetDC(hwnd)

SelectObject hdc,hpenDot

Rectangle hdc,rcBmp.left,rcBmp.top, rcBmp.right,rcBmp.bottom)

fDragRect=TRUE

ReleaseDC hwnd,hdc

WM_LBUTTONUP

' Release the mouse cursor.

ClipCursor  0

NCCALCSIZE TO MAKE A SPACE

WVR_ALIGNBOTTOM = 64

WVR_ALIGNLEFT = 32

WVR_ALIGNRIGHT = 128

WVR_ALIGNTOP = 16

WVR_HREDRAW = 256

WVR_REDRAW = WVR_HREDRAW + WVR_VREDRAW

WVR_VALIDRECTS = 1024

WVR_VREDRAW = 512

Type RECT

left As Long

right As Long

top As Long

bottom As Long

End Typd

Type NCCALCSIZE_PARAMS

rgrc(3) As RECT

lppos As WINDOWPOS

End Type 

Type WINDOWPOS

x As Long

y As Long

cx As Long    ' width

cy As Long    ' heigth

End Type

Dim tNCR As NCCALCSIZE_PARAMS 

Dim tWP As WINDOWPOS

If wParam <> 0 Then

 lParam containts a pointer to the'

 NCCALCSIZE_PARAMS structure: 

(CopyMemory tNCR,ByVal lParam, Len(tNCR

 the NCCALCSIZE_PARAMS structure contains'

 a pointer to the WINDOWPOS structure: 

(CopyMemory tWP,ByVal tNCR.lppos, Len(tWP

 Set the first rectangle to the WINDOWPOS ' size'

(With tNCR.rgrc(0

Left=tWP.x.

Top=tWP.y.

Right=tWP.x+tWP.cx.

Bottom = tWP.y + tWP.cy.

End With

Now modify the rectangle if we're showing tabs'

 to allow space for the tab strip itself'

If (m_bShowTabs) Then 

tNCR.rgrc(0).Left=tNCR.rgrc(0).Left+2

tNCR.rgrc(0).Right=tNCR.rgrc(0).Right-2

If (m_eTabAlign=TabAlignBottom) Then

tNCR.rgrc(0).Top=tNCR.rgrc(0).Top+2

tNCR.rgrc(0).Bottom=tNCR.rgrc(0).Bottom-m_lTabHeight

Else

tNCR.rgrc(0).Top=tNCR.rgrc(0).Top+m_lTabHeight

tNCR.rgrc(0).Bottom=tNCR.rgrc(0).Bottom-2 

End If 

End If

 Set the second rectangle to equal the first'

(tNCR.rgrc(1)=tNCR.rgrc(0

CopyMemory ByVal lParam,tNCR, Len(tNCR) ' Tell 

 :Windows we've modified the size'

ISubclass_WindowProc=WVR_VALIDRECTS

Once this is done, there will be a space for the tabs

Case WM_NCPAINT 

 Ensure the standard mon-client drawing is' 

:completed

(ISubclass_WindowProc=CallOldWindowProc(hWnd,iMsg,wParam,lParam

 Do custom drawing: first get a DC to the non-client' 

:area

Dim lhDC As Long 

(lhDC=GetWindowDC(hWnd

'.... Now can draw in the area we've cleared'

  Clear up DC '

ReleaseDC lHDC, hWnd

Check the actual source code for the details of drawing the tabs. The code uses an EnumWindowsProc callback function to determine all of the windows within the MDIClient area, and the WM_MDIGETACTIVEmessage to determine which 

.(window is the currently selected MDI child (if any

Finally, we need to intercept the user clicking on a tab or button within the tab control. There are two messages Windows sends to the non-client area to allow you to 

:check for mouse events

WM_NCHITTEST

This message allows you to tell Windows that a non-client area should be treated in a particular way, such as title bar or size gripper.

WM_SETCURSOR

This message is used by Windows to determine which cursor to display, however, since it provides the type of mouse action being performed you can use it to determine mouse movement and button presses in the 

.area

lParam LoWord/HiWord

 Dim pt As POINTAPI

    Dim rrr As RECT

           

   

          (pt.x = CLng(lParam And 65535

         ( pt.y = CLng(lParam / 65535

          

           ClientToScreen hwnd, pt

           GetWindowRect hwnd, rrr