vb Uses Unicode for text string so use SendMessageW instead Of SendMessageA Function
The list box has the LBS_OWNERDRAWFIXED and LBS_HASSTRINGS styles, in addition to the standard list box styles.
LBS_HASSTRINGS
LB_GETTEXT
The return value is the length of the string, in TCHARs, excluding the terminating
(null character ( hence buff+1
If the list box has an owner-drawn style but not the LBS_HASSTRINGS style, the buffer pointed to by the lParam parameter receives the value associated with the item the item data
Means Use Byval
If the list box has WS_HSCROLL style and you insert a string wider than the list box, send an LB_SETHORIZONTALEXTENT message to ensure the horizontal scroll bar appears.
Case WM_MEASUREITEM
Case WM_DRAWITEM
Dim pdis As DRAWITEMSTRUCT
Dim tm As TEXTMETRIC
Dim hDCMem As LongPtr
CopyMemory pdis, ByVal lParam, 40
Select Case pdis.itemAction
Case ODA_SELECT, ODA_DRAWENTIRE
Dim p As RECT
GetClientRect pdis.hwndItem, pdis.rcitem
BitBlt pdis.hdc
SetBkMode pdis.hdc, 0
SetTextColor pdis.hdc, vbRed
TextOutA pdis.hdc, pdis.rcitem.Left,pdis.rcitem.Top, buffer$, 5
CopyMemory lParam, pdis,40
End Select
گرفتن تعداد آیتم ها در لیست باکس
LB_GETCOUNT message
Gets the number of items in a list box
wParam,lParam
Not used; must be zero
Dim index As Integer
Dim textBuff As String
(textBuff = Space(255
(NumItems=SendMessage(hWndList,LB_GETCOUNT,0,0
index use GETCURSEL'
Gets the index of the currently selected item)'
(if any, in a single-selection list box'
SendMessageW hWndList, LB_GETTEXT,index, textBuff
MsgBox textBuff
docs.microsoft.com/enmeasureitemstruct
مثالی از کشیدن نقطه چین دور آیتم سلکت شده به زبان دیگر
if lpdis->itemState & ODS_SELECTED
* Set RECT coordinates to surround only the'
* bitmap.
rcBitmap.left=lpdis->rcItem.left
rcBitmap.top=lpdis->rcItem.top
rcBitmap.right=lpdis->rcItem.left+XBITMAP
rcBitmap.bottom=lpdis->rcItem.top + YBITMAP
* Draw a rectangle around bitmap to indicate'
* the selection.
DrawFocusRect lpdis->hDC, &rcBitmap
استفاده در مثال شکل بالا به زبان دیگر
Display the text associated with the item'
SendMessage lpdis->hwndItem
LB_GETTEXT,lpdis->itemID, (LPARAM) tchBuffer,
GetTextMetrics lpdis->hDC, &tm
GetClientRect lpdis.hwnditem,lpdis.rcItem'
-y=(lpdis->rcItem.bottom+lpdis->rcItem.top
tm.tmHeight) / 2
6+TextOutA lpdis->hDC,XBITMAP
(y,tchBuffer,len(tchBuffer,
SelectObject hdcMem, hbmpOld
DeleteDC hdcMem
The GetTextMetrics function fills the specified buffer with the metrics for the currently selected font
BOOL GetTextMetrics( HDC hdc, LPTEXTMETRIC lptm );
Parameters
hdc
A handle to the device context
lptm
A pointer to the TEXTMETRIC structure that receives the text metrics.
Type TEXTMETRICA
tmHeight As Long
tmWeight As Long
tmItalic As Long
tmMaxCharWidth As Long
tmUnderlined As Long
tmCharSet As Long
End Type
: case WM_MEASUREITEM
;lpmis = (LPMEASUREITEMSTRUCT) lParam
;lpmis->itemHeight=20
;return TRUE
(DrawEntire(LPDRAWITEMSTRUCT lpDStruct
;(CRect rect(lpDStruct->rcItem
;HDC dc =lpDStruct->hDC
;MYLISTITEM *a = (MYLISTITEM*)lpDStruct->itemData
TextOut(dc,rect.left+20,rect.top+2,a->title,strlen(a-
;((title<
;(SelectObject(dc,hOldFont
;(SelectObject(dc,oldpen
;(SelectObject(dc,oldbrush
;("strcpy(logFont.lfFaceName,"courier
;(hFont = CreateFontIndirect(&logFont
(hOldFont = (HFONT)SelectObject(dc,hFont
lParam
Pointer to an NMUPDOWN structure that contains information about the position change. The iPos member of this structure contains the current position of the control. The iDelta member of the structure is a signed integer that contains the proposed change in position
If the user has clicked the up button, this is a positive value
If the user has clicked the down button, this is a negative value
wParam
State of the progress bar that is being set. One of the following values.
lParam
با DrawIcon هم می توان آیکونی را در DC صفحه انداخت
تنظیم حاشیه در کنترل EDIT
: wparam
EC_LEFTMARGIN=&H1
EC_RIGHTMARGIN=&H2
: Msg
EM_SETMARGINS=211 '&HD3
دسیمال 211 تبدیل به هگزا - ->> عدد دسیمال تقسیم بر 16 میشود 13 معادل آن D و حاصل تفریق عدد211 و حاصلضرب 13 در 16 میشود 3 .... نهایتا از کنار هم گذاشتن آنها D3 بدست می آید ، در تابع زیر پارامتر هندل Et ذکر شده و منظور گرفتن هندل Edit است که با FindWindowEx انجام شده.
SendMessageA Et, 211, &H1, ByVal 25
SendMessageA Et, 211, &H2, ByVal 65536 * 50
تست شده طبق شکل زیر که تمام تکست داخل EDIT BOX با Ctrl+A انتخاب شده در نتیجه مارجین یا حاشیه مشخص است . البته باید دید تغییر فونت چه تاثیری خواهد گذاشت .
SWP_FRAMECHANGED 0x0020
Applies new frame styles set using the SetWindowLongfunction. Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZEis sent only when the window's size is being changed.
Fully redraw the window in its new
.position
SWP_FRAMECHANGED Sends a WM_NCCALCSIZEmessage to the window, even if the window's size is not being changed. If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.
ارسال آیکون به باتن با پیام BM_SETIMAGE و تابع ارسال پیام به دیالوگ باکس و آیدی باتن که یک است. image_icon=1 , un1=1
موارد پایین تست شده ... البته اینها موارد ساده ای هستند و پیش پا افتاده
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
WM_MOUSEMOVE
Dim p As POINTAPI
GetCursorPos p
ScreenToClient hwnd, p
Dim ff As RECT
Dim ff1 As RECT
SetRect ff, p.x, p.y, p.x, p.y
ff.Left = p.x - 15
ff.Top = p.y - 15
ff.right = p.x + 35
ff.bottom = p.y + 30
DrawFrameControl GetDC(hwnd), ff, DFC_BUTTON, DFCS_BUTTONPUSH
RoundRect GetDC(hwnd), ff.Left, ff.Top, ff.right, ff.bottom, 16, 16
( FillRect GetDC(hwnd), ff, GetSysColorBrush(16
Sleep 100
InvalidateRect hwnd, ff, 1
UpdateWindow hwnd
(ReleaseDC hwnd, GetDC(hwnd
در BS_OWNERDRAW یا خود Button کار نمی کند نتیجتا ترسیم شد ( منظور ناحیه ای که در تصویر پایین داخلش تکست Inside ترسیم شده) . DrawEdge و DrawTextA
dim rr as RECT
If wMsg = WM_PAINT Then
z1.Left = 285 + GetSystemMetrics(SM_CYFRAME) * 3 ' 296
z1.right = 348 + GetSystemMetrics(SM_CYFRAME) * 2 ' 355
z1.Top = 63 + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME) * 2 ' 95
z1.bottom = 86 + GetSystemMetrics(SM_CYCAPTION) + GetSystemMetrics(SM_CYFRAME) + 2 ' 115
(WindProc = DrawEdge(GetWindowDC(hwnd), z1, EDGE_RAISED, BF_RECT + BF_ADJUST
End If
If wMsg = WM_LBUTTONDOWN Then 'WM_MOUSEMOVE
Dim cp As POINTAPI
SetRect rr, 285, 63, 348, 86
GetCursorPos cp
ScreenToClient hwnd, cp
rr.Left = rr.Left + 2
rr.right = rr.right - 2
rr.Top = rr.Top - cp.y + 2
rr.bottom = rr.bottom - cp.y - 2
If PtInRect(rr, cp.x, cp.y) Then
End If
اگر شکل را مشاهده کنید زمان فشردن باتن سمت چپ ماوس در مستطیل موردنظر با مختصات صفحه در قسمت کپشن ویندو هم IN ارسال میشود
بسته شدن پنجره زمانیکه کپشن به عدد 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
کار سختی نیست از منبعی که در انتهای صفحه آمده استفاده شده که تابع ویندوزی است
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
If PtInRect(nn, p.x, p.y) Then
" ... MsgBox "You Clicked Me
End If
.....RedrawWindow
مورد بالا تست شده
در 32 بیت
getdlgctrlid : Retrieves the identifier of the
.specified control
بر گرفته از فروم خارجی ( بررسی موقعیت ماوس در باتن موردنظر )
1-find your button rectangle
GetWindowRect BtnHwnd,BtnRect
WM_SETCURSOR
. Do not change anything, just detect if wParam is HWND of your button. If it is, then set a #define WM_SETCURSOR 0x0020