ListBox

Const LBN_SELCHANGE = 1

Const LBN_DBLCLK = 2

Const LBN_SELCANCEL = 3

Const LBN_SETFOCUS = 4

Const LBN_KILLFOCUS = 5

Const LB_ADDSTRING = &H180

Const LB_SETSEL = &H185

Const LB_SETCURSEL = &H186 Const LB_GETSEL = &H187

Const LB_GETCURSEL = &H188

Const LB_GETTEXT = &H189

Const LB_GETTEXTLEN = &H18A

Const LB_GETCOUNT = &H18B

Const LB_SELECTSTRING = &H18C

Const LB_GETITEMRECT = &H198

Const LB_GETITEMDATA = &H199

Const LB_SETITEMDATA = &H19A

Const LB_SELITEMRANGE = &H19B

Const LB_SETITEMHEIGHT = &H1A0

Const LB_GETITEMHEIGHT = &H1A1

private Const WM_NOTIFY=&H4E

public Const WM_COMMAND=&H111

Const WM_DRAWITEM =&H2B

Const ODA_FOCUS = &H4

Const ODS_FOCUS = &H10

Const ODS_SELECTED = &H1

?private lpListBox as ListBox

?set lpListBox = lpLB

?m_LBHwnd = lpListBox.hwnd

private Function LBSubcls_WndProc_V3(byval hwnd as Long, byval Msg as Long, byval wParam as Long, byval lParam as Long) as Long

Dim lCurind as Long

Select Case Msg 

Case WM_COMMAND

If lParam = m_LBHwnd then

LongInt2Int wParam, iHw, iLW

