ترسیم دکمه ای شکل ( Button shaped) در InputBox استفاده از DrawFrameControl

با DrawIcon هم می توان آیکونی را در DC صفحه انداخت 

Paint InputBox

موارد پایین تست شده ... البته اینها موارد ساده ای هستند و پیش پا افتاده

Public Function CallWindProc(ByVal hwnd As LongPtr, ByVal Msg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

Dim hdc As LongPtr

Select Case Msg

   Case WM_PAINT

     Dim cc As RECT

     GetClientRect hwnd, cc

     (hdc = GetDC(hwnd

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

   Case WM_DESTROY

   SetWindowLongPtr hwnd, GWL_WNDPROC, OldWindow

   End Select

CallWindProc = CallWindowProc(OldWindow, hwnd,

(Msg, wParam, lParam,

End Function

(FillRect hdc, cc, GetSysColorBrush(5

(FillRect hdc, cc, GetSysColorBrush(16

TIMER

 Case WM_TIMER

GetClientRect hwnd, rcClient

hdc

(GetDC(hwnd=

      DrawText hdc, x, 2, rcClient, DT_CENTER

      SetWindowTextA hwnd, x

    x = x + 1

ترسیم مستطیل در InputBox

Case WM_TIMER

               Dim Et As LongPtr

        Dim WinRect As RECT

     Et:Edit Handle,WinRect For Edit Control'

        GetWindowRect Et, WinRect

       ( hdc = GetDC(hwnd

        rc.Left = 10

        rc.Top = 68

        rc.right = 70

        rc.bottom = 88

rcClear.Left = rc.Left: rcClear.right = GetUpdateRight

        rcClear.Top = rc.Top - 3: rcClear.bottom = rc.bottom

         rc.Left = rc.Left + x: rc.right = rc.right + x

        Fill Rectangle' 

( FillRect hdc, rcClear, GetSysColorBrush(15

           Draw Rectangle'

           Rectangle hdc, rc.Left, rc.Top, rc.right, rc.bottom

FillRect Again GetSysColorBrush(18) ' Black'

Use Offset And FillRect rc With Another Brush'

GetUpdateRight = rc.right + x

        If rc.right > WinRect.right - WinRect.Left Then x = 0

CUSTOM CAPTION

case WM_PAINT

Dim ps As PAINTSTRUCT ps

hdc =BeginPaint(hwnd,ps)

'fill the window with a color HBRUSH

hbrush=CreateSolidBrush(RGB(33, 33, 33))

FillRect hdc,ps.rcPaint,hbrush

DeleteObject(hbrush)

'get a drawing area

Dim Crect As RECT

GetClientRect hwnd,Crect

Crect.bottom=Crect.top+GetSystemMetrics(SM_CYCAPTION)+ GetSystemMetrics(SM_CYEDGE)*2

'draw a simple win9x style caption (switch out the window text while drawing)

SetWindowText hwnd,CUSTOM_CAPTION

DrawCaption hwnd, hdc, rect,DC_GRADIENT Or DC_TEXT Or DC_ACTIVE Or DC_ICON

SetWindowText hwnd,WINDOW_CAPTION

DC_ACTIVE = 1
DC_SMALLCAP = 2
DC_ICON = 4
DC_TEXT = 8
DC_INBUTTON = 16
DC_GRADIENT = 32

SM_CXSCREEN = 0
SM_CYSCREEN = 1

SM_CXSIZE = 30
SM_CYSIZE = 31

SM_CXFRAME = 32
SM_CYFRAME = 33

SM_CYCAPTION = 4

SM_CXBORDER = 5
SM_CYBORDER = 6

SM_CXICON = 11
SM_CYICON = 12

SM_CXFRAME = 32
SM_CYFRAME = 33

SM_CXEDGE = 45
SM_CYEDGE = 46

---

DFC_CAPTION = 1
DFC_MENU = 2
DFC_SCROLL = 3
DFC_BUTTON = 4
DFC_POPUPMENU = 5
DFCS_CAPTIONCLOSE = 0
DFCS_CAPTIONMIN = 1
DFCS_CAPTIONMAX = 2
DFCS_CAPTIONRESTORE = 3
DFCS_CAPTIONHELP = 4
DFCS_MENUARROW = 0
DFCS_MENUCHECK = 1
DFCS_MENUBULLET = 2
DFCS_MENUARROWRIGHT = 4
DFCS_SCROLLUP = 0
DFCS_SCROLLDOWN = 1
DFCS_SCROLLLEFT = 2
DFCS_SCROLLRIGHT = 3
DFCS_SCROLLCOMBOBOX = 5
DFCS_SCROLLSIZEGRIP = 8
DFCS_SCROLLSIZEGRIPRIGHT = 16
DFCS_BUTTONCHECK = 0
DFCS_BUTTONRADIOIMAGE = 1
DFCS_BUTTONRADIOMASK = 2
DFCS_BUTTONRADIO = 4
DFCS_BUTTON3STATE = 8
DFCS_BUTTONPUSH = 16
DFCS_INACTIVE = 256
DFCS_PUSHED = 512
DFCS_CHECKED = 1024
DFCS_TRANSPARENT = 2048
DFCS_HOT = 4096
DFCS_ADJUSTRECT = 8192
DFCS_FLAT = 16384
DFCS_MONO = 32768

---

پیام WM_PAINT جهت رنگ Client و WM_DRAWITEM برای باتن ساخته شده بجای باتن CANCEL

تست شده 

The WM_PAINT message is sent when the system or another application makes a request to paint a portion 

  of an application's window

The PAINTSTRUCT structure contains information that can be used to paint the.client area of a window

حاوی اطلاعاتی برای استفاده در نقاشی ناحیه ی Client پنجره.

Case WM_PAINT

Dim ps As PAINTSTRUCT

    ( hdc = BeginPaint(lhwnd, ps

     Dim rrc As RECT

     GetClientRect lhwnd, rrc 

  (( FillRect hdc, rrc, CreateSolidBrush(RGB(100, 0, 100

     SetTextColor hdc, vbRed

     TextOutA hdc, 10, 10, "sa", 2

     EndPaint lhwnd, ps

     ReleaseDC lhwnd, hdc

البته غیر از پیام زیر میشود با پیام WM_CTLCOLORBTN  هم  رنگ باتن  را تغییر داد که lParam میشود هندل باتن و wParam هم هندل DC میشود

Case WM_DRAWITEM

   Dim pDIS As DRAWITEMSTRUCT

   Dim state

   (CopyMemory pDIS, ByVal lParam, Len(pDIS

  ( hdc = GetDC(pDIS.hdc

   Dim p As RECT

   p = pDIS.rcItem

   state = pDIS.itemState

  GetClientRect can, p

   If pDIS.CtlID = 2 Then

   If state = 272 Then       

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

ReleaseDC can, hdc  

  Else         

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

  ReleaseDC can, hdc      

 End If     

   End If

   (CopyMemory ByVal lParam, pDIS,Len(pDIS

زمان کلیک روی باتن کنسل  مکث عمل RounRect را نمایش داده و پنجره بسته میشود.

If state = 785 Then  '272

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

  Sleep 400

  ReleaseDC can, hdc

If (pDIS.itemState And???

ODS_SELECTED)=ODS_SELECTED Then

---

طبق داکیومنت آفیس  (WM_CTLCOLORBTN) :

در موارد بالا حتما باید BS_OWNERDRAW تنظیم شود برای کل باتن ها که هندل میشود هندل Dlg و برای باتن خاص هندل همان باتن فقط ،   setwindowlongptra را در WIN64 ببینید.

See For Button Control button-styles

See For Static Control static-control-styles

wParam
An HDC that specifies the handle to the display context for the button
lParam
)An HWND that specifies the handle to the button

getdlgitem : Retrieves a handle to a control in the 

(specified dialog box

hdc=wParam '

Case WM_CTLCOLORBTN

if lparam=GetDlgItem(hwnd,IDCANCEL) then

.

End if

Exit Function

---

The idea is to add your own Windows message handler, you can do this using 

.SetWindowsHookEx function

Don't forget : Before terminating, an application must call the UnhookWindowsHookEx function to free 

system resources associated with the hook