PushButton

MOUSEMOVE / XPOS

WParwm : LBUTTON Or RBUTTON

lParam

Lo مختصات x کرسر را مشخص میکند . مختصات مرتبط با گوشه چپ بالایی از منطقه Client

The low-order word specifies the x-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area

ho مختصات y کرسر را مشخص میکند . مختصات  مرتبط با گوشه چپ بالایی منطقه Client

The high-order word specifies the y-coordinate of the cursor. The coordinate is relative to the upper-left corner of the client area

در کل مختصات x و y  گوشه چپ بالایی منطقه Client را مشخص می نماید. 

---

Case WM_MOUSEMOVE

         Dim rw As RECT

         Dim rc As RECT

         Dim pp As POINTAPI

         GetWindowRect BtnOk, rw

         pp.x = rw.left

         pp.y = rw.top

         ClientToScreen BtnOk, pp

         GetCursorPos pp

         If Not PtInRect(rw, pp) Then'

         ' MsgBox "rt'

         'End If'

         SetWindowTextA hwnd, pp.x & "," & pp.y & "...." & rw.left & "," & rw.top

---

اگر ازGetClientRect استفاده کنید مختصات left و Topرا صفر میدهد.

dim rw As RECT

GetWindowRect hwndBtnOk,rw

dim pp as POINTAPI

(pp.x = LoWord(lParam

        ( pp.y = HiWord(lParam

          MoveWindow hwndBtnOk, pp.x, pp.y, (rw.right - rw.left), (rw.bottom - rw.top), 1

The &H prefix denotes a number represented in hexadecimal (base 16) notation.

Hexadecimal digits, like decimal, start at 0, but go up to 

.(F (16

e.g. 0 1 2 3 4 5 6 7 8 9 A B C D E F, 10 11 12 13 14 15 16 17 18 19 1A 1B etc.

In C-based languages hexadecimal numbers are prefixed with 0x, eg. 0x10000. This is directly equal to 

H10000 in VB&

Hex To Decimal

NCCALCSIZE ( محاسبه ی اندازه در Non Client )

اولین  مستطیل یا Rectangle حاوی مختصات جدید پنجره که جابجا یا تغییر سایز شده است طبق داکیومنت زیر 

When the window procedure receives

 the WM_NCCALCSIZE message, the first rectangle contains the new coordinates of a window that has been moved or resized, that is, it is the proposed new window coordinates. The second contains the coordinates of the window before it was moved or resized. The third contains the coordinates of the window's client area before the window was moved or resized

افزایش عرض یا طول مستطیل ( Rectangle )

InflateRect lprc,dx,dy

یک مستطیل را به منطقه به روز رسانی پنجره مشخص اضافه می کند

InvalidateRect hWnd,lpRect,bErase

Also Read   offsetrect

WM_NCCALCSIZE'

(private WmNCCalcSize(ByRef m Ss Message 

Get Window Rect RECT'

Dim formRect As RECT

GetWindowRect m.HWnd,formRect

Check WPARAM'

 if m.WParam<>0 Then 

When TRUE, LPARAM Points to a'

NCCALCSIZE_PARAMS structure'

Dim nccsp As NCCALCSIZE_PARAMS

We're adjusting the size of the client area 'here. Right' 

now, the client area is the whole form

Adding to the Top, Bottom, Left, and Right will size the '

client area.

nccsp.rgrc0.top= formRect.top+30

 Thirty pixel top border'
nccsp.rgrc0.bottom=formRect.bottom-4
Four pixel bottom (resize) border'
nccsp.rgrc0.left=formRect.left+4
Four pixel left (resize) border'

Else 'FALSE
When FALSE,LPARAM Points to a RECT structure'
Dim clnRect As RECT
'Like before, we're adjusting the rectangle...
'Adding to the Top, Bottom, Left, and Right will size the client area. 

(CopyMemory clnRect,Byval lParam,Len(lParam
clnRect.top+=30
Thirty-pixel top border'
clnRect.bottom-=4
Four-pixel bottom (resize) border'
clnRect.left+=4
Four-pixel left (resize) border'
clnRect.right-=4
Four-pixel right (resize) border'
CopyMemory lParam,clnRect,Len

 Ret=0

()Private Sub InvalidateNC

 'refresh or invalidate don't work for the nonclient-area.
 'this sub forces a refresh for NC.    

SetWindowPos(Me.Handle,0,0,0,0,0,SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE Or
SWP_FRAMECHANGED)
End Sub 'invalidateNC

---

WM_NCCALCSIZE return flags
Global Const WVR_ALIGNTOP = &H0010
Global Const WVR_ALIGNLEFT = &H0020
Global Const WVR_ALIGNBOTTOM = &H0040
Global Const WVR_ALIGNRIGHT = &H0080
Global Const WVR_HREDRAW = &H0100
Global Const WVR_VREDRAW = &H0200
Global Const WVR_REDRAW = (WVR_HREDRAW Or WVR_VREDRAW)
Global Const WVR_VALIDRECTS = &H0400

WM_NCCALCSIZE parameter structure'
Type NCCALCSIZE_PARAMS
rgrc As Long
lppos As Long
End Type

Global Const MA_NOACTIVATEANDEAT = 4

Type WINDOWPOS
hwndInsertAfter As Long
hwnd As Long
x As Long
y As Long
cx As Long
cy As Long
flags As Long
End Type

Dim nccs  As NCCALCSIZE_PARAMS
Dim WndPos  As WINDOWPOS
MAGICNUMBER=23

Case WM_NCCALCSIZE


' Adjust the client area size calculation to allow for our tabstrip

 If (wParam <> 0) Then
'nccs->NCCALCSIZE Structure
(CopyMemory nccs,ByVal lParam,Len(nccs

(CopyMemory WndPos,ByVal nccs.lppos,Len(WndPos

  (With nccs.rgrc(0
     Left=nccsPos.x+2.
     Top=nccsPos.y+MAGICNUMBER.
     Right=(nccsPos.x+nccsPos.cX)-2.
     Bottom=nccsPos.y+nccsPos.cY)-2.
End With


(Set nccs.rgrc(1)=nccs.rgrc(0

(CopyMemory ByVal lParam,nccs,Len(nccs

 WndProc=WVR_VALIDRECTS

 
Else

WndProc =CallWindowProc(mlpfnOldWindowProc

(hWnd,uMsg,wParam,lParam,

End If

Case WM_NCPAINT

  GetWindowRect hWnd,WndRect

  GetDCEx(hWnd,wparan,DCX_WINDOW or'

DCX_INTERSECTRGN'

  ( lhDC = GetWindiwDC(hWnd

....  BitBlt
  ReleaseDC hWnd, lhDC

WndProc =CallWindowProc(mlpfnOldWindowProc

(hWnd,uMsg,wParam,lParam

I was about to reply that I had been trying GetWindowDC and GetDCEx also until it occured to me that of course the coordinates are different... it works now Thanks so much

---

You can respond to the WM_NCCALCSIZEmessage, modify WndProc's default behaviour to remove the invisible border.

As this document and this documentexplain, when wParam > 0, On request wParam.Rgrc[0] contains the new coordinates of the window and when the procedure returns, Response wParam.Rgrc[0] contains the coordinates of the new client rectangle.

:The golang code sample



params.Rgrc(0).Top=params.Rgrc(2).Top params.Rgrc(0).Left=params.Rgrc(0).Left + 1
params.Rgrc(0).Bottom=params.Rgrc(0).Bottom-1
params.Rgrc(0).Right=params.Rgrc(0).Right-1
return 0x0300

Case WM_NCLBUTTONDOWN
            'pt = PointToClient(New Point(m.LParam.ToInt32()))
            'pt.Offset(I.BorderWidthLeft, I.BorderWidthTop)
       

---

منبع خارجی 

    

HITTEST

Type MARGINS

cxLeftWidth As Long

cxRightWidth As Long

cyTopHeight As Long

cyBottomHeight As Long 

End Type

Extends the window frame into the client area'

DwmExtendFrameIntoClientArea(hWnd, ByRef 

(MARGINS 

-------------------------------------------------------------

if (m.Msg=&H83 And WParam=1) Then

Dim nccsp As NCCALCSIZE_PARAMS

nccsp.rect0.Top+=30;

nccsp.rect0.Bottom+= -8;

nccsp.rect0.Left+= 8;

nccsp.rect0.Right += -8;

Ret=0

( else if m.Msg=&H84 And (Ret=0

(Ret=HitTestNCA(HWnd,WParam, LParam

else

(base.WndProc(ref m

End if 

(private HitTestNCA(hwnd,wparam,lparam

HTNOWHERE=0;

int HTCLIENT=1;

int HTCAPTION=2;

int HTMINBUTTON=8;

int HTMAXBUTTON=9;

int HTLEFT=10;

int HTRIGHT=11;

int HTTOP=12;

int HTTOPLEFT=13;

int HTTOPRIGHT=14

int HTBOTTOM=15;

int HTBOTTOMLEFT=16;

int HTBOTTOMRIGHT=17; 

'Getting the point where the mouse clicked... 

Dim p As POINT

(p.x=LoWord(lparam

(p.y=HiWord(lparam

'The ClientToScreen function converts 'the client-area'

coordinates of a specified 'point to screen coordinates

ClientToScreen hwnd,pt'

'The PtInRect function determines 'whether the'

specified point lies within 'the specified rectangle. A point is within 'a rectangle if it lies on the left or top side 'or is within all four sides. A point on the 'right or bottom side is considered 'outside the rectangle

(Ret=PtInRect(rc,nccsp.rect0'

Rectangle hdc,left,top,right,bottom'

(topleft=Rectangle(hdc,0, 0, 8, 8

if (topleft.Contains(p)) Then

(return=IntPtr(HTTOPLEFT

(topright=Rectangle(hdc,Width-8,0,8,8

if (topright.Contains(p)) Then

(Ret=IntPtr(HTTOPRIGHT

(botleft=Rectangle(hdc,0,Height-8,8,8

if (botleft.Contains(p)) Then 

(Ret=IntPtr(HTBOTTOMLEFT

(botright=Rectangle(hdc,Width-8,Height-8,8, 8

if (botright.Contains(p)) Then

(Ret=IntPtr(HTBOTTOMRIGHT

(top=Rectangle(hdc,0,0,Width,8

if (top.Contains(p)) Then

(Ret=IntPtr(HTTOP

(cap=Rectangle(hdc,0,8,Width,38-8

if (cap.Contains(p)) Then

(Ret=IntPtr(HTCAPTION

(left=Rectangle(hdc,0,0,8,Height

if (left.Contains(p)) Then

(Ret=IntPtr(HTLEFT

(right=Rectangle(hdc,Width-8,0,8,Height

if (right.Contains(p)) Then

(Ret=IntPtr(HTRIGHT

(bottom=Rectangle(hdc,0,Height-8,Width, 8

if (bottom.Contains(p)) Then

(Ret=IntPtr(HTBOTTOM

WM_MOUSEACTIVATE

.wParam: Handle to the active top-level parent window

LOWORD (lParam): Hit test value where the mouse is clicked. If you clicked the work area, the HTCLIENT 

.value is passed

HIWORD (lParam): The ID of the mouse message that caused this message. Depending on the return value of this message, mouse messages are either queued 

.or discarded

 : MA_ACTIVATE
Activates the window and does not discard mouse messages

: MA_ACTIVATEANDEAT
.Activates the window and discards mouse messages
: MA_NOACTIVATE
Does not activate Windows and does not discard mouse messages

 : MA_NOACTIVATEANDEAT
It does not activate the window nor discard the mouse message

The following example prints the letter "C" at a specific location on the screen, which can be moved with the left mouse button. As soon as the button is pressed, the position of the character changes, but it does not process mouse messages when it is changed from inactive to active

(WndProc(hWnd,Msg,wParam,lParam

Dim hdc As Long

Dim ps As PAINTSTRUCT

Dim Ret As Long

static x, y

Select Case Msg

case WM_MOUSEACTIVATE

Ret=MA_ACTIVATEANDEAT

case WM_LBUTTONDOWN

(x=LOWORD (lParam

(y=HIWORD (lParam

InvalidateRect  hWnd,0,TRUE

Ret=0

case WM_PAINT

(hdc=BeginPaint(hWnd,ps

TextOut hdc,x,y,"C",1

EndPaint hWnd, & ps

Ret=0

case WM_DESTROY

PostQuitMessage 0

Ret=0

((Ret=DefWindowProc(hWnd,Msg,wParam, lParam

---

 Process messages'
Public Function NewWindowProc(ByVal hwnd As Long,ByVal msg  As Long,ByVal wParam As Long,ByVal 

(lParam As Long
As  Long
Const WM_NCDESTROY=&H82

If we're being destroyed'
 restore the original WindowProc'
If msg=WM_NCDESTROY Then
SetWindowLong hwnd,GWL_WNDPROC,  OldWindowProc
End If
 See if a control was clicked'
If msg=WM_MOUSEACTIVATE Then
Form1.MouseClicked
NewWindowProc=CallWindowProc(OldWindowProc,hwnd,msg,wParam,lParam) End Function


()Public Sub MouseClicked
Dim pt As POINTAPI

See where the mouse is'
GetCursorPos pt
Convert into client coordinates'
ScreenToClient hwnd,pt
Draw a big X on the form where the mouse is'
Cls
(Line (pt.X - 50, pt.Y - 50)-(pt.X + 50, pt.Y + 50

(Line (pt.X + 50, pt.Y - 50)-(pt.X - 50, pt.Y + 50

End Sub 

---

Type tagNCCALCSIZE_PARAMS
RECT] rgrc[]'
rgrc0 As RECT
rgrc1 As RECT
rgrc2 As RECT
lppos
End Type

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

WM_NCLBUTTONDOWN

 allow to drag & move userform via control  Label1)
      

Private Declare Function ReleaseCapture Lib "user32" () As Long
 
Private Const WM_NCLBUTTONDOWN = &HA1
Private Const HTCAPTION = 2

Dim hWndForm As Long

Private Sub UserForm_Initialize()
  hWndForm = FindWindow("ThunderDFrame", Me.Caption)
End Sub

Private Sub lb1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Button = xlPrimaryButton Then
    Call ReleaseCapture
    Call SendMessage(hWndForm, WM_NCLBUTTONDOWN, HTCAPTION, ByVal 0&)
  End If
End Sub

پیام ها

%MAX_TITLE_BUTTONS=8

%B_EDGE=2

 GLOBAL szPropName As String * 255? Or Byte

TYPE CaptionButton

uCmd AS LONG 'command to send when clicked

nRightBorder AS LONG 'Pixels between this button and buttons to the right

hBmp AS LONG 'Bitmap to display

fPressed AS LONG 'Private

END TYPE 

TYPE CustomCaption buttons(%MAX_TITLE_BUTTONS) AS CaptionButton

nNumButtons AS LONG

fMouseDown AS LONG

wpOldProc AS LONG

iActiveButton AS LONG

END TYPE

FUNCTION GetCustomCaption(hwnd) AS  Long

'CustomCaption

FUNCTION=GetProp(hwnd,szPropName) END FUNCTION

FUNCTION MakShort(BYVAL n AS LONG) AS LONG

IF n<=32768 THEN

MakeShort=n:EXIT FUNCTION

MakeShort=-1 *(65535-n) 

End Function

Sub RedrawNC(hwnd) As Long

SetWindowPos hwnd,0,0,0,0,0, SWP_NOMOVE OR SWP_NOSIZE OR SWP_NOZORDER OR SWP_NOACTIVATE OR SWP_DRAWFRAME) 

END SUB

FUNCTION CalcTopEdge(hwnd) AS LONG DIM dwStyle AS Long

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

IF(dwStyle AND  WS_THICKFRAME)

THEN 

FUNCTION=GetSystemMetrics(SM_CYSIZEFRAME)

ELSE

FUNCTION=GetSystemMetrics(SM_CYFIXEDFRAME)

END IF

END FUNCTION

FUNCTION CalcRightEdge(hwnd) AS LONG

DIM dwStyle AS Long

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

IF(dwStyle AND WS_THICKFRAME) THEN

FUNCTION=GetSystemMetrics(SM_CXSIZEFRAME)

ELSE

FUNCTION=GetSystemMetrics(SM_CXFIXEDFRAME)

END IF

END FUNCTION 

GetRightEdgeOffset(ctp * CustomCaption,hwnd) AS LONG

DIM dwStyle As Long

DIM dwExStyle AS Long

DIM nButSize AS LONG

DIM nSysButSize AS LONG

dwStyle=GetWindowLong(hwnd,GWL_STYLE)

dwExStyle=GetWindowLong(hwnd,GWL_EXSTYLE)

nButSize = 0 

nSysButSize=GetSystemMetrics(SM_CXSIZE)-B_EDGE

IF(dwStyle AND WS_SYSMENU) THEN nButSize=nButSize+nSysButSize+B_EDGE

END IF

IF (dwStyle AND (WS_MINIMIZEBOX OR WS_MAXIMIZEBOX) ) THEN

nButSize=nButSize+B_EDGE+nSysButSize * 2 

End if 

FUNCTION=nButSize+CalcRightEdge(hwnd)

GetButtonRect(ctp*CustomCaption, hwnd,idx,rct RECT,fWindowRelative AS LONG)

DIM i AS LONG,re_start AS LONG 

DIM cxBut AS LONG,cyBut AS LONG

DIM xLeft AS LONG,yTop AS LONG

cxBut=GetSystemMetrics(SM_CXSIZE) cyBut=GetSystemMetrics(SM_CYSIZE)

' right-edge starting point of inserted buttons

re_start=GetRightEdgeOffset(ctp,hwnd) 

GetWindowRect hwnd,rct

IF fWindowRelative=True THEN

OffsetRect rct,-1 * rct.Left, -1*rct.Top 

END IF

'Find the correct button - but take into 'account all other buttons. 

LOCAL nRightBorder AS LONG

FOR i = 0 To idx

re_start=re_start+nRightBorder+cxBut -B_EDGE

NEXT

rct.nLeft=rct.nRight-re_start

rct.nTop=rct.nTop+CalcTopEdge(hwnd)+ B_EDGE

rct.nRight=rct.nLeft+cxBut-B_EDGE

rct.nBottom=rct.nTop+cyBut-B_EDGE * 2 END SUB

FUNCTION Caption_NCHitTest(ctp AS CustomCaption PTR, hwnd,wParam, lParam) AS LONG

DIM rct AS RECT

DIM pt AS POINTAPI

DIM i AS LONG

DIM ret AS LONG

pt.x=LOWRD(lParam)

pt.y=HIWRD(lParam)

ret=CallWindowProc(ctp.wpOldProc,hwnd,WM_NCHITTEST,wParam,lParam)

'If the mouse is in the caption, then check to 'see if it is over one of our buttons 

IF (ret=HTCAPTION) THEN

FOR i=0 TO ctp.nNumButtons-1 

GetButtonRect ctp,hwnd,i,rct,FALSE

InflateRect rct,0,B_EDGE

'If the mouse is in any custom button, then 'We need to override the default behaviour.

IF PtInRect(rct,pt.x,pt.y) THEN

Caption_NcHitTest=HTBORDER

END IF

NEXT

END IF

Caption_NcHitTest=ret

END FUNCTION 

FUNCTION Caption_NCPaint(ctp AS CustomCaption,hwnd, hrgn) AS LONG 

DIM rct AS RECT,rct1 AS RECT

DIM fRegionOwner AS LONG

DIM i AS LONG

DIM hdc AS Long

DIM uButType AS LONG

DIM x AS LONG,y AS LONG

DIM hrgn1 AS Long

LOCAL nNumButtons AS LONG 

fRegionOwner=FALSE

GetWindowRect hwnd,rct

x=rct.left

y =rct.top

'Create a region which covers the whole window. This'

must be in screen coordinates'

IF hrgn=1 OR hrgn=0 THEN

(hrgn=CreateRectRgnIndirect(rct

fRegionOwner=TRUE

END IF

FOR i = 0 TO ctp.nNumButtons-1

Get button rectangle in screen coords '

GetButtonRect ctp,hwnd,i,rct1,FALSE 

(hrgn1=CreateRectRgnIndirect(rct1

Cut out a button-shaped hole'

CombineRgn hrgn,hrgn,hrgn,RGN_XOR 

DeleteObject hrgn1

NEXT 

(hdc=GetWindowDC(hwnd

Draw buttons in a loop'
FOR i = 0 TO ctp.nNumButtons-1
Get Button rect in window coords '
GetButtonRect ctp,hwnd,i,rct1,TRUE
uButType=DFCS_BUTTONPUSH
IF ctp.buttons(i).fPressed=True THEN DrawFrameControl hdc,rct,DFC_BUTTON, uButType OR DFCS_PUSHED
ELSE
DrawFrameControl hdc,rct,DFC_BUTTON, uButType
END IF
InflateRect rct1,-2,-2
rct1.Right=rct1.nRight-2
rct1.Bottom=rct1.Bottom-2
IF ctp.buttons(i).fPressed=True THEN OffsetRect rct1,1,1
END IF
NEXT
ReleaseDC hwnd,hdc
IF fRegionOwner=True THEN

DeleteObject hrg

Caption_NCPaint=0

END FUNCTION 

FUNCTION Caption_NCLButtonDown(ctp AS CustomCaption, hwnd,msg, wParam, lParam) AS Long
 'LRESULT
DIM i AS LONG
DIM rct AS RECT
DIM pt AS POINTAPI
pt.x=LOWRD(lParam)
pt.y=HIWRD(lParam)
 'If mouse has been clicked in caption
IF wParam=HTCAPTION THEN
FOR i=0 TO ctp.nNumButtons-1
GetButtonRect ctp,hwnd,i,rct,FALSE
InflateRect rct,0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x,pt.y)=True THEN ctp.iActiveButton=i
ctp.buttons(i).fPressed= TRUE
ctp.fMouseDown=TRUE
SetCapture hwnd
RedrawNC hwnd
FUNCTION= 0:EXIT FUNCTION
END IF
NEXT
END IF
Caption_NCLButtonDown= CallWindowProc(ctp.wpOldProc,hwnd,msg,wParam,lParam)
END FUNCTION

FUNCTION Caption_LButtonUp(ctp AS CustomCaption, hwnd,wParam,lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM uCmd AS LONG
pt.x=LOWRD(lParam)
pt.y= HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
ReleaseCapture
GetButtonRect(ctp,hwnd, ctp.iActiveButton,rct,FALSE)
InflateRect rct, 0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x, pt.y)=True THEN
uCmd=ctp.buttons(ctp.iActiveButton).uCmd
SendMessage hwnd,WM_COMMAND, uCmd,MAKDWD(pt.x,pt.y)
END IF ctp.buttons(ctp.iActiveButton).fPressed=FALSE
ctp.fMouseDown=FALSE
RedrawNC hwnd
FUNCTION=0
EXIT FUNCTION
END IF
FUNCTION = CallWindowProc(ctp.wpOldProc,hwnd, WM_LBUTTONUP,wParam,lParam)
END FUNCTION 

FUNCTION Caption_MouseMove(ctp AS CustomCaption,hwnd, wParam, lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM fPressed AS LONG
pt.x=LOWRD(lParam)
pt.y=HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
GetButtonRect ctp,hwnd,ctp.iActiveButton,rct,FALSE
InflateRect rct,0,2
fPressed=PtInRect(rct, pt.x,pt.y)
IF fPressed <> ctp.buttons(ctp.iActiveButton).fPressed THEN ctp.buttons(ctp.iActiveButton).fPressed= ctp.buttons(ctp.iActiveButton).fPressed XOR 1
RedrawNC hwnd
END IF
Caption_MouseMove=0:EXIT FUNCTION
END IF
Caption_MouseMove = CallWindowProc(ctp.wpOldProc,hwnd, WM_MOUSEMOVE,wParam,lParam)
END FUNCTION 

FUNCTION Caption_LButtonUp(ctp AS CustomCaption, hwnd,wParam,lParam) AS LONG
'LRESULT
DIM rct AS RECT
DIM pt AS POINTAPI
DIM uCmd AS LONG
pt.x=LOWRD(lParam)
pt.y= HIWRD(lParam)
ClientToScreen hwnd,pt
IF ctp.fMouseDown=True THEN
ReleaseCapture
GetButtonRect(ctp,hwnd, ctp.iActiveButton,rct,FALSE)
InflateRect rct, 0,2
'if clicked in a custom button
IF PtInRect(rct, pt.x, pt.y)=True THEN
uCmd=ctp.buttons(ctp.iActiveButton).uCmd
SendMessage hwnd,WM_COMMAND, uCmd,MAKDWD(pt.x,pt.y)
END IF ctp.buttons(ctp.iActiveButton).fPressed=FALSE
ctp.fMouseDown=FALSE
RedrawNC hwnd
FUNCTION=0
EXIT FUNCTION
END IF
FUNCTION = CallWindowProc(ctp.wpOldProc,hwnd, WM_LBUTTONUP,wParam,lParam)
END FUNCTION 

WM_NCHITTEST

مختصات صفحه               Screen Coordinate

برای تعیین اینکه چه بخشی از پنجره با یک مختصات صفحه خاص مطابقت دارد به عنوان مثال ، هنگامی که مکان نما حرکت می کند ، وقتی دکمه ماوس را فشار داده یا آزاد می شود 

این پیام از طریق تابع WindowProc خودش دریافت می شود.

در صورتیکه ماوس تسخیر نشود ، پیام به پنجره ای که  زیر مکان نما است ارسال می شود. در غیر این صورت ، این پیام به پنجره ای که ماوس را تسخیر کرده است ، ارسال می شود.

مقدار برگشتی تابع DefWindowProc یکی از مقادیر زیر است که نشانگر موقعیت نقطه داغ مکان نما است.

رنگ کنترل رسمی ( Custom Control) در SubClaasing

ساب کلاس کردن کنترل ترسیمی  ( تنها یک کنترل ) 

Type  cz As SIZE

cx As Long ' Width

cy As Long  ' Height

End Type 

Type CustCtrl

'Foreground text colour

crForeGnd As Long 

'Background text colour

crBackGnd As Long 

'The font

hFont As Long 

'The control's window handle

hwnd As Long 

End Type 

Painting the control

Whenever windows wants us to update the contents of our window (the client area), a WM_PAINT message will be sent. So, whenever the WM_PAINT message is received, we need to call our control’s painting routine.

case WM_PAINT

 CustCtrl_OnPaint ccp,wParam, lParam

(CustCtrl_OnPaint(ccp As CustCtrl,wParam,lParam

Dim  hdc As Long

Dim ps As PAINTSTRUCTHANDLE

Dim hOldFont As Long

Dim szText As String*200

Dim rc As RECT

Get a device context for this window'

(hdc=BeginPaint(ccp.hwnd,ps

Set the font we are going to use'

(hOldFont=SelectObject(hdc,ccp.hFont

Set the text colours'

SetTextColor hdc,ccp.crForeGnd

SetBkColor  hdc,ccp.crBackGnd

Find the text to draw'

(GetWindowText ccp.hwnd,szText, Len(szText

Work out where to draw'

GetClientRect ccp.hwnd,rc

computes the width and height of the '

.specified string of text'

GetTextExtentPoint32 hdc,szText, len(szText),sz

Center the text'

x=(rc.right-sz.cx)/2

y=(rc.bottom-sz.cy)/2

Draw the text'

ETO_OPAQUE'

The current background color should be used to fill'

the rectangle'

ExtTextOut hdc,x,y,ETO_OPAQUE,rc,szText,len(szText),0

Restore the old font when we have finished'

SelectObject hdc,hOldFont

Release the device context'

EndPaint ccp.hwnd,ps

return 0

---

The GWL_USERDATA area

Every window in the system has a 32bit integer which can be set to any value. This 4 byte storage area is enough to store a pointer to a structure. We set this integer using SetWindowLong, and retrieve the integer using GetWindowLong. Using this technique, our function will look like this:

(GetCustCtrl(hwnd
return=GetWindowLong(hwnd,GWL_USERDATA

(SetCustCtrl(ByVal hwnd As Long,ByRef ccp As CustCtrl

SetWindowLong hwnd,GWL_USERDATA,ccp

This method is usually used when subclassing a control

---

Memory allocated by HeapAlloc is not movable. The address returned by HeapAlloc is valid until the memory block is freed or reallocated; the memory 

.block does not need to be locked

To free a block of memory allocated byHeapAlloc, use 

.the HeapFree function

---

Our custom control will change colour whenever the user clicks the mouse on it. Therefore the next message handler will be for the 

.WM_LBUTTONDOWNmessage

case WM_LBUTTONDOWN

CustCtrl_OnLButtonDown ccp, wParam, lParam


CustCtrl_OnLButtonDown(ByRef ccp As 

(CustCtrl,wParam,lParam
(col=RGB(rnd()*256,rnd()*256,rnd()*256 

Change the foreground colour'
ccp.crForeGnd=col
Use the inverse of the foreground colour'

(ccp.crBackGnd=((col) And &Hffffff
Now redraw the control'
InvalidateRect ccp.hwnd,0,0
UpdateWindow ccp.hwnd
return 0

WM_MOUSEACTIVATE=&H21

'Activates the window, and does not discard the mouse'

.message
MA_ACTIVATE =1

case WM_MOUSEACTIVATE
    SetFocus hwnd
    return MA_ACTIVATE

قلاب کردن پنجره HOOK و دسترسی به کلاس های آن از طریق Subclass کردن

در WIN32 : 

Private Type CWPSTRUCT

lParam As Long

wParam As Long

message As Long

hwnd As Long

End Type

End Type 

Private Const SWP_FRAMECHANGED=&H20

Private Const SWP_NOSIZE=&H1

Private Const SWP_NOZORDER=&H4

Private Const WH_CALLWNDPROC=4

(Private Const GWL_WNDPROC=(-4

Private Const WM_GETFONT=&H31

Private Const WM_CREATE=&H1

Private Const WM_CTLCOLORBTN=&H135

Private Const WM_CTLCOLORDLG=&H136

Private Const WM_CTLCOLORSTATIC=&H138

Private Const WM_CTLCOLOREDIT=&H133

Private Const WM_DESTROY=&H2

Private Const WM_SHOWWINDOW=&H18

Private Const WM_COMMAND=&H111

Private Const BN_CLICKED=0

Private Const IDOK=1

 

Private Const EM_SETPASSWORDCHAR =&HCC

Private INPUTBOX_HOOK As Long

Private INPUTBOX_HWND As Long

Private INPUTBOX_PASSCHAR As String

Private INPUTBOX_FONT As String

Private INPUTBOX_SHOWING As Boolean

Private INPUTBOX_OK As Boolean

Public Function InputBoxEx(ByVal Prompt As String,Optional ByVal Title As String,Optional ByVal FontName As String,Optional ByVal FontSize As Long, Optional ByVal PasswordChar As String,Optional ByVal CancelError As Boolean = False) As String

"INPUTBOX_FONT="MS Sans Serif

INPUTBOX_FONTSIZE=8

INPUTBOX_PASSCHAR=PasswordChar

If Len(FontName) Then INPUTBOX_FONT=FontName

If FontSize>0 Then INPUTBOX_FONTSIZE=FontSize

INPUTBOX_SHOWING = True

INPUTBOX_HOOK=SetWindowsHookEx(WH_CALLWNDPROC,AddressOf 

(HookWindow,0,GetCurrentThreadID

(InputBoxEx=InputBox(Prompt,Title,Context

INPUTBOX_SHOWING=False

 Remove The Hook'

(UnhookWindowsHookEx(INPUTBOX_HOOK

If Not INPUTBOX_OK And CancelError Then Err.Raise vbObjectError + 1, , "User Pressed " & Chr(34) & "Cancel" & Chr(34)

End Function

Private Function HookWindow(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim tCWP As CWPSTRUCT

This is where you need to Hook the Inputbox'

(CopyMemory tCWP, ByVal lParam, Len(tCWP

If tCWP.message=WM_CREATE Then

     If ClassName ="#32770" Then

         If INPUTBOX_SHOWING Then

INPUTBOX_HWND=SetWindowLong(tCWP.hwnd,GWL_WNDPROC,AddressOf 

(InputBoxProc

          End If

     End If

End If HookWindow=CallNextHookEx(INPUTBOX_HOOK,nCode,wParam,ByVal lParam)

End Function

Private Function InputBoxProc(ByVal hwnd As Long,ByVal Msg As Long, ByVal wParam As Long,ByVal lParam As Long) As Long

Select Case Msg

    Case WM_COMMAND

        '..Check to see if the OK Button was Pressed'

       lNotify=Val("&H" & Left$(Right$("00000000" & Hex$(wParam), 8), 4))

       lID = Val("&H" & Right$(Right$("00000000" & Hex$(wParam), 8), 4))

       If lNotify = BN_CLICKED Then

          (INPUTBOX_OK = (lID = IDOK

       End If

Case WM_SHOWWINDOW

      GetWindowRect(hwnd, tRECT

     SetWindowPos hwnd,0, tRECT.Left,tRECT.Top,0,0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_FRAMECHANGED)

Case WM_CTLCOLORDLG,WM_CTLCOLORSTATIC,WM_CTLCOLORBTN,WM_CTLCOLOREDIT

.

.

.

If Msg=WM_CTLCOLORSTATIC Then
Set the Font'
lFont=CreateFont(((INPUTBOX_FONTSIZE/72)*96),0,0,0,0,0,0,0,0,0,0,0,0, 

(INPUTBOX_FONT
SelectObject wParam,lFont
End If

tLB.lbColor=INPUTBOX_BACKCOLOR

(InputBoxProc = CreateBrushIndirect(tLB

 Case WM_DESTROY

    Remove the Inputbox Subclassing'

Call SetWindowLong(hwnd,GWL_WNDPROC, INPUTBOX_HWND)

End Select

InputBoxProc=CallWindowProc(INPUTBOX_HWND,hwnd,Msg,wParam,ByVal lParam)

End Function

قلاب کردن InputBox برای ارسال پیام ویندوزی به آن HOOK /SUBCLASS

تست نشده ولی جواب خواهد داد توابع برای استفاده در Win32 است در Win64 نحوه ی اظهار توابع فرق میکند که در لینک توابع API  در [ پیوندها ] ،  نحوه ی صحیح آن در سایت خارجی درج شده.

Option Explicit 

Necessary constants  for hooking '

Private Const HCBT_ACTIVATE=5

Public Const WH_CBT=5 

Constants for password masking '

Public Const EM_SETPASSWORDCHAR= &HCC 

 Working variables that require global scope in hooking'

module 

Private hHook As Long 

 The API declarations we need Private'

Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long 

Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Declare Function SendMessage Lib "user32" Alias

 SendMessageA" (ByVal hwnd As Long, ByVal wMsg"

As Long, ByVal wParam As Long, lParam As Any) As Long

Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long 

 Wrapper for the normal InputBox function'

Public Function vbInputBox(Prompt As String, Optional Title As String, Optional Default As String, Optional Xpos As Single, Optional YPos As Single, Optional Helpfile As String, Optional Context As Long) As String 

Optional Buttons As VbMsgBoxStyle = vbOKOnly,'

Optional Title As String, Optional HelpFile As String,' 

Optional Context As Long) As Long ,'

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(CBTProc,GetModuleHandle(vbNullString), 0

vbInputBox=InputBox(Prompt, Title, Default, Xpos, 

(YPos, Helpfile, Context)

 End Function

Function Private Function CBTProc(ByVal lMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim hwndEditControl As Long 

If lMsg=HCBT_ACTIVATE And ClassName="#32770" Then

("","hwndEditControl=FindWindowEx(wParam,0,"Edit

 get the edit control'

If hwndEditControl Then

Do your stuff here to modify the window'

SendMessage hwndEditControl,

EM_SETPASSWORDCHAR, Asc("*"), 0,

Immediately unhook'

UnhookWindowsHookEx hHook

End If

'allow operation to continue'

CBTProc = 0

End Function

---

مثال دیگر از فروم خارجی 

Private Declare Function CallNextHookEx Lib "user32

ByVal hHook As Long,ByVal ncode As Long, ByVal)

wParam As Long, lParam As Any) As Long

Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long

Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long 

'Constants to be used in our API functions 

Private Const EM_SETPASSWORDCHAR =&HCC

Private Const WH_CBT=5

Private Const HCBT_ACTIVATE=5

Private Const HC_ACTION=0

Private hHook As Long 

Public Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim RetVal

If lngCode<HC_ACTION Then

(NewProc=CallNextHookEx(hHook,lngCode,wParam,lParam

Exit Function

End

If lngCode=HCBT_ACTIVATE Then

A window has been activated'

If ClassName="#32770" Then

Class name of the Inputbox'

 This changes the edit control'

SendDlgItemMessage wParam,&H1324, EM_SETPASSWORDCHAR,Asc("*"),&H0

End If

End If

CallNextHookEx hHook,lngCode,wParam, lParam

End Function

Function InputBoxDK(Prompt,Title) As String

Dim lngModHwnd As Long,lngThreadID As Long

lngThreadID=GetCurrentThreadId lngModHwnd 

(GetModuleHandle(vbNullString

hHook=SetWindowsHookEx(WH_CBT, AddressOf 

(NewProc,lngModHwnd,lngThreadID

(InputBoxDK=InputBox(Prompt,Title

UnhookWindowsHookEx hHook

End Function

GWL_USERDATA

When you send a WM_CLOSE message to a window, it tries to close the window as if the X button were pressed.You cannot know whether the application was closed externally or by clicking the X button

But there is an easy alternative. When you are closing the window externally using WM_CLOSE, you can initialize its 32-bit user data value using the SetWindowLong function before sending the message. In the target application (being closed) you will query this user data using GetWindowLong function and execute your code accordingly.

The user data value is set to 0 by default. You can set it to any non-zero value before sending the WM_CLOSE 

.message

Set the user data value of the target window to -1'

(originally 0)'

WIN32'

SetWindowLong CurrApp,GWL_USERDATA,-1

send closing messgae'

CurrApp is a Handle to the window

&SendMessage CurrApp,WM_CLOSE, 0,ByVal 0

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)

    If GetWindowLong(hwnd, GWL_USERDATA) = 0 Then

        MsgBox "Closing from X."

    Else '(if -1)

        MsgBox "Closing externally using WM_CLOSE."

    End If

End Sub

گرفتن عرض بوردر ادیت کنترل

SM_CXBORDER=4

'The width of a window border, in pixels. This is equivalent to the SM_CXEDGE value for windows with the 3-D look.

SM_CYBORDER=6   in pixles

SM_CYCAPTION=4  in pixles

SM_CXEDGE=45,SM_CYEDGE=46

'The width And Height of a 3-D border, in pixels. This metric is the 3-D counterpart of SM_CXBORDER.

SM_CXSIZE=30, SM_CYSIZE=31

The width And Height of a button in a window caption'

.or title bar, in pixels

An edit control sends notification codes to its parent window in the 

.form of WM_COMMANDmessages

در کنترل HIWORD پارامترهای آرگومان wparam میشود notification code و LOWORD آن آیدی کنترل و lParam هم هندل کنترل میشود hwndControl

force the edit control to update its non-client area '

SetWindowPos hwndControl,0,0,0,0,0, SWP_FRAMECHANGED Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_NOZORDER

POSTMESSAGE

بررسی وجود باتن MAXIMIZE در پرنت ویندو WIN32

Const GWL_EXSTYLE = -20
Const GWL_HINSTANCE = -6
Const GWL_HWNDPARENT = -8
Const GWL_ID = -12
Const GWL_STYLE = -16
Const GWL_USERDATA = -21
Const GWL_WNDPROC = -4
Const DWL_DLGPROC = 4
Const DWL_MSGRESULT = 0
Const DWL_USER = 8

در ویندوز ۳۲ بیتی  : 

Public Declare Function GetWindowLong Lib "user32.dll" Alias GetWindowLongA" (ByVal hWnd 

As Long,ByVal nIndex As Long) As Long 

Public Const GWL_STYLE=-16

Public Const WS_MAXIMIZEBOX= &H10000

()Private Sub Command1_Click

Dim styles As Long

 receives window styles of Form1'

Get the window styles of Form1'

(styles=GetWindowLong(Me.hWnd,GWL_STYLE

Determine if a maximize box exists or not'

If (styles And WS_MAXIMIZEBOX)= WS_MAXIMIZEBOX Then

".Debug.Print "The form window has a maximize box

Else

Debug.Print "The form window does not have a 

".maximize box

End If

End Sub

CreateWindowEx

 HWND CreateWindowExA

dwExStyle

lpClassName

lpWindowName

dwStyle

X

Y

nWidth

nHeight

hWndParent

hMenu

hInstance

lpParam 

WS_EX_WINDOWEDGE=&H100
WS_EX_TOOLWINDOW=&H80

 :  Window Styles 

WS_BORDER=&H800000
WS_CHILD=&H40000000

WS_POPUP=&H80000000

 : Note 

The windows is a pop-up window. This style cannot' 

be used with the WS_CHILDstyle

Case WM_CREATE/SHOWWINDOW

create window

int style=WS_POPUP And WS_BORDER

int exstyle=WS_EX_TOOLWINDOW

int hwnd=CreateWindowEx(exstyle "xclass"0 style 10 

(10 50 50 0 0 _hinst 0

BS_OWNERDRAW

case WM_CREATE
hWndButton=CreateWindowEx(0, "BUTTON", NULL, 

WS_CHILD Or 

(BS_OWNERDRAW,10,10,80,20,hWnd,IDC_OWNERDRAW,0,0

Type SIZE
x As Long
y As Long
End Type

LPDRAWITEMSTRUCT lpdis =(DRAWITEMSTRUCT*)lParam
SIZE size
[char text[256
("sprintf(text, "%s", "Test

The GetTextExtentPoint32 function computes the'

. width and height of the specified string of text

(GetTextExtentPoint32 lpdis.hDC,text, Len(text),size
(SetTextColor lpdis.hDC,RGB(0, 0, 0
(SetBkColor lpdis.hDC,RGB(255, 255, 0

ExtTextOut lpdis.hDC, ((lpdis.rcItem.right -lpdis.rcItem.left)-size.cx)/2,((lpdis.rcItem.bottom-lpdis.rcItem.top)- size.cy)/2,ETO_OPAQUE And ETO_CLIPPED,lpdis.rcItem,text,Len(text),0)

DrawEdge lpdis.hDC,lpdis.rcItem,(lpdis.itemState & ODS_SELECTED ? EDGE_SUNKEN : EDGE_RAISED ), BF_RECT

: case WM_CREATE
      
       "hButton = CreateWindow("button","Label,
                WS_CHILD | WS_VISIBLE | BS_DEFPUSHBUTTON,
                100, 200, 
                50 ,20,
                hWnd,(HMENU) BUTTON_ID,

                0,0,

تغییرپس زمینه ادیت باکس

if message=WM_CTLCOLOREDIT Then

HDC hdcChild=(HDC)wParam

Text is black – you can modify this by adding anothe '

variable for text color

((SetTextColor hdcChild,RGB(0,0,0

SetBkColor hdcChild, m_BackColor

End if

(OnSetFocus(pOldWnd

(m_BackColor=RGB(255,255,0

Invalidate FALSE

(OnKillFocus(pNewWnd

(m_BackColor=RGB(255,255,255

Force a repaint'

Invalidate FALSE

()OnPaint

(GetWindowText(m_Text

()SetBkGrndColor

Do not call for painting messages'

()SetBkGrndColor

Delete the old brush'

DeleteObject m_Brush

Create a new brush in the specified color' 

(m_Brush=CreateSolidBrush(m_BackColor

(pDC=GetDC(handle

(SetBkMode pDC,OPAQUE

(SetBkColor  pDC,m_BackColor

Select the brush into this window’s device context'

(SelectObject pDC,m_Brush

Dim rc As Rect 

Get the client area of the edit control'

GetClientRect handle,rc

(ScreenToClient handle,rc

Rectangle pDC,0, 0, rc.Width, rc.Height

Rewrite the text since the backcolor paint overwrote'

the existing text 

((SetTextColor pDC,RGB(0, 0, 0

TextOut pDC,2, 2, m_Text.GetBuffer,m_Text.GetLength

Rich Text

Type CHANGENOTIFY
dwChangeType : CN_TEXTCHANGED
End Type

To receive EN_CHANGE notification codes, specify ENM_CHANGE in the mask sent with  the EM_SETEVENTMASK message

برای دریافت کدهای اعلان باید ENM بالا را توسط پیام EM با لا ارسال کرد.

SendMessageA hwndRichBox,EM_SETEVENTMASK,0,ENM_CHANGE

 :EM_SETEVENTMASK

wParam

.This parameter is not used; it must be zero

---

case WM_INITDIALOG
(+) Set password character to a plus sign '
SendDlgItemMessage(hDlg, IDE_PASSWORDEDIT, 

(EM_SETPASSWORDCHAR,"+",0,
"Set the default push button to "Cancel'
(SendMessage(hDlg,DM_SETDEFID, IDCANCEL,0
return TRUE

استایل ورودی تکست / EDIT CONTROL

تغییر بک گراند کنترل Static

case WM_CTLCOLORSTATIC
HDC hdcStatic = (HDC) wParam
(SetTextColor hdcStatic,RGB(0,0,255
(SetBkColor hdcStatic,RGB(250,250,0
((Function=CreateSolidBrush(RGB(250,250,0

case WM_CTLCOLOREDIT
HDC hdcStatic = (HDC) wParam
(SetTextColor hdcStatic,RGB(0,0,255
(SetBkColor hdcStatic,RGB(0,230,0
((Function=CreateSolidBrush(RGB(0,230,0

OffsetRect / جابجائی

Type INSTBUT

uCmdId ' WM_COMMAND message

uState As Integer

fButtonDown ' ?button up/down

fMouseDown As Boolean

WNDPROC oldproc ' need to remember the old window procedure

 cxLeftEdge As Long

cxRightEdge As Long

cyTopEdge As Long

cyBottomEdge As Long

End Type 

SubClass Edit Control

(BOOL InsertButton(hwnd,uCmdId
Dim pbut As InsBut
((pbut=heapalloc(GetProcessHeap(),0, Len(InsBut
if Not pbut  Then InsertButton=False
pbut.uCmdId=uCmdId
pbut.fButtonDown=FALSE
replace the old window procedure with our new one'
pbut.oldproc=SetWindowLong(hwnd,

(GWL_WNDPROC,InsButProc,
associate our button state structure with the window '
(SetWindowLong(hwnd,GWL_USERDATA, pbut
force the edit control to update its non-client area'
SetWindowPos(hwnd,0,0,0,0,0, SWP_FRAMECHANGED | SWP_NOMOVE|SWP_NOSIZE|SWP_NOACTIVATE|SWP_NOZORDER)
InsertButton=True

GetButtonRect(ByRef pbut As InsBut,ByRef rc As RECT 

)

rc.right=rc.right-pbut.cxRightEdge

rc.top=rc.top+pbut.cyTopEdge

rc.bottom=rc.bottom-pbut.cyBottomEdge

(rc.left=rc.right-GetSystemMetrics(SM_CXVSCROLL

'take into account any scrollbars in the edit control

if(rc.cxRightEdge>rc.cxLeftEdge) Then  OffsetRect rc,pbut.cxRightEdge-pbut.cxLeftEdge,0

End if

Dim rc As RECT
Dim pt As POINT

Dim prect As RECT
Dim oldrect As RECT
'get the button state structure InsBut *pbut = (InsBut *)GetWindowLong(hwnd, GWL_USERDATA)

case WM_NCCALCSIZE
prect =(RECT *)lParam
oldrect= *prect
let the old wndproc allocate space for the borders or' 

.any other non-client space
CallWindowProc(pbut.oldproc,hwnd,msg, 

(wParam,lParam,
calculate what the size of each window border is'
we need to know where the button is going to live
pbut.cxLeftEdge=prect.left-oldrect.left pbut.cxRightEdge=oldrect.right-prect.right
pbut.cyTopEdge=prect.top-oldrect.top
pbut.cyBottomEdge=oldrect.bottom
prect.bottom-

now we can allocate additional space by deflating the' 

rectangle even further. Our button will go on the right-hand side and will be the same width as a scrollbar button
-prect.right=prect.right

(GetSystemMetrics(SM_CXVSCROLL
'that's it! Easy or what!
return 0



case WM_NCLBUTTONDOWN
'get the screen coordinates of the mouse

(pt.x=GET_X_LPARAM(lParam
(pt.y=GET_Y_LPARAM(lParam

'get the position of the inserted button'

GetWindowRect hwnd,rc

GetButtonRect pbut,rc
check that the mouse is within the inserted button'
if(PtInRect(rc, pt)) Then
SetCapture hwnd
pbut.uState=1
pbut.fMouseActive=TRUE
redraw the non-client area to reflect the change'

RedrawNC hwnd
End If

Dim rc As RECT
Dim pt As POINT
Dim oldstate

case WM_MOUSEMOVE
...if(pbut.fMouseActive=FALSE) Exit 
get the CLIENT coordinates of the mouse'
(pt.x=GET_X_LPARAM(lParam
pt.y=GET_Y_LPARAM(lParam)

ClientToScreen hwnd,pt
get the position of the inserted button'
GetWindowRect hwnd,rc
GetButtonRect pbut,rc
oldstate=pbut.uState
check that the mouse is within the inserted button'
if(PtInRect(rc,pt)) Then
pbut.uState=1
else
pbut.uState=0

End if
redraw the non-client area to reflect the change'

to prevent flicker, we only redraw the button if its state'

has changed if(oldstate<>pbut.uState Then'

RedrawNC hwnd

Dim rc As RECT
Dim pt As POINT
Dim oldstate As Integer

case WM_LBUTTONUP
...if(pbut.fMouseActive=FALSE) Exit
get the CLIENT coordinates of the mouse'
(pt.x=GET_X_LPARAM(lParam
(pt.y=GET_Y_LPARAM(lParam
ClientToScreen hwnd,pt
get the position of the inserted button'
GetWindowRect hwnd,rc
GetButtonRect pbut,rc
check that the mouse is within the inserted button'
if(PtInRect(rc,pt)) Then
PostMessage(GetParent(hwnd), WM_COMMAND, MAKEWPARAM(pbut.uCmdId, BN_CLICKED),0)
ReleaseCapture
pbut.uState = 0
pbut.fMouseDown=FALSE
.redraw the non-client area to reflect the change'
RedrawNC hwnd

case WM_NCHITTEST
get the screen coordinates of the mouse'
(pt.x=GET_X_LPARAM(lParam
(pt.y=GET_Y_LPARAM(lParam
get the position of the inserted button'
GetWindowRect hwnd,rc
GetButtonRect pbut,rc
check that the mouse is within the inserted button'
 if(PtInRect(rc,pt)) Then
return HTBORDER
else
...Exit

End if 

case WM_NCDESTROY
oldproc=pbut.oldproc

HeapFree(GetProcessHeap(),0, pbut)

return CallWindowProc(oldproc, hwnd,msg, wParam,

(lParam,

پیام WM_MOUSEMOVE

     setcapture

releasecapture

getcapture

settimer

killtimer

wm-timer

nidEvent می تواند WM_MOUSELEAVE باشد یعنی SetTimer  در MOUSEMOVE تنظیم شود اگر Msg گرفته شده در TIMEPROC برابر MOUSELEAVE شد کاری انجام شده و بعد KillTimer اعمال گردد.

Detect Mouse Over The Button ( ردیابی وقایع ماوس )

trackmouseevent :Posts messages when the mouse pointer leaves window or hovers over a window for a specified amount of time

پست کردن پیام هایی به پرنت ویندو  وقتی نشانگر ماوس پنجره را ترک کرده ( هندل به ویندو ) یا  روی یک پنجره برای مدتی از زمان بصورت شناور است ( می پلکد- یا روی آن محدوده).

---

API Declarations'

Public Type udtTrackMouseEvent
cbSize As Long
dwFlags As Long
hwndTrack As Long
dwHoverTime As Long
End Type

Public Declare Function TrackMouseEvent Lib "comctl32" Alias "_TrackMouseEvent" (lpEventTrack As udtTrackMouseEvent) As Long

---

Dim TheButtonToggle As Boolean

TheButtonToggle=false

ButtonSubclass(hWnd,uMsg,wParam,lParam,uIdSubclass,dwRefData

(

Select Case uMsg

    case WM_MOUSEMOVE

        if (TheButtonToggle=false) Then 

(tm_Event.cbSize =Len(TRACKMOUSEEVENT

tm_Event.dwFlags=TME_LEAVE

(tm_Event.hwndTrack=GetDlgItem((HWND)dwRefData,IDC_TheButton

TrackMouseEvent tm_Event

TheButtonToggle=true

hBit =LoadImage(0,MAKEINTRESOURCE(IDB_ButtonWhenMouseIsOver

(IMAGE_BITMAP,90,49,0,

SendMessage GetDlgItem((HWND)dwRefData

IDC_TheButton),STM_SETIMAGE,IMAGE_BITMAP,ByVal 

(hBit

         End If 

     case WM_MOUSELEAVE

hBit=LoadImage(0

(MAKEINTRESOURCE(IDB_ButtonAtRest

(IMAGE_BITMAP,90,49,0,

SendMessage GetDlgItem((HWND)dwRefData

IDC_TheButton),STM_SETIMAGE,IMAGE_BITMAP,ByVal 

(hBit

TheButtonToggle = false

      case WM_LBUTTONDOWN

,hBit=LoadImage(0

(MAKEINTRESOURCE(IDB_TheButtonWhenClickedDown),IMAGE_BITMAP,90,49,0

SendMessage GetDlgItem((HWND)dwRefData,

IDC_TheButton),STM_SETIMAGE,IMAGE_BITMAP,ByVal 

(hBit

       case WM_LBUTTONUP

,hBit=LoadImage(0

(MAKEINTRESOURCE(IDB_TheButtonWhenMouseIsOVer),IMAGE_BITMAP,90,49,0)

SendMessage

,GetDlgItem((HWND)dwRefData,IDC_TheButton),STM_SETIMAGE,IMAGE_BITMAP,

(ByVal hBit

TheButtonToggle = false

ButtonSubclass=True 

' Other cases...

End Select 

,ButtonSubclass=DefSubclassProc(hWnd, uMsg 

(wParam, lParam

Source : how-to-detect-if-mouse-is-hover-on-button

---

Dim g_fMouseInClient As Boolean
MOUSEMOVE

 if Not g_fMouseInClient Then 

( g_fMouseInClient=TRUE

MessageBeep(0
Dim tme As TRACKMOUSEEVENT

(tme.cbSize=Leb(tme
tme.dwFlags=TME_LEAVE

 tme.hwndTrack=hwnd
TrackMouseEvent tme

case WM_MOUSELEAVE 

g_fMouseInClient=FALSE
return 0
(HANDLE_MSG(hwnd,WM_MOUSEMOVE,OnMouseMove; 

Source : devblogs

---

تغییر رنگ پس زمینه WM_NCMOUSEMOVE

پیام WM_SETCURSOR برای تغییررنگ Custom Button

 getdlgctrlid : Retrieves the identifier of the 

.specified control

بر گرفته از فروم خارجی  ( بررسی  موقعیت ماوس در باتن موردنظر )

1-find your button rectangle

GetWindowRect BtnHwnd,BtnRect

2-transform form client coordinate in screen coordinate

ClientToScreen BtnRect,pt

(those 2 points in OnInitDialog or equivalent)

3-in OnMouseMove function check if mouse point is inside BtnRect (use PtInRect(BtnRect,pt) and if it is then do what u want to do.The mouse point u can found it this way:Dim pt As POINT

(pt.x = LOWORD(lParam

(pt.y = HIWORD(lParam

---

WM_SETCURSOR. Do not change anything, just detect if wParam is HWND of your button. If it is, then set a 

flag (some BOOL) and InvalidateRect(..) your button. 

#define WM_SETCURSOR                    0x0020

تست شده طبق توصیه ی دوست خارجی 

Case WM_SETCURSOR

      Dim cc As RECT

      (hdc = GetWindowDC(can

      GetClientRect can, cc ' Necessary

can is handle of Cancel Button'       

      If wParam = can Then

      ((FillRect hdc, cc, CreateSolidBrush(RGB(255, 0, 0

      ReleaseDC can, hdc

      Else

InvalidateRect' 

      InvalidateRect can, cc, False

      End If

Hook کردن MsgBox و Subclass کردن تغییر حالت باتن ها به BS_OWNERDRAW  در ENUMCHILDPROC و گرفتن  آیدی های باتن فرضا IDYES=6 و IDNO=7 و IDCANCEL=2 با GetDlgCtrlID که در مثال زیر در ناحیه کنترل Static در آخرش آیدی ها پرینت شده.

آیدی ها درمتغید تعریف شده بنام GetBtn  ذخیره شده و با تابع Split  در اکسس جدا شده ودر لوپ گذاشته شده این متد فقط با پیام DRAWITEN انجام میشود و پیام CTLCOLORBTN جواب نخواهد داد.

Case WM_DRAWITEM

  

 Dim pDIS As DRAWITEMSTRUCT

   Dim state

   Dim p As RECT

   Dim pdc As LongPtr

   Dim OldBr As LongPtr

 

   ("," ,SplitBtn = Split(GetBtn

     (For i = 0 To UBound(SplitBtn

      (CopyMemory pDIS, ByVal lParam, Len(pDIS

      DeleteObject OldBr

      

     (( BtnHwnd = GetDlgItem(lhwnd, SplitBtn(i

      p = pDIS.rcItem

      pdc = pDIS.hdc

      (hdc = GetWindowDC(pdc

      pDIS.hwndItem = BtnHwnd

      GetClientRect pDIS.hwndItem, p

      ,OldBr=SelectObject(hdc

((CreateSolidBrush(RGB(100, 0, 135

      RoundRect hdc, p.Left, p.Top, p.Right, p.Bottom, 16, 16

      ReleaseDC BtnHwnd, hdc

      DeleteObject OldBr

      (CopyMemory ByVal lParam, pDIS, Len(pDIS

          Next

 Case WM_SETCURSOR

      Dim cc As RECT

      Dim txt

      

(" ,",SplitBtn = Split(GetBtn

    (For j = 0 To UBound(SplitBtn

DeleteObject OldBr   

((BtnHwnd = GetDlgItem(lhwnd, SplitBtn(j   

(txt = GetText(BtnHwnd    

GetClientRect BtnHwnd, cc    

(hdc = GetWindowDC(BtnHwnd    

GetClientRect BtnHwnd, cc    

If wParam = BtnHwnd Then

            cc.Left = cc.Left + 2.5     

            cc.Top = cc.Top + 2.5     

            cc.Right = cc.Right - 2.5     

            cc.Bottom = cc.Bottom - 2.5     

 (( FillRect hdc, cc, CreateSolidBrush(RGB(255, 0, 0

  DrawText hdc, txt, Len(txt), cc, DT_CENTER            ReleaseDC BtnHwnd, hdc

DeleteObject OldBr 

       Else

InvalidateRect BtnHwnd, cc, False

ReleaseDC BtnHwnd, hdc

DeleteObject OldBr

      End If  

      Next

      

SetBkMode hdc,0'