رسم ۳ باتن در TitleBar

X,y طبق POINTAPI در lParam 

(x = CLng(lParam) And &HFFFF& 'LoWord(lParam

  (y = CLng(lParam) \ 65535  ' LoWord(lParam

در پیام WM_NCPAINT

Private  tBtn As RECT

Dim i As Integer

Dim C As Integer

C=10

Gap=0

For i=0 To 2

GetClientRect lhwnd,tBtn

With tBtn

(Bottom=GetSystemMetrics(SM_CYCAPTION.

Left=.Right-c-Gap.

Right=.Right+18.

Top=.Top+4.

End With

C=C+28

Gap=2

Next

---

کپی شده از فروم های خارجی چنانچه در MsgBox  تست شود تصویر گذاشته خواهد شد 

Public Const SM_CXSIZE = 30

Public Const SM_CYSIZE = 31

Public Const SM_CXFRAME = 32

Public Const SM_CYFRAME = 33

Dim closeRect As RECT

(hDC=GetWindowDC(lhwnd

closeRect.left=rc.right-rc.left-20

(closeRect.top=GetSystemMetrics(SM_CYFRAME

closeRect.right=rc.right-rc.left-5

(closeRect.bottom=GetSystemMetrics(SM_CYSIZE

DrawFrameContro

hDC,closeRect,DFC_CAPTION,DFCS_CAPTIONCLOSE

 ???m_rcClose=closeRect

ReleaseDC dc

////////////////////////

Private Const DHT_CLOSE As Long=20
Private DHT_CAPTION As Long=2
Dim m_LastHit As Long
Dim m_ButtonDown As Long Dim m_rcClose As RECT 

Public Const HTCLIENT=1    ' in a client area
Public Const HTCAPTION=2 ' in a title bar
Public Const HTCLOSE=20   ' in a close button
Public HTMAXBUTTON=9 ' in a Maximize Button
Public HTMINBUTTON=8 ' in a Minimize Button

(Private Sub OnNcActivate(bActive As Boolean

()Call OnNcPaint
OnNcActivate=TRUE
End Sub

()Private Sub OnNcPaint
.
.
.
DrawFrameControl hDC,closeRect,DFC_CAPTION,DFCS_CAPTIONCLOSE
m_rcClose = closeRect
ReleaseDC hDC
End Sub 

(Private Sub HitTest(pt As POINAPI
CRect rect=m_rcClose'
(if rect.PtInRect(pt' 
(if PtInRect(m_rcClose,pt
HitTest=DHT_CLOSE
else
HitTest=DHT_CAPTION
End If

(OnNcLButtonDown(UINT nHitTest, CPoint point

CPoint pt=point

ScreenToClient pt

pt.y += GetSystemMetrics(SM_CYCAPTION) +
GetSystemMetrics(SM_CYFRAME);
pt.x += 5

hitTest=HitTest(pt)

Select Case hitTest

case DHT_CLOSE

CWindowDC dc(this)
DrawFrameControl dc.m_hDC,
m_rcClose,
DFC_CAPTION,
DFCS_CAPTIONCLOSE +DFCS_PUSHED)
m_LastHit=hitTest
m_ButtonDown=hitTest
SetCapture lhwnd
End Select

---

روش های زیر فقط برای باتن در صورتیکه Resize انجام نشود تست شده. 

بنده آدم بی سوادی هستم  ولی بخاطر اینکه به این مرحله با کمک فروم های خارجی رسیدم احساس رضایت میکنم  بنابراین کمک کوچکیست برای بقیه ی افراد تا زمانشون از دست نره ... روش زیر طبق تصاویر کاملا تست شده اگر مشکلی در کدها بود لطفا مهندسان کامپیوتر در نظرها درست آن را برای بقیه به اشتراک بگذارند از این قبیل کدها در VBA کم هست یا روش های سخت تری هست.

برداشتن منوهای سیستمی در NonClient Region  ا ز طریق Hook و Subclass Specified Window 

SetWindowLongPtr wnd(#32770), GWL_STYLE,

 GetWindowLong(wnd, GWL_STYLE) And Not WS_SYSMENU

تست شده برای کلوز باتن ایجاد شده 

Case WM_NCLBUTTONDOWN

Dim ptp As POINTAPI

    GetCursorPos ptp

 Get Position of Left Window In Screen'

     GetWindowRect lhwnd, wRect

Dim p1 As POINTAPI  ' Top & Left

     Dim p2 As POINTAPI  ' Right & Bottom

     

     p1.x = wRect.Left + tCloseRect.Left ' Left

     p1.y = wRect.Top + tCloseRect.Top   ' Top

     

     p2.x = wRect.Left + tCloseRect.Right ' Right

     p2.y = wRect.Top + tCloseRect.Bottom ' Bottom

 _  If ptp.x > wRect.Left + tCloseRect.Left And ptp.x < wRect.Left + tCloseRect.Right 

     And ptp.y > wRect.Top + tCloseRect.Top And ptp.y < wRect.Top + tCloseRect.Bottom Then

(hdc = GetWindowDC(lhwnd

      DrawFrameControl hdc, tCloseRect, DFC_BUTTON, DFCS_PUSHED

      ReleaseDC lhwnd, hdc

      SendMessageA lhwnd, WM_CLOSE, 0, 0'

     End If

مثال دیگر روی MsgBox در پیام   WM_NCLBUTTONDOWN   و تعریف tcloseRect,Btn در آغاز کدنویسی Btn در پیام Create یا ShowWindow و  Destroy به False تنظیم شود متغیرهای ذکر شده گلوبال هستند .

x1,y1 در اینجا طبق خط اول این تاپیک منظور x و  y که از lParam که نشانگر کرسر هست در پیام استفاده شده .

در کدهای زیر زمان فشردن باتن چپ ماوس در ناحیه NonClient و در X,y گرفته شده باتن به حالت Pushed و بعد از مکث کنی به حالت اول برمی گردد.

در کد زیر از GetWindowRect برای گرفتن Left پنجره از دسکتاپ استفاده شده که به POINT داده میشود .اگر  GetClientRect استفاده کنید Left را صفر میدهد پس حواستون جمع باشه.

_  If x1 > wrect.Left + tCloseRect.Left And x1 < wrect.Left + tCloseRect.Right 

      And y1 > wrect.Top + tCloseRect.Top And y1 < wrect.Top + tCloseRect.Bottom Then

      btn = True

      &SendMessageA lhwnd, WM_NCPAINT, 0&, 0

      btn = False

      Sleep 150

      &SendMessageA lhwnd, WM_NCPAINT, 0&, 0

      End If

     Exit Function

در پیام WM_NCPAINT 

If btn = True Then

      DrawFrameControl hdc, tCloseRect, DFC_BUTTON, DFCS_PUSHED

      ElseIf btn = False Then

      DrawFrameControl hdc, tCloseRect, DFC_BUTTON, DFCS_BUTTONPUSH   ' DFCS_PUSHED

      End If

 در مثال زیر در صورت کلیک در باتن کلوزحالت به Pushed  تغییر کرده بعد از مکث دوبار به حالت ButtonPush تغییر و بعد از مکث خیلی کوتاه پنجره بسته میشود. همانطور که میبینید عملکرد باتن طبق پیامی که به پنجره ارسال میشود انجام میگیرد یعنی NC_PAINT.

_  If x1 > wrect.Left + tCloseRect.Left And x1 < wrect.Left + tCloseRect.Right

      And y1 > wrect.Top + tCloseRect.Top And y1 < wrect.Top + tCloseRect.Bottom Then

      btn = True

      &SendMessageA lhwnd, WM_NCPAINT, 0&, 0

      btn = False

      Sleep 150

     & SendMessageA lhwnd, WM_NCPAINT, 0&, 0

      Sleep 20

     & SendMessageA lhwnd, WM_CLOSE, 0&, 0

      End If

windows/win32/gdi/using-rectangles