GETWINDOWRECT نمایش باتن ساخته شده در InputBox

دادن  ابعاد مستطیل پنجره ی مشخص شده ( ابعاد در مختصات صفحه داده میشود ) در ClientRect عدد x  و y  گوشه ی بالایی صفر است 

Retrieves the dimensions of the bounding  rectangle of the specified window. The dimensions are given in screen coordinates  that are relative to the upper-left 

.corner of the screen

برای اضافه کردن باتن ازCreateWindowEx استفاده میشود . در زمان ساب کلاس کردن و قرار دادن در پیام SHOWWINDOW و استفاده از استایل WS_CHILD OR WS_VISIBLE اگر بخواهیم میتوان از BS_OWNERDRAW استفاده کرد و باتن خود را در پیام CTLCOLORBTB ( که lparam هندلی است برای هندل باتن ) ترسیم کرد .

فرضا اگر به InputBox  در زیر باتن کنسل بخواهیم باتنی اضافه کنیم می توانیم با GetWindowRect موقعیت باتن کنسل را بگیریم  منظور X و Y گوشه بالایی و با GetClientRect عرض و طول باتن Cancel را بدست آوریم  ( همانطور که گفته شد GetClientRect گوشه بالایی هر کنترلی را صفر میدهد )  

Dim WinRect As RECT 

Dim BtnWinRect As RECT 

Dim BtnClientRect As RECT

Dim CyFrame As Long 

(CyFrame=GetSystemMetrics(SM_CYFRAME

(CyCaption=GetSystemMetrics(SM_CYCAPTION

GetWindowRect Hwnd,WinRect

GetWindowRect BtnHandle,BtnRect

GetClientRect BtnHandle,BtnClientRect

ابعاد زیر میشود پارامترهایی که باید در آرگومانهای تابع CreateWindowEx قراردهیم x1,y1 میشود مختصات گوشه ی بالایی سمت چپ  و cx (  عرض ) و cy ( ارتفاع ) یا x2 و y2 میشود مختصات گوشه پایینی سمت راست 

LeftBound=(BtnWinRect.Left-WinRect.Left)+CyFrame

TopBound=(BtnWinRect.Top-WinRect.Top)+CyFrame

(CyCaption/2)+

RightBound'

Width=BtnClientRect.Rigth-BtnClientRect.Left

BottomBound'

Height=BtnClientRect.Bottom-BtnClientRect.Top

NCPAINT

Region GetDCExFlags

Const DCX_WINDOW=&H1

Const DCX_CACHE=&H2

Const DCX_NORESETATTRS=&H4

Const DCX_CLIPCHILDREN=&H8

Const DCX_CLIPSIBLINGS=&H10

Const DCX_PARENTCLIP=&H20

Const DCX_EXCLUDERGN=&H40

Const DCX_INTERSECTRGN=&H80

Const DCX_EXCLUDEUPDATE=&H100

  : Message WM_NCPAINT

HDC hdc

RECT Winrect

HBRUSH b

HPEN pe

hdc=GetDCEx(hwnd

 HRGN)wParam,DCX_WINDOW Or DCX_CACHE Or)

(DCX_INTERSECTRGN Or DCX_LOCKWINDOWUPDATE

GetWindowRect hwnd,Winrect

((b=CreateSolidBrush(RGB(0,180,180

SelectObject hdc,B

(pe=CreatePen(PS_SOLID,1,RGB(90, 90, 90

SelectObject hdc,pe

Rectangle hdc,0,0,(rect.right-rect.left),(rect.bottom

(rect.top-

DeleteObject pe

DeleteObject B

ReleaseDC hwnd,hdc

RedrawWindow hwnd,Winrect

(HRGN)wParam,RDW_UPDATENOW,

return 0

---

NC_Paint is better because it will only paint when needed.


WM_NCPAINT

(DefWindowProc(hwnd, msg, wparam, lparam
let the defaultWNDPROC handle most of it'
(hdc = GetWindowDC(hwnd
Rectangle hdc,150,3,250,23) 'then draw in your button
("TextOutW hdc,153,4,"New Button",10
ReleaseDC hwnd, hdc
return 0

---

Step 4: the Window Procedure

WndProc(HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam)

Select Case msg

case WM_CLOSE
DestroyWindow hwnd

case WM_NCHITTEST
if(CallWindowProc(OldProc,hwnd,msg,wParam,lParam)=HTCAPTION) Then
return 0
else
CallWindowProc hwnd, msg,wParam, lParam
End if

case WM_NCCALCSIZE

if(wParam=TRUE) Then
LPNCCALCSIZE_PARAMS lpncsp = (LPNCCALCSIZE_PARAMS)lParam

lpncsp.rgrc(0).left += 5
lpncsp.rgrc(0).top += 100
lpncsp.rgrc(0).right -= 5
lpncsp.rgrc(0).bottom -= 5
return 0
else
CallWindowProc OldProc,hwnd, msg, wParam, lParam
End if

case WM_NCLBUTTONDBLCLK
return NULL
break;
case WM_NCLBUTTONUP
return NULL
break
case WM_DESTROY
PostQuitMessage 0
break
case WM_NCACTIVATE
////// what i do here.'
return FALSE
break

case WM_NCPAINT

m=(HRGN)wParam
hdic=GetDCEx(hwnd,(HRGN)wParam,DCX_WINDOW 

(Or DCX_CACHE Or DCX_INTERSECTRGN

GetWindowRect hwnd,Winrect
((b=CreateSolidBrush(RGB(180,180,180
SelectObject hdic,b
((pe=CreatePen(PS_SOLID,1,RGB(90, 90, 90
SelectObject hdic,pe
Rectangle hdic,0,0,(rect.right-rect.left),(rect.bottom-rect.top)
DeleteObject pe
DeleteObject b

ReleaseDC hwnd,hdic
RedrawWindow hwnd,Winrect,(HRGN)wParam,RDW_UPDATENOW
return 0

Custom Caption

(LONG lStyle=GetWindowLong(Hwnd, GWL_STYLE

 SetWindowLong Hwnd,GWL_STYLE, lStyle And Not WS_SYSMENU 

If I removed the caption and then changed the client area on WM_NCCALCSIZE that would alow me to alocate some space for the nonclient caption that I need to draw! I really think this could work... I'm already modifying the client area a little as it is in 

... WM_NCCALCSIZE

SetWindowLong(Handle, GWL_STYLE, GetWindowLong(Handle, GWL_STYLE) and (not 

WS_CAPTION) or WS_THICKFRAME)

private { Private declarations } FDownButton: TRect

FUpButton: TRect

FCloseButton: TRect

FYCaption, FXTtlBit, FYTtlBit: Integer

const BTN_TOP = 10

const htCloseBtn = htSizeLast + 100 htDropBtn = htSizeLast + 101 htCloseUpBtn = htSizeLast + 102

 : Procedure DrawTitleButton 

FXTtlBit=GetSystemMetrics(SM_CXSIZE)'Button Width

FYTtlBit=GetSystemMetrics(SM_CYSIZE) 'Button Height

(FYCaption=GetSystemMetrics(SM_CYCAPTION

Caption Height'

FCloseButton=Width-FXTtlBit-5,BTN_TOP,FXTtlBit,FYTtlBit

FDownButton=Width-(2 * FXTtlBit)-3

(BTN_TOP,FXTtlBit,FYTtlBit,

FUpButton=Width-(3 * FXTtlBit)-1

(BTN_TOP,FXTtlBit,FYTtlBit,

GetWindowDc 

FillRect 

: Message WM_NCACTIVATE 

DrawTitleButton

 

 :Message WM_NCHITTEST 

if PtInRect(FCloseButton,Point(XPos- Left,YPos-Top)) then

DrawTitleButton

Result=htCloseBtn

End if 

if PtInRect(FDownButton,Point(XPos-Left,YPos-Top)) then

DrawTitleButton

Result=htDropBtn

End If 

if PtInRect(FUpButton,Point(XPos-Left, YPos-Top)) then

DrawTitleButton

Result=htCloseUpBtn

End if

 : Message WM_NCLBUTTONDOWN 

if (Msg.HitTest=htCloseBtn) then

DrawTitleButton

End if 

if (Msg.HitTest=htDropBtn) then

DrawTitleButton

End if 

if (Msg.HitTest=htCloseUpBtn) then

DrawTitleButton

End if 

 : Procedure FoldDown 

if ClientHeight=0 then ClientHeight= 100

: Procedure FoldUp 

if ClientHeight > 0 then ClientHeight= 0

 : Message WM_NCLBUTTONUP 

wParam'

The hit-test value returned by the' 

DefWindowProc function as a result 'of processing the'

WM_NCHITTEST message. For a list 'of hit-test values 

see WM_NCHITTEST'

lParam'

A POINTS structure that contains the x-'and coordinates of the cursor. The 'coordinates are relative'to the upper-left 'corner of the screen'

if (Msg.HitTest=htCloseBtn) then 

Hide

End if

if (Msg.HitTest=htDropBtn) then FoldDown

End if

if (Msg.HitTest=htCloseUpBtn) then FoldUp

End if

 : Message WM_NCPAINT 

DrawTitleButton

Draw your custom buttons where the caption would normally place them. Position doesn't matter. In the WM_COMMANDsection of your callback, use ShowWindow(hwnd, SW_MAXIMIZE) and ShowWindow(hwnd, SW_RESTORE). That's all there is to it.

Custom Button

1) Do not use BeginPaint/EndPaint in WM_ERASEBKGND. Move that code in a WM_PAINT handler.

2) Use SetWindowLong and the GWL_USERDATA index for storing the button state (UP or DOWN) and use GetWindowLong for retrieving the current state.

3) Use SetCapture for capturing the mouse, starting with WM_LBUTTONDOWN. Update the state of the button (UP or DOWN) according to mouse position

4) Use RedrawWindow when you need painting to occur

---

SubClassEditControl


 replace the old window procedure with our new one'

oldproc=SetWindowLong(hwnd,GWL_WNDPROC,Address 

(Of 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 Or SWP_NOMOVE Or SWP_NOSIZE Or SWP_NOACTIVATE Or SWP_NOZORDER


 get the button state structure'

, InsBut *pbut = (InsBut *)GetWindowLong(hwnd

(GWL_USERDATA

case WM_NCPAINT
let the old window procedure draw the borders / other' 

non-client // bits-and-pieces for us.'

CallWindowProc oldproc,hwnd,msg, wParam, lParam

get the screen coordinates of the window. // adjust '

the coordinates so they start from 0,0

GetWindowRect hwnd,Wrect
OffsetRect Wrect, -Wrect.left,-Wrect.top

BM_SETIMAGE = 247
BST_UNCHECKED = 0
BST_CHECKED = 1
BST_INDETERMINATE = 2
BST_PUSHED = 4
BST_FOCUS = 8  ' KeyBoard Focus

SetWindowLongPtr hwnd,GWL_USERDATA,0

Button Menu

docs.appendmenua

(SubclassWindow(hWnd

Somewhere in WM_INITDIALOG handler 

(btnMenu =GetDlgItem(IDC_BTN_ABOUT

("btnMenu.AddMenuItem(IDC_MNU_ONE,"Windows

("btnMenu.AddMenuItem(IDC_MNU_TWO,"Template

(btnMenu.AddMenuItem(IDC_MNU_THREE,"",MF_SEPARATOR

("btnMenu.AddMenuItem(IDC_MNU_FOUR,"Library

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

---

CLIENTRECT

RECT rWindow

RECT rClient

HRGN hRgnWindow

HRGN hRgnClient

HRGN hNCRgn

Get the window and client rectangles for the window.'

GetWindowRect hWnd,rWindow

GetClientRect hWnd,rClient

Translate the Client rectangle into screen coordinates.'

{POINT pt = {0,0

MapWindowPoints hWnd,0,pt1

OffsetRect rClient,pt.x,pt.y

Create regions from these two rectangles'

(hRgnWindow=CreateRectRgnIndirect(rWindow

(hRgnClient=CreateRectRgnIndirect(rClient

(hNCRgn =CreateRectRgn(0,0,0,0

Subtract the client region from the window region'

,CombineRgn hNCRgn,hWindowRgn,

(hClientRgn,RGN_DIFF

Perform actions on the NC region'

'Free region resources

DeleteObject hRgnWindow

DeleteObject hRgnClient

DeleteObject hNCRgn

PAINT-BUTTON

احتملا Rec   در پیام WMPAINT باید Global یا Static تعیین شود.  تست نشده ولی روال بدین شکل است .

Private Pressed As Boolean

Private FocusLost As Boolean

Private TRect As RECT

Border3D_Y, Border_Thickness, Btn_Width,Button_Width, Button_Height

(GetWindowDC(FrmMainForm.Handle

(Border3D_Y=GetSystemMetrics(SM_CYEDGE

(Border_Thickness=GetSystemMetrics(SM_CYSIZEFRAME

(Button_Width=GetSystemMetrics(SM_CXSIZE

(Button_Height=GetSystemMetrics(SM_CYSIZE

Btn_Width=Border3D_Y+Border_Thickness+Button_Height-(2 * Border3D_Y) - 1

*Rec.Left=FrmMainForm.Width-(3 

(Button_Width+Btn_Width

+Rec.Right=FrmMainForm.Width - (3 * Button_Width 

(03

Rec.Top=Border3D_Y+Border_Thickness -1

*Rec.Bottom=Rec.Top+Button_Height - (2 

(Border3D_Y

FillRect 

(MyCanvas.Handle,Rec,HBRUSH(COLOR_BTNFACE+1

If not Pressed or Focuslost Then

    DrawEdge MyCanvas.Handle, Rec, EDGE_RAISED,BF_SOFT or BF_RECT

  Else If Pressed and Not Focuslost Then

    DrawEdge MyCanvas.Handle, Rec, EDGE_SUNKEN, BF_SOFT or BF_RECT

DrawIconEX MyCanvas.Handle,Rec.Left+4,Rec.Top+3,Application.Icon.Handle,8, 8, 0, 0, DI_NORMAL

WMNCACTIVATE
(InvalidateRect FrmMainForm.Handle, Rec, True
 

WMNCPAINT
InvalidateRect FrmMainForm.Handle, Rec, True


WMNCMOUSEDOWN

PT1.X=Loword(LParam)- FrmMainForm.Left
PT1.Y=Hiword(LParam)- FrmMainForm.Top
 
  if PTInRect(Rec,PT1.x,PT1.y) Then
      Pressed=True
      FocusLost=False
   InvalidateRect FrmMainForm.Handle, Rec,True
 SetCapture TWinControl(FrmMainForm).Handle
End If


WMLBUTTONUP

  Tmp  Boolean
 
 ReleaseCapture
  Tmp=Pressed
  Pressed=False
  if Tmp and PTInRect(Rec, PT1.x,PT1.y) Then
 
    InvalidateRect FrmMainForm.Handle, Rec,True
   

WMNCHITTEST

  Tmp : Boolean

  if Pressed then
      Tmp=FocusLost
 End if
   
PT1.X=Loword(LParam)- FrmMainForm.Left
PT1.Y=Hiword(LParam)- FrmMainForm.Top
   
   if PTInRect(Rec, PT1.x,PT1.y) then
      FocusLost=False
   else
      FocusLost=True
  End if

    if FocusLost =Tmp then
      InvalidateRect FrmMainForm.Handle, Rec,True
  End If 

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_CYSIZEFRAME =    SM_CYFRAME
            SM_CXSIZEFRAME =    SM_CXFRAME

SM_CXFRAME = 32
SM_CYFRAME = 33

SM_CXEDGE = 45
SM_CYEDGE = 46

ساب کلاس کردن

Option Compare Database

Public WinProcOld As LongPtr

(Public Function SubClassWnd(hwnd As LongPtr

   ( WinProcOld = SetWindowLongPtr(hwnd, GWL_WNDPROC, AddressOf WindProc

End Function

(Public Function UnSubclassWnd(hwnd As LongPtr

    SetWindowLongPtr hwnd, GWL_WNDPROC, WinProcOld

    WinProcOld = 0

End Function

'This is your subclassed window procedure

Public Function WindProc(ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr

    'WM_COMMAND message is sent to parent window to notify of a button click

    'The lParam parameter tells the hWnd of the button

   'If wMsg = WM_CTLCOLORBTN Then WindProc = CreateSolidBrush(RGB(0, 0, 10))

    If wMsg = WM_COMMAND Then

         If lParam = GetDlgItem(hwnd, 4) Then MsgBox "Button was clicked!"

         If lParam = GetDlgItem(hwnd, 1) Then MsgBox "Button was clicked!"

    End If

    If wMsg = WM_DESTROY Then

      UnSubclassWnd hwnd

    End If

      WindProc = CallWindowProc(WinProcOld, hwnd, wMsg, wParam, ByVal lParam)

End Functionc

Balloon Tooltips

(TTM_TRACKACTIVATE=(&H400+17

(TTM_TRACKPOSITION=(&H400+18

(TTM_ACTIVATE=(&H400+1

CW_USEDEFAULT = &80000000
        TTM_ADDTOOL = &404
        TTM_TRACKACTIVATE = &411
        TTM_UPDATETIPTEXT = &40C
        TTS_BALLOON = 64
        TTS_ALWAYSTIP = 1
        TTS_NOPREFIX = 2
 
        WS_POPUP = &80000000

TTF_RTLREADING=&H4

TTF_TRACK=&H20

TTF_CENTERTIP=&H2

TTF_SUBCLASS=&H10

TTF_TRANSPARENT=&H100

TTF_ABSOLUTE=&H80

Type TOOLINFOA

cbSize As Long

uFlags As Long

hwnd As Long

uId As Long

rect As RECT

hinst As Long

lpszText As String

End Type

 : uFlags
TTF_CENTERTIP
TTF_RTLREADING
TTF_SUBCLASS
TTF_TRACK

---

TTM_TRACKACTIVATE message
wParam : True(Activate tracking) /False(Deactivate

 tracking)

lParam
Pointer to a TOOLINFO structure that identifies the tool to which this message applies. The hwnd and uId members identify the tool, and the cbSize member specifies the size of the structure. All other 

.members are ignored

---

TTM_TRACKPOSITION message

.Sets the position of a tracking tooltip

wParam

.Must be zero

lParam

The LOWORD specifies the x-coordinate of the point at which the tracking tooltip will be displayed, in screen coordinates. The HIWORD specifies the y-coordinate of the point at which the tracking tooltip will 

.be  displayed, in screen coordinates

---

To have tooltip windows displayed at specific coordinates, include th TTF_ABSOLUTE flag in the uFlagsmember of the TOOLINFO 

.structure .when  adding the tool

WM_CREAT

g_hwndTT =CreateWindow(TOOLTIPS_CLASS,NULL, WS_POPUP Or TTS_ALWAYSTIP Or 

(TTS_BALLOON,0,0,0,0,hWnd,0,0,0
if not g_hwndTT  Then
MessageBeep(0) ' just to signal error somehow
(g_ti.cbSize =Len(TOOLINFO
g_ti.uFlags=TTF_TRACK Or TTF_ABSOLUTE
g_ti.hwnd=hWnd
"g_ti.lpszText="Hi there
(if( ! SendMessage(g_hwndTT, TTM_ADDTOOL,0, g_ti) )

MessageBeep(0) ' just to have some error signal 'subclass edit control
SetWindowSubclass  hEdit, EditSubProc, 0, 0
return 0



,EditSubProc ( HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam, UINT_PTR 

(uIdSubclass, DWORD_PTR dwRefData 

Select Case  message
case WM_CHAR
!if not isdigit( wParam ) ' if not a number pop a tooltip
Dim ebt As EDITBALLOONTIP
(ebt.cbStruct = Len(EDITBALLOONTIP

"!ebt.pszText =" Tooltip text
"!!!ebt.pszTitle =" Tooltip title
ebt.ttiIcon =TTI_ERROR_LARGE 'tooltip icon
(SendMessage(hwnd, EM_SHOWBALLOONTIP, 0,ebt

return FALSE
else
(SendMessage(hwnd, EM_HIDEBALLOONTIP,0,0
,return DefSubclassProc( hwnd, message, wParam,

(lParam 

tooltip-for-button

---

Private Type TOldWndProc
    hwnd As Long
    lPrevWndProc As Long
End Type

Private WndProc() As TOldWndProc
Private NumTips As Long
Const iOffset = 8
Const FontType = "Tahoma" & vbNullChar
Const FontSize = 13

Private Function CustomTipProc(ByVal hwnd As Long, ByVal uiMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long


Case WM_PAINT
          Get the Current Window Rect'
        GetWindowRect hwnd, rc
        GetCursorPos CurPos
        rc.Right = CurPos.x - iOffset + 6 + rc.Right - rc.Left
        rc.Bottom = CurPos.y + 20 + rc.Bottom - rc.Top
        rc.Left = CurPos.x - iOffset + 6
        rc.Top = CurPos.y + 20
        MoveWindow hwnd, rc.Left, rc.Top, rc.Right - rc.Left, rc.Bottom - rc.Top, False
BeginPaint hwnd, ps
  .
.
.

ToolTip_DrawBalloon hwnd, ps.hdc, lpszText
EndPaint hwnd, ps
CustomTipProc = 0


Case Else
        ' Sends message to previous procedure
        For i = 0 To NumTips - 1
            If WndProc(i).hwnd = hwnd Then
                CustomTipProc = CallWindowProc(WndProc(i).lPrevWndProc, hwnd, uiMsg, _
                    wParam, lParam)
                Exit For
            End If
        Next
    End Select
End Function


,Private Sub ToolTip_DrawBalloon(hwndTip As Long,

(hdc As Long, lpszText As String
    Dim rc As RECT
    Dim hRgn, hrgn1, hrgn2 As Long
    Dim pts(0 To 2) As POINTAPI

    GetClientRect hwndTip, rc
    pts(0).x = rc.Left + iOffset
    pts(0).y = rc.Top
    pts(1).x = pts(0).x
    pts(1).y = pts(0).y + iOffset
    pts(2).x = pts(1).x + iOffset
    pts(2).y = pts(1).y
    hRgn = CreateRectRgn(0, 0, 0, 0)
    ' Create the rounded box
    hrgn1 = CreateRoundRectRgn(rc.Left, rc.Top + iOffset, rc.Right, rc.Bottom, 15, 15)
    ' Create the arrow
    hrgn2 = CreatePolygonRgn(pts(0), 3, ALTERNATE)
    ' combine the two regions
    CombineRgn hRgn, hrgn1, hrgn2, RGN_OR
    ' Fill the Region with the Standard BackColor of the ToolTip Window
    FillRgn hdc, hRgn, GetSysColorBrush(COLOR_INFOBK

    Draw the Frame Region'
    FrameRgn hdc, hRgn, GetStockObject(DKGRAY_BRUSH), 1, 1
    rc.Top = rc.Top + iOffset * 2
    rc.Bottom = rc.Bottom - iOffset
    rc.Left = rc.Left + iOffset
    rc.Right = rc.Right - iOffset
    ' Draw the Shadow Text
    SetTextColor hdc, GetSysColor(COLOR_3DLIGHT)
    DrawText hdc, lpszText, Len(lpszText), rc, DT_VCENTER + DT_NOCLIP
    rc.Left = rc.Left - 1
    rc.Top = rc.Top - 1
    ' Draw the Text
    SetTextColor hdc, GetSysColor(COLOR_INFOTEXT)
    DrawText hdc, lpszText, Len(lpszText), rc, DT_VCENTER + DT_NOCLIP
End Sub

Public Sub AddCustomToolTip(x As Object, ToolTipText As String, FormOwner As Form)
    Dim ti As TOOLINFO
    Dim dwStyle As Long
    Dim hTip As Long

      A tooltip control with the TTS_ALWAYSTIP style 

appears when the cursor is on a tool, regardless of whether the tooltip control's owner window is active or inactive. Without this style, the tooltip control appears when the tool's  owner window is active, but not when it 

.is inactive

    hTip=CreateWindowEx(0&, "tooltips_class32", "", TTS_ALWAYSTIP, CW_USEDEFAULT,CW_USEDEFAULT, CW_USEDEFAULT, 

(CW_USEDEFAULT, FormOwner.hwnd,0,0,0

     (ti.cbSize = Len(ti

    ti.uFlags =TTF_IDISHWND +TTF_SUBCLASS
    ti.hwnd = x.hwnd
    ti.uId = x.hwnd
    ti.lpszText = ToolTipText

    SendMessage hTip,TTM_ADDTOOL,0,ti

    ' SubClass the tooltip window
     (ReDim Preserve WndProc(NumTips
    WndProc(NumTips).lPrevWndProc = SetWindowLong(hTip,GWL_WNDPROC, AddressOf 

(CustomTipProc
    WndProc(NumTips).hwnd=hTip
    NumTips = NumTips + 1
    Remove Border from ToolTip'

     (dwStyle = GetWindowLong(hTip, GWL_STYLE
     (dwStyle = dwStyle And (Not WS_BORDER
    SetWindowLong hTip, GWL_STYLE, dwStyle
End Sub

()Private Sub Form_Load
  AddCustomToolTip Command2, "This is another" & vbCrLf & "custom ToolTip", Form1
AddCustomToolTip Command3, "Hi! I'm a Tip", Form1
AddCustomToolTip Text1, "TextBox ToolTip", Form1
End Sub

ارسال پیام به ToolTips 

SendMessage (HWND)ToolTipCtrl,TTM_SETTITLE(adds a standard 

--icon and title string to a ToolTip),(WPARAM) tti_ICON  [TTI_NONE = 0 - no icon] [TTI_INFO = 1 - information icon] [TTI_WARNING = 2 - warning icon] [TTI_ERROR = 3 - error icon],(LPARAM) (LPCTSTR) title

تایمر بستن پنجره با کلاس 32770#

بسته شدن پنجره زمانیکه کپشن به عدد 10 رسید.

 : 64BIT

Declare PtrSafe Function SetTimer Lib "user32" Alias "SetTimer" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr

Declare PtrSafe Function KillTimer Lib "user32" Alias "KillTimer" (ByVal hwnd As LongPtr, ByVal nIDEvent As LongPtr) As Long

Private Const TIMER1 = 1001

SetTimer hWndMainWnd,TIMER1,1000,0

(WndProc(HWND hWnd,UINT uMsg,WPARAM 

Static xtimer

    Select Case uMsg

      xtimer=xtimer+1

    case WM_TIMER

        if wParam = TIMER1

          SetWindowTextA hwnd, xtimer

           If xtimer = 10 Then SendMessageA hwnd, WM_CLOSE, 0, 0: xtimer = 0

        End if 

عدم نمایش شورتکات در ادیت کنترل در ساب کلاس کردن  Case WM_CONTEXTMENU 

            Exit Function

    Case WM_DESTROY, WM_NCDESTROY

          KillTimer hwnd, TIMER1

          xtimer = 0

Source

Source

مورد بالا تست شده و طبق منبع اعمال گردیده

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

آیدی کنترل های InputBox

ارسال تکست به کپشن پنجره در صورت فشردن باتن Ok در صورتیکه تعداد کاراکتر داخل کنترل ادیت  بیشتر از 13 باشد

 Edit Control Notification Codes'

EN_SETFOCUS=&H100

EN_KILLFOCUS=&H200

---

EN_CHANGE=&H300

Parameters

wParam

The LOWORD contains the identifier of the edit control

.The HIWORD specifies the notification code

lParam

A handle to the edit control

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

the EM_SETEVENTMASKmessage 

(SendMessageA hwndEdit,EM_SETEVENTMASK,0,ENM_CHANGE)

EM_SETEVENTMASK message
Private Const EM_SETEVENTMASK As Integer = 1073

ENM_NONE = 0
ENM_CHANGE = 1
ENM_UPDATE = 2

Parameters

wParam

.This parameter is not used; it must be zero

lParam

New event mask for the rich edit control. For a list of 

.event masks, see Rich Edit Control Event Mask Flags

Return value

.This message returns the previous event mask

Remarks

The default event mask (before any is set) is 

.ENM_NONE

---

EN_UPDATE=&H400

EN_ERRSPACE=&H500

EN_MAXTEXT=&H501

WndProc

Case WM_COMMAND

    Case 1

(InputDataLen=SendDlgItemMessage(hwnd,EM_LINELENGTH,0,0

if InputDataLen>14 Then 

"....SetWindowTextA hwnd,"Exceed Data

Sleep 1000

End If 

Case 2

Case 4900

End Select 

این پیام هنگامی ارسال میشود که یوزر اقدام به تغییر متن در کنترل EDIT کرده است. ( منظور پیام EN_CHANGE )

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

نمایش بالن راهنما در EDIT CONTROL

EM_SHOWBALLOONTIP

displays a balloon tip associated with an edit control

Parameters

 : wParam

Not used; must be zero

lParam

این پارامتر یک نشانگر به ساختار EDITBALLONTIP ( ممبر یا عضوهای ساختار در ادامه آمده ) که حاوی اطلاعات درباره ی بالن راهنمای جهت نمایش است .

A pointer to an EDITBALLOONTIP structure that contains information about the balloon tip to display.



Type EDITBALLOONTIP
cbStruct As Long
pszTitle As String
pszText As String
ttiIcon As Integer
End Type

ttiIcon

TTI_ERROR  Use the error icon
TTI_INFOUse the information icon
TTI_NONEUse no icon
TTI_WARNINGUse the warning icon

Tooltip iconsconst
TTI_NONE = 0
TTI_INFO = 1
TTI_WARNING = 2
TTI_ERROR = 3
TTI_INFO_LARGE = 4
TTI_WARNING_LARGE = 5
TTI_ERROR_LARGE = 6

• عدم ظهور BALLOONTIP یا بالن راهنما در Subclass کردن EDIT CONTROL

Function NoBalloonWndProc(ByVal hwnd As Long,ByVal uMsg As Long,ByVal wParam As 

(Long,Byval lParam As Long

Select Case uMsg

  case EM_SHOWBALLOONTIP

     NoBalloonWndProc=FALSE

End Select 

NoBalloonWndProc=CallWindowProc(g_Edit,hwnd,uMsg,wParam,lParam

(

تنظیم نشانه ی متن در EDIT CONTROL

ارسال توسط تابع SendMessageA  : 

SendMessageA hwndEdit,EM_SETCUEBANNER,0,ByVal 

"User Name" 

ECM_FIRST =&H1500 

The following messages need Unicode strings

(EM_SETCUEBANNER=(ECM_FIRST + 1

(EM_GETCUEBANNER=(ECM_FIRST + 2

(EM_SHOWBALLOONTIP=(ECM_FIRST + 3

(EM_HIDEBALLOONTIP=(ECM_FIRST + 4

EM_SETHILITE=(ECM_FIRST+5);>=Vista, not documented

EM_GETHILITE=(ECM_FIRST+6);>=Vista, not documented

EM_SETCUEBANNER

Parameters

 : wParam

اگر این پارامتر در تابع بالا  غیرصفر باشدحتی اگر فوکس بگیرد نمایش داده میشود اگر صفر باشد زمانی که در آن ( ادیت کنترل) کلیک شود(  نشانه ی متن ) محو میشود.

TRUE if the cue banner should show even when the edit control has focus; otherwise, FALSE. FALSE is the default behavior the cue banner disappears when the 

.user clicks in the control

  : lParam

A pointer to a Unicode string that contains the text to 

.display as the textual cue

دراکسس در قسمت پراپرتی Format تکست باکس @ و بعد SemiColon و تکست موردنظر در داخل دابل کوتیشن ها 

تنظیم رنگ پس زمینه ی EDIT CONTROL

EM_SETBKGNDCOLOR

The EM_SETBKGNDCOLOR message sets the background color for a rich edit control.

wParam

Specifies whether to use the system color. If this parameter is a nonzero value, the background is set to the window background system color. Otherwise, the 

.background is set to the specified color

lParam

A COLORREF structure specifying the color if wParam 

.is zero. To generate a COLORREF, use the RGB macro

تنظیم حاشیه ها در EDIT CONTROL

: wParam 

EC_LEFTMARGIN

EC_RIGHTMARGIN

 : lParam

The LOWORD specifies the new width of the left margin, in pixels. This value is ignored if wParam does not include EC_LEFTMARGIN

The HIWORD specifies the new width of the right margin, in pixels. This value is ignored if wParam does not include EC_RIGHTMARGIN.

EM_SETRECT

wParam

.parameter is not used and must be zero

lParam

A pointer to a RECT structure that specifies the new dimensions of the rectangle. If this parameter is NULL, 

.the formatting rectangle is set to its default values

RECT rc

'Get the current control rectangle

(SendMessage(hWndRichEdit,EM_GETRECT,0,ByVal rc

rc.left += 20 'increase the left margin

rc.top += 20 'increase the top margin

rc.right -= 20 'decrease the right margin

rc.bottom -= 20 'decrease the bottom margin (rectangle) ' Set the rectangle

(SendMessage(hWndRichEdit,EM_SETRECT,0,ByVal rc

EM-SETMARGINS

WM_CTLCOLORDLG

win32api/reference/Message/WM_CTLCOLORDLG.htm

WM_CTLCOLORDLG
Static wBrush
If wBrush<>0 Then
(hBM=LoadImage(0,"tile.bmp",0,0,0,0x2010
(wBrush=CreatePatternBrush(hBM

Function=wBrush

FrameRect

Const SM_CXFRAME=32

Const SM_CYFRAME=33

Const SM_CYSIZE 31

The height of a button in a window caption or title bar' 

.in pixels

framerect

setrect

fillrect

()Sub Button2_on 

Dim fWidth As Long

Dim fHeight As Long

Dim RndCol As Long

Dim hBrush As Long 

Dim Ret As Long

fWidth=GetSystemMetrics(SM_CXFRAME)*2

(fHeight=GetSystemMetrics(SM_CYFRAME)*2+GetSystemMetrics(SM_CYSIZE

-Ret=SetRect(rct,5,5,GetWidth-fWidth-5, GetHeight

(fHeight-5

hBrush=CreateHatchBrush (HS_DIAGCROSS, vbBlue) 'Draw with blue DIAGCROSS for VB

(Ret=FrameRect(hfDC,rct,hBrush

(Ret=DeleteObject(hWhiteBrush

End Sub

WM_LBUTTONDOWN

using-brushes

case WM_LBUTTONDOWN

Store the mouse coordinates in a POINT structure'

ptlHit=MAKEPOINTS((POINTS FAR *)lParam

Create a rectangular region with dimensions and' 

coordinates that correspond to those of the grid 

window

,hrgnCell=CreateRectRgn(rctGrid.left, rctGrid.top

(rctGrid.right, rctGrid.bottom

Retrieve a window DC for the grid window'

(hdc=GetWindowDC(hwndGrid

Select the region into the DC'

(SelectObject(hdc, hrgnCell

Test for a button click in the grid-window rectangle'

if (PtInRegion(hrgnCell, ptlHit.x, ptlHit.y)) Then

CreateHatchBrush/ CreatePatternBrush

hatch-brush

((hBrush=CreateSolidBrush (RGB(0, 0, 255

Associate the brush with the display device context'

SelectObject  hdc, hBrush

Draw a rectangle with blue background'

Rectangle hdc, 400,40,800,400

Create a hatch brush that draws horizontal red line'

,hBrush=CreateHatchBrush(HatchStyleHorizontal

((RGB(255, 0, 0

Set the background color to yellow'

(SetBkColor hdc, RGB(255, 255, 0

createpatternbrush

HBRUSH (CreatePatternBrush ( HBITMAP hbm

برگرفته از فروم های خارجی 

 Hatch Styles'

HS_HORIZONTAL= 0

HS_VERTICAL= 1

HS_FDIAGONAL= 2

HS_BDIAGONAL =3

HS_CROSS =4

HS_DIAGCROSS =5

()Sub OnPaint

Dim Brush

CreatePatternBrush 

(Brush,HS_HORIZONTAL,RGB(232,166,153

Dim ps As PAINTSTRUCT

Dim rct As RECT

GetClientRect hwnd,rct

(dc=BeginPaint(hwnd,ps

SelectObject dc,Brush

Rectangle hdc,left,top,right,bottom'

Rectangle dc,rct?

(SetBkColor dc,RGB(232,166,153

DrawText dc,"Brush Demo",10,rct,DT_CENTER Or DT_VCENTER Or DT_SINGLELINE

EndPaint hwnd,ps

Private hbr

(Function CreatePatternBrushFromFile(pszFile

hbr=0

(hbm=LoadImage(0,pszFile,IMAGE_BITMAP,0,0,LR_LOADFROMFILE

if (hbm) Then 

(hbr=CreatePatternBrush(hbm

DeleteObject hbm

End if

CreatePatternBrushFromFile=hbr

End Function

Function PaintContent(ByVal hwnd As Long,ByRef pps As 

(PAINTSTRUCT  

BeginPath pps.hdc

Ellipse pps.hdc,0,0,200,100

EndPath pps.hdc

(hbrOld=SelectObject(pps.hdc,hbr

FillPath pps.hdc

SelectObject pps.hdc,hbrOld

End Function

---

SWP_NOSIZE = 0x0001

SWP_NOMOVE = 0x0002

SWP_NOZORDER = 0x0004

SWP_FRAMECHANGED = 0x0020

SWP_SHOWWINDOW = 0x0040

(GWL_STYLE = (-16

'Window Style 

WS_CLIPCHILDREN=0x02000000

WS_CLIPSIBLINGS=0x04000000

hBrush=CreateHatchBrush(HS_DIAGCROSS,ColorTranslator.ToWin32(Color.Red)

,SetWindowSubclass(textBox1.Handle

(AddressOf WindowSubClass,0,0

SetWindowPos(textBox1.Handle,0,0,0, 200,40,SWP_NOZORDER Or SWP_NOMOVE Or 

(SWP_SHOWWINDOW Or SWP_FRAMECHANGED

For main form resizing long'

(nStyle = GetWindowLong(this.Handle, GWL_STYLE

SetWindowLong(this.Handle,GWL_STYLE, nStyle And 

(WS_CLIPCHILDREN

,WindowSubClass(hWnd,uMsg,wParam

(lParam,uIdSubclass,dwRefData

Select Case  uMsg

Case WM_NCPAINT

(hDC=GetWindowDC(hWnd

Dim rct As RECT 

()rect = new RECT'

(GetClientRect(hWnd, out rect

rct.right += 20 * 2

rct.bottom += 20 * 2

if  hBrush<>0 Then 

FillRect hDC,rct,hBrush

ReleaseDC hWnd, hDC

Exit Function

case WM_NCCALCSIZE

if (wParam == (IntPtr)0'

Dim pRect As RECT

,pRect =(RECT)Marshal.PtrToStructure(lParam'

((typeof(RECT'

(Call CopyMemory(VarPtr(rct)+4,ByVal lParam+4,4

pRect.left += 10

pRect.top += 10

pRect.bottom -= 10

pRect.right -= 10

(Marshal.StructureToPtr(pRect, lParam,false'

(Call CopyMemory(lparam,VarPtr(rct),4

Exit Function

End Select

DefSubclassProc(hWnd, uMsg, wParam, lParam)

EDIT CONTROL اعلان ( Notification) / محدودیت تکست / ارسال تکست Edit به کپشن پنجره اصلی

EN_CHANGE 

wParam

The LOWORD contains the identifier of the edit control. The HIWORD specifies the notification code.

lParam

A handle to the edit control.

'  Edit styles const'

ES_LEFT = 0x0000

ES_CENTER = 0x0001

ES_RIGHT = 0x0002

ES_MULTILINE = 0x0004

ES_UPPERCASE = 0x0008

ES_LOWERCASE = 0x0010

ES_PASSWORD = 0x0020

ES_AUTOVSCROLL = 0x0040

ES_AUTOHSCROLL = 0x0080

ES_NOHIDESEL = 0x0100

ES_OEMCONVERT = 0x0400

ES_READONLY = 0x0800

ES_WANTRETURN = 0x1000

ES_NUMBER = 0x2000

  Edit notifications const' 

EN_SETFOCUS = 0x0100

EN_KILLFOCUS = 0x0200

EN_CHANGE = 0x0300

EN_UPDATE = 0x0400

EN_ERRSPACE = 0x0500

EN_MAXTEXT = 0x0501

EN_HSCROLL = 0x0601 

EN_VSCROLL = 0x0602

EN_ALIGN_LTR_EC = 0x0700

EN_ALIGN_RTL_EC = 0x0701

  Edit messages const'

EM_GETSEL = 0x00B0

EM_SETSEL = 0x00B1

EM_GETRECT = 0x00B2

EM_SETRECT = 0x00B3

EM_SETRECTNP = 0x00B4

EM_SCROLL = 0x00B5

EM_LINESCROLL = 0x00B6

EM_SCROLLCARET = 0x00B7

EM_GETMODIFY = 0x00B8

EM_SETMODIFY = 0x00B9

EM_GETLINECOUNT = 0x00BA

EM_LINEINDEX = 0x00BB

EM_SETHANDLE = 0x00BC

EM_GETHANDLE = 0x00BD

EM_GETTHUMB = 0x00BE

EM_LINELENGTH = 0x00C1

EM_REPLACESEL = 0x00C2

EM_GETLINE = 0x00C4

EM_LIMITTEXT = 0x00C5

EM_CANUNDO = 0x00C6

EM_UNDO = 0x00C7

EM_FMTLINES = 0x00C8

EM_LINEFROMCHAR = 0x00C9

EM_SETTABSTOPS = 0x00CB EM_SETPASSWORDCHAR = 0x00CC EM_EMPTYUNDOBUFFER = 0x00CD EM_GETFIRSTVISIBLELINE = 0x00CE EM_SETREADONLY = 0x00CF EM_SETWORDBREAKPROC = 0x00D0 EM_GETWORDBREAKPROC = 0x00D1 EM_GETPASSWORDCHAR = 0x00D2 EM_SETMARGINS = 0x00D3

EM_GETMARGINS = 0x00D4

EM_SETLIMITTEXT = EM_LIMITTEXT EM_GETLIMITTEXT = 0x00D5

EM_POSFROMCHAR = 0x00D6

EM_CHARFROMPOS = 0x00D7

EM_SETIMESTATUS = 0x00D8

EM_GETIMESTATUS = 0x00D9

EM_SETCUEBANNER = 0x1501

EM_GETCUEBANNER = 0x1502

EM_LIMITTEXT message 

.Sets the text limit of an edit control

wParam

The maximum number of TCHARs the user can enter. For ANSI text, this is the number of bytes; for Unicode text, this is the number of characters. This number does

.  not include the terminating null character

lParam

.This parameter is not used

) LRESULT WINAPI SendDlgItemMessage
_In_ HWND   hDlg,
_In_ int    nIDDlgItem,
_In_ UINT   Msg,
_In_ WPARAM wParam,
_In_ LPARAM lParam
;(

در InputBox  زیر با کلاس 32770#  که تست شده  در کنترل Edit آن با آیدی 4900 نمی توان بیشتر از 10 کاراکتر واردنمود

Case WM_SHOWWINDOW     

          SendDlgItemMessageA hwnd, 4900, EM_LIMITTEXT, 0, 10