Following code is a VB-style dir listbox that works fine. Ownerdrawn,
so items are drawn in subclassed procedure, under %WM_DRAWITEM. One
thing left to solve, and I can't understand how.
It seems like I have to pass the %WM_DRAWITEM message on from parent
dialog for it to work. Would like to make it handle all this by
itself, without having to pass any calls on from the parent, but
can't find a way of doing it.
If you test the following code, all looks fine (I hope). Uncomment
the code under %WM_DRAWITEM in main dialog callback, DlgProc, and
nothing is drawn in the listbox. Feels like there should be an easy
solution to this, to make the control handle all this by itself,
but no matter how I try, I can't solve it. I'm probably stupid.. (probably?)
------------------
so items are drawn in subclassed procedure, under %WM_DRAWITEM. One
thing left to solve, and I can't understand how.
It seems like I have to pass the %WM_DRAWITEM message on from parent
dialog for it to work. Would like to make it handle all this by
itself, without having to pass any calls on from the parent, but
can't find a way of doing it.
If you test the following code, all looks fine (I hope). Uncomment
the code under %WM_DRAWITEM in main dialog callback, DlgProc, and
nothing is drawn in the listbox. Feels like there should be an easy
solution to this, to make the control handle all this by itself,
but no matter how I try, I can't solve it. I'm probably stupid.. (probably?)
Code:
'¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Directory listbox - by Borje Hagsten, January 2001. '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' VB style Dir listbox sample.. :-) ' ' Public Domain, feel free to use and customize as you like. ' Code is commented, should be easy to follow. GDI stuff seems safe, ' no leaks. Still, as always, use at own "risk".. :-) '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Declares '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ #COMPILE EXE #INCLUDE "WIN32API.INC" %ID_BTN1 = 10 %ID_DIR1 = 130 GLOBAL oldLBproc AS LONG 'for subclassing, to hold original window procedure address DECLARE CALLBACK FUNCTION DlgProc DECLARE FUNCTION LBproc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG DECLARE SUB DirsToList(BYVAL hWnd AS LONG, BYVAL AbsPath AS STRING) '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Entrance - Create dialog and controls '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION PBMAIN LOCAL hDlg AS LONG, hDirList AS LONG DIALOG NEW 0, "Dir List sample", , , 120, 120, %WS_SYSMENU TO hDlg CONTROL ADD BUTTON, hDlg, %ID_BTN1, "&Close", 30, 85, 60, 14 CONTROL ADD LISTBOX, hDlg, %ID_DIR1, , 4, 4, 108, 80, _ %WS_CHILD OR %LBS_OWNERDRAWFIXED OR %LBS_HASSTRINGS OR _ %WS_TABSTOP OR %LBS_DISABLENOSCROLL OR %WS_VSCROLL, %WS_EX_CLIENTEDGE CONTROL HANDLE hDlg, %ID_DIR1 TO hDirList 'Subclass Dirlistbox oldLBproc = SetWindowLong(hDirList, %GWL_WNDPROC, CODEPTR(LBproc)) CALL DirsToList(hDirList, CURDIR$) 'initialize to whatever path, like CURDIR$ DIALOG SHOW MODAL hDlg, CALL DlgProc END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Main dialog callback '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ CALLBACK FUNCTION DlgProc SELECT CASE CBMSG CASE %WM_COMMAND SELECT CASE CBCTL CASE %ID_BTN1 : DIALOG END CBHNDL 'Exit CASE %ID_DIR1 END SELECT CASE %WM_DESTROY 'Un-subclass listbox SetWindowLong GetDlgItem(CBHNDL, %ID_DIR1), %GWL_WNDPROC, oldLBproc CASE %WM_DRAWITEM 'Must pass this on to subclassed control, wonder why..? IF CBWPARAM = %ID_DIR1 THEN SendMessage GetDlgItem(CBHNDL, %ID_DIR1), CBMSG, CBWPARAM, CBLPARAM FUNCTION = 0: EXIT FUNCTION END IF END SELECT END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Subclassed DirListbox procedure '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ FUNCTION LBproc(BYVAL hWnd AS LONG, BYVAL wMsg AS LONG, _ BYVAL wParam AS LONG, BYVAL lParam AS LONG) AS LONG SELECT CASE wMsg CASE %WM_GETDLGCODE 'make sure we get all keys FUNCTION = %DLGC_WANTALLKEYS : EXIT FUNCTION CASE %WM_KEYDOWN 'respond to keyboard input SELECT CASE wParam CASE %VK_RETURN 'Enter key CALL DirsToList(hWnd, "") FUNCTION = 0 : EXIT FUNCTION CASE %VK_TAB 'must handle Tab ourselves, since we have taken full controll.. IF HIWRD(GetKeyState(%VK_SHIFT)) = 0 THEN SetFocus GetNextDlgTabItem(GetParent(hWnd), hWnd, 0) 'Move focus to next control ELSE 'If Shift is pressed - SetFocus GetNextDlgTabItem(GetParent(hWnd), hWnd, -1) 'Move focus to previous control END IF FUNCTION = 0 : EXIT FUNCTION END SELECT CASE %WM_LBUTTONDBLCLK 'respond to double-click CALL DirsToList(hWnd, "") FUNCTION = 0 : EXIT FUNCTION CASE %WM_DRAWITEM 'Ownerdrawn = owner draws all items self (programmer = owner) LOCAL lpdis AS DRAWITEMSTRUCT PTR lpdis = lParam IF @lpdis.itemID = -1 THEN EXIT FUNCTION 'empty list, take a break.. SELECT CASE @lpdis.itemAction CASE %ODA_DRAWENTIRE, %ODA_SELECT LOCAL lpshfi AS SHFILEINFO, tm AS TEXTMETRIC, zTxt AS ASCIIZ * %MAX_PATH, rct AS RECT LOCAL hBrush AS LONG, hBrushOld AS LONG, img AS LONG, it AS LONG, xPos AS LONG, y AS LONG 'CLEAR BACKGROUND hBrush = CreateSolidBrush(GetSysColor(%COLOR_WINDOW)) 'Create a background brush hBrushOld = SelectObject(@lpdis.hDC, hBrush) 'Select brush into device context CALL FillRect(@lpdis.hDC, @lpdis.rcItem, hBrush) 'Paint background color rectangle CALL SelectObject(@lpdis.hDC, hBrushOld) 'Select old brush back CALL DeleteObject(hBrush) 'Delete brush 'GET SELECTED TEXT AND CALCULATE X POSITION CALL SendMessage(hWnd, %LB_GETTEXT, @lpdis.itemID, VARPTR(zTxt)) 'Get selected text it = SendMessage(hWnd, %LB_GETITEMDATA, @lpdis.itemID, 0) xPos = (TALLY(zTxt, "\") + it - 1) * 3 ' * 3 decides x pos between opened folders 'GET SMALL ASSOCIATED ICON AND TEXT TO DISPLAY IF it <> 1 THEN img = SHGetFileInfo(zTxt, 0, lpshfi, LEN(lpshfi), %SHGFI_DISPLAYNAME OR %SHGFI_ICON OR %SHGFI_SMALLICON) ELSE img = SHGetFileInfo(zTxt, 0, lpshfi, LEN(lpshfi), %SHGFI_DISPLAYNAME OR %SHGFI_ICON OR %SHGFI_SMALLICON OR %SHGFI_OPENICON) END IF 'ADJUST ITEM HEIGHT TO FONT SIZE CALL GetTextMetrics(@lpdis.hDC, tm) 'get font size y = (@lpdis.rcItem.nBottom + @lpdis.rcItem.nTop - tm.tmHeight) / 2 'Center text ypos IF SendMessage(hWnd, %CB_GETITEMHEIGHT, @lpdis.itemID, 0) < tm.tmHeight + 2 THEN CALL SendMessage(hWnd, %CB_SETITEMHEIGHT, @lpdis.itemID, tm.tmHeight + 2) 'adjust item height END IF 'DRAW TEXT CALL SetBkColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOW)) 'Set text Background CALL SetTextColor(@lpdis.hDC, GetSysColor(%COLOR_WINDOWTEXT)) 'Set text color IF @lpdis.itemID = 0 THEN lpshfi.szDisplayName = UCASE$(zTxt) 'First item, drive, UCASE CALL TextOut(@lpdis.hDC, xPos + 22, y, lpshfi.szDisplayName, LEN(lpshfi.szDisplayName)) 'Draw text 'SELECTED ITEM IF (@lpdis.itemState AND %ODS_SELECTED) THEN 'if selected CALL InvertRect(@lpdis.hDC, @lpdis.rcItem) 'invert area around text only END IF 'DRAW ASSOCIATED ICON DrawIconEx @lpdis.hDC, xPos + 3, @lpdis.rcItem.ntop, _ lpshfi.hIcon, 16, 15, 0, BYVAL %NULL, %DI_NORMAL FUNCTION = %TRUE : EXIT FUNCTION CASE %ODA_FOCUS CALL DrawFocusRect(@lpdis.hDC, @lpdis.rcItem) 'draw focus rectangle END SELECT END SELECT FUNCTION = CallWindowProc(oldLBproc, hWnd, wMsg, wParam, lParam) 'pass all other messages on to orig. proc. END FUNCTION '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ ' Populate DirListbox with available directories '¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤¤ SUB DirsToList(BYVAL hWnd AS LONG, BYVAL AbsPath AS STRING) LOCAL hSearch AS LONG, fRes AS LONG, Path AS STRING, s AS STRING, arr() AS STRING, dc AS LONG LOCAL WFD AS WIN32_FIND_DATA, I AS LONG, J AS LONG IF LEN(AbsPath) = 0 THEN 'if nothing has been passed, look for selected item I = SendMessage(hWnd, %LB_GETCURSEL, 0, 0) J = SendMessage(hWnd, %LB_GETTEXTLEN, I, 0) AbsPath = SPACE$(J) I = SendMessage(hWnd, %LB_GETTEXT, I, BYVAL STRPTR(AbsPath)) END IF IF LEN(AbsPath) = 0 THEN EXIT SUB 'if something bad has happened IF RIGHT$(AbsPath, 1) <> "\" THEN AbsPath = AbsPath & "\" 'make sure we have a trailing backslash Path = AbsPath 'store for later use AbsPath = AbsPath + "*" 'for finding all subsequent folders FOR I = 1 TO PARSECOUNT(Path, "\") - 1 'Parse current path and add opened folders to array s = s + PARSE$(Path, "\", I) IF LEN(s) THEN REDIM PRESERVE arr(dc) IF RIGHT$(s, 1) <> "\" THEN s = s & "\" arr(dc) = s INCR dc END IF NEXT I J = dc - 1 hSearch = FindFirstFile(BYVAL STRPTR(AbsPath), WFD) 'Find all following non-opened sub-folders IF hSearch <> %INVALID_HANDLE_VALUE THEN CALL SendMessage(hWnd, %CB_RESETCONTENT, 0, 0) fRes = %TRUE DO WHILE fRes IF ASC(WFD.cFileName) <> 46 THEN 'No . or .. IF (WFD.dwFileAttributes AND 16) = 16 THEN 'dirs only.. AbsPath = TRIM$(WFD.cFileName, CHR$(0)) REDIM PRESERVE arr(dc) arr(dc) = Path + AbsPath INCR dc END IF END IF fRes = FindNextFile(hSearch, WFD) ' Get next LOOP fRes = FindClose(hSearch) END IF ARRAY SORT arr(J), COLLATE UCASE 'sort non-opened folders only CALL SendMessage(hWnd, %LB_RESETCONTENT, 0, 0) 'clear list FOR I = 0 TO UBOUND(arr) CALL SendMessage(hWnd, %LB_ADDSTRING, 0, BYVAL STRPTR(arr(I))) 'add to list IF I = 0 THEN 'Set item data for chosing type of *** . icon CALL SendMessage(hWnd, %LB_SETITEMDATA, I, 0) 'Drive ELSEIF I = < J THEN CALL SendMessage(hWnd, %LB_SETITEMDATA, I, 1) 'opened folder ELSE CALL SendMessage(hWnd, %LB_SETITEMDATA, I, 2) 'closed folder END IF NEXT CALL SendMessage(hWnd, %LB_SELECTSTRING, -1, BYVAL STRPTR(Path)) 'select current 'Note - here is good place to fill a file listbox. 'Can use same FindFirstFile loop as above, but use '"IF (WFD.dwFileAttributes AND 16) <> 16" instead, 'to get file names for an ordinary listbox, whatever. END SUB
------------------
Comment