(Select Case (iHw

Case LBN_SELCHANGE

lCurind=SendMessage(lParam, LB_GETCURSEL,0,byval 0&)

If (lCurind Mod 3) = 0 then

lCurind = SendMessage(lParam, LB_SETCURSEL, lCurind + 1, byval 0&)

End If 

Debug.print " sendmessage returned:" & Hex$(lCurind)

Case LBN_SELCANCEL

lCurind=SendMessage(lParam, LB_GETCURSEL,0,byval 0&) 

Debug.print " lbnselcancel for:"; Hex$(lCurind)

End Select 

End If

Case WM_DRAWITEM

If LB_Drawitem(lParam) = 0 then 

LBSubcls_WndProc_V3 = 0 

Exit Function 

End If

Case else 

End Select

LBSubcls_WndProc_V3=CallWindowProc(oldWndProc,hwnd,Msg, wParam, lParam)

End Function

private Function LB_Drawitem(byval lParam as Long) as Integer

Dim drawstruct as DRAWITEMSTRUCT 

Dim szBuf(256) as Byte

CopyMemory drawstruct,byval lParam, len(drawstruct)

Dim i as Integer

Dim hbrGray as Long,hbrback as Long,szListStr as string ' * 256

Dim crback as Long,crtext as Long,lbuflen as Long

Select Case (drawstruct.CtlType)

   Case ODT_LISTBOX

lbuflen=SendMessagedrawstruct.hwndItem,LB_GETTEXTLENdrawstruct.itemID,byval 0&)

Redim szBuf(lbuflen+2)

lbuflen=SendMessage(drawstruct.hwndItem,LB_GETTEXT,drawstruct.itemID,szBuf(0))

i = drawstruct.itemID

If i Mod 3=0 then

hbrGray = CreateSolidBrush(GetSysColor(COLOR_GRAYTEXT))

 

GrayString drawstruct.hdc, hbrGray,byval 0&,szListStr, len(szListStr),drawstruct.rcItem.Left,drawstruct.rcItem.Top, 0,0

DeleteObject hbrGray 

crback=RGB(180, 180, 180) crtext=RGB(60, 60, 60) 

else

If (drawstruct.itemState And ODS_SELECTED)=ODS_SELECTED then 

crback=GetSysColor(COLOR_HIGHLIGHT)

crtext=GetSysColor(COLOR_HIGHLIGHTTEXT)

ElseIf (drawstruct.itemState And ODS_FOCUS)=ODS_FOCUS then

crback=GetSysColor(COLOR_WINDOW)

crtext=vbRed

else

End if 

If (drawstruct.itemState And ODS_FOCUS)= 

ODS_FOCUS then

crtext=vbRed

End If

End If

hbrback=CreateSolidBrush(crback)

FillRect drawstruct.hdc, drawstruct.rcItem,hbrback 

DeleteObject hbrback

SetBkColor drawstruct.hdc, crback

SetTextColor drawstruct.hdc, crtext 

TextOut drawstruct.hdcdrawstruct.rcItem.Left,drawstruct.rcItem.Top, szListStr,len(szListStr) 

TextOutBStr drawstruct.hdc, drawstruct.rcItem.Left,drawstruct.rcItem.Top,szBuf(0),lbuflen

If (drawstruct.itemState And ODS_FOCUS) then

DrawFocusRect drawstruct.hdc, drawstruct.rcItem

End If

LB_Drawitem = 1

End Select

End Function

private Function LBSubcls_WndProc_V4(byval hwnd as Long,byval Msg as Long, byval wParam as Long,byval lParam as Long) as Long

Dim iHw as Integer,iLW as Integer

Dim lCurind as Long

Select Case Msg 

Case WM_LBUTTONDOWN, WM_LBUTTONDBLCLK

LongInt2Int lParam, iHw, iLW

Debug.print " Mouse down at(" & iHw & "," & iLW &  ")"

lCurind=SendMessage(hwnd, LB_ITEMFROMPOINT,byval 0, byval lParam)

Debug.print "Index of btn down:" & Hex$(lCurind)

If (lCurind Mod 3) = 0 then 

LBSubcls_WndProc_V4 = 1

Exit Function

End If

,Case WM_KEYDOWN

LongInt2Int wParam, iHw, iLW 

Select Case (iLW)

Case vbKeyDown

lCurind=SendMessage(hwnd, LB_GETCARETINDEX,0,byval 0&) 

Debug.print " Keydown With Itemid :" & Hex$(lCurind) 

If ((lCurind + 1) Mod 3) = 0 then 

lCurind=SendMessage(hwnd, LB_SETCARETINDEX,lCurind + 1, byval 0&)

End If 

lCurind = SendMessage(hwnd, LB_GETCURSEL, 0, byval 0&) 

Debug.print " Keydown With Itemid :" & Hex$(lCurind)

If ((lCurind + 1) Mod 3) = 0 then

lCurind = SendMessage(hwnd, LB_SETCURSEL, lCurind + 1, byval 0&)

End If 

Case vbKeyUp 

lCurind = SendMessage(hwnd, LB_GETCARETINDEX,0,byval 0&) 

Debug.print " KeyUp With Itemid :" & Hex$(lCurind)

If ((lCurind - 1) Mod 3) = 0 then

lCurind = SendMessage(hwnd, LB_SETCARETINDEX,lCurind - 1, byval 0&)

End If 

lCurind = SendMessage(hwnd, LB_GETCURSEL,0,byval 0&) 

Debug.print " KeyUp With Itemid :" & Hex$(lCurind)

If ((lCurind - 1) Mod 3) = 0 then

lCurind = SendMessage(hwnd, LB_SETCURSEL, lCurind - 1, byval 0&)

End If 

End Select 

Case else 

End Select

LBSubcls_WndProc_V4 = CallWindowProc(LBProc1, hwnd, Msg, wParam, lParam)

End Function 

public Function LongInt2Int(byval lLongInt as Long,byref iHiWord as Integer, byref iLowWord as Integer) as Boolean 

Dim tmpHW as Integer,tmpLW as Integer

CopyMemory tmpLW,lLongInt, len(tmpLW)

tmpHW =(lLongInt / TwoPower16) 

iHiWord = tmpHW 

iLowWord = tmpLW 

End Function 

TwoPower16=2^16 : 65536

public Function MakeLParam(byval iHiWord as Integer, byval iLowWord as Integer) as Long 

MakeLParam=(iHiWord * TwoPower16) + iLowWord

End Function

---

WS_BORDRR,WS_EX_CLIENDEDGE

"SendMessageA hlist, &H180, 0, ByVal "D

       "SendMessageA hlist, &H180, 0, ByVal "E

       "SendMessageA hlist, &H180, 0, ByVal "FFF

      " SendMessageA hlist, &H180, 0, ByVal "HHT

       "SendMessageA hlist, &H180, 0, ByVal "123E

    "سلام  " SendMessageA hlist, &H180, 0, ByVal

"حاجی " SendMessageA hlist, &H180, 0, ByVal 

در Subclassing

Case WM_KEYDOWN

    Select Case wParam

      Case &H11, &H1

      Dim c, ll

      Dim buf As String

      Dim Idx

     ( Idx = SendMessageA(hwnd, LB_GETCURSEL, 0, 0

     ( c = SendMessageA(hwnd, LB_GETCOUNT, 0, 0

      (textcount = SendMessageA(hwnd, LB_GETTEXTLEN, i, 0

buffer$ = Space$(textcount + 255)

      $SendMessageA hwnd, LB_GETTEXT, Idx, ByVal buffer

  $ SetWindowTextA GetParent(hwnd), c & "... Idx : " & Idx & "...." & l & buffer

     End Select