-
mistake
hello,
you made an error in the test code :
the declaration and using of the MyPopupLV() forgot the D parametter !
DominiqueLeave a comment:
-
This version is slightly improved by allowing the PBCC application to pass a depth parameter. This is the pixel depth of the listview.
Code:' ' Popup listview DLL ' ' It is called using a pointer to an asciz array of pointers to data ' which is treated as a 2D array. This is how SQLite returns query results, ' although this library function doesn't care who created the array. ' ' The other parameters locate the ListView on the screen (location and depth) and manage ' its presentation. The width of the listview is recalculated dynamically. ' ' The value returned is the row which was selected plus 1, to make it compatible ' with the DDT convention for numbering rows. ' ' Chris Holbrook Oct 2009 ' ' changes ' 27 Oct 2009 - added depth (pixels) parameter ' #compile dll #dim all #include "WIN32API.INC" #include "COMMCTRL.INC" %IDD_DIALOG1 = 101 %IDC_LV = 1002 %DEFAULT_LV_STYLES = %ws_child or %ws_tabstop or %ws_visible or %lvs_nosortheader or %lvs_showselalways or %lvs_report %DEFAULT_LV_EX_STYLES = %lvs_ex_gridlines or %ws_ex_left or %ws_ex_rightscrollbar global gResultSetPtr as dword ' as returned by SQLite global gColumnList as string ' csv list of column names global gnrows as long global gncols as long global gerror as string global gtitle as string global gptable() as asciz ptr global gX, gY, gD as long '------------------------------------------------------------------------------ function QLVCustomDraw ( byval ptlvcd as NMLVCUSTOMDRAW ptr ) as long local szItem as asciiz * %MAX_PATH ' item text local trcItem as RECT ' bounding rectangle of item/subitem local tlv_item as LV_ITEM ' listview item information local tlb as LOGBRUSH ' specifies information used to create background brush local hWndHdr as dword ' handle of header child control local hBrush as dword local hBrushOld as dword local hPenOld as dword local dwBackColor as dword local nBkModeOld as integer local hwin as dword local lresult as long ' Get the item or subitem info tlv_item.mask = %LVIF_TEXT or %LVIF_IMAGE or %LVIF_STATE tlv_item.stateMask = %LVIS_FOCUSED or %LVIS_SELECTED tlv_item.iItem = @ptlvcd.nmcd.dwItemSpec tlv_item.iSubItem = @ptlvcd.iSubItem tlv_item.pszText = varptr(szItem) tlv_item.cchTextMax = %MAX_PATH SendMessage @ptlvcd.nmcd.hdr.hwndFrom, %lvm_getitem, 0, byval varptr(tlv_item) ' Get the bounding rectangle of the subitem(cell) trcItem.nLeft = %LVIR_BOUNDS trcItem.nTop = @ptlvcd.iSubItem lresult = SendMessage( @ptlvcd.nmcd.hdr.hwndFrom, %lvm_getsubitemrect, @ptlvcd.nmcd.dwItemSpec, byval varptr(trcItem)) ' Color the background if @ptlvcd.nmcd.dwItemSpec mod 2 = 0 then dwBackColor = %rgb_lightblue ' background else dwBackColor = %white ' white background end if tlb.lbStyle = %BS_SOLID tlb.lbColor = dwBackColor tlb.lbHatch = 0 hBrush = CreateBrushIndirect(tlb) FillRect @ptlvcd.nmcd.hdc, trcItem, hBrush DeleteObject hBrush ' Draw the text nBkModeOld = SetBkMode(@ptlvcd.nmcd.hdc, %TRANSPARENT) DrawTextEx @ptlvcd.nmcd.hdc, szItem, len(szItem), trcItem, %DT_SINGLELINE or %DT_LEFT or %DT_VCENTER or %DT_END_ELLIPSIS, byval %NULL SetBkMode @ptlvcd.nmcd.hdc, nBkModeOld function = %CDRF_SKIPDEFAULT end function '-------------------------------------------------- callback function ShowDIALOG1Proc() local i, j as long local h, lcols, lresult, n, w as long local sz as asciz * 512 local pnmh as nmhdr ptr local pnm as NMLVCUSTOMDRAW ptr local p as pointapi local lpLVDispInfo as LV_DISPINFO ptr local lpia as NMITEMACTIVATE ptr local s as string select case as long cbmsg case %wm_initdialog local alignment, pxwidth as long for i = 1 to gncols ' listview columns s = parse$(GColumnList,i) pxwidth = val(parse$(s, "|", 2)) alignment = val(parse$(s, "|", 3)) s = parse$(s, "|", 1) if s = "" then listview insert column cb.hndl, %IDC_LV, i, @gptable(i-1), pxwidth, alignment else listview insert column cb.hndl, %IDC_LV, i, s, pxwidth, alignment end if if pxwidth = 0 then listview fit header cb.hndl, %IDC_LV, i listview get column cb.hndl, %IDC_LV, i to n w = w + n + 2 next control get size cb.hndl, %IDC_LV to n, h w = w + GetSystemMetrics(%SM_CXVSCROLL) h = h + GetSystemMetrics(%SM_CYVSCROLL) dialog set client cb.hndl, w, h control set size cb.hndl, %IDC_LV, w, h for i = 1 to gnrows listview insert item cb.hndl, %IDC_LV, i, 0, @gptable(i * gncols -1) for j = 2 to gncols listview set text cb.hndl, %IDC_LV, i * gncols, j, @gptable(i * gncols + j -1) next next case %wm_notify pnmh = cblparam select case @pnmh.code if lowrd(cbwparam) <> %IDC_LV then exit select lpia=cblparam case %nm_click n = @lpia.iitem + 1 if n = 0 then ' did not click in 1st column ? "please click on the left-hand item!" exit select end if listview get text cb.hndl, %IDC_LV, n, 1 to s dialog end cb.hndl, n case %nm_customdraw ' Here you can specify font and color. pnm = cblparam select case @pnm.nmcd.dwDrawStage case %CDDS_PREPAINT ' The following statement ensures that the relevant ' messages are coming back to Windows, so Windows ' can respond appropriately. ' The following statement makes Windows happy: SetWindowLong cbhndl,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW ' This statement makes the DDT engine happy: function = 1: exit function case %CDDS_ITEMPREPAINT SetWindowLong cbhndl,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW function = 1: exit function case %CDDS_SUBITEM or %CDDS_ITEMPREPAINT function = QLVCustomDraw(byval pnm) exit function end select case %lvn_getdispinfo 'Virtual ListView ask for Item text lpLVDispInfo = cblparam @lpLVDispInfo.item.pszText = varptr(sz) if (@lpLVDispInfo.item.mask and %LVIF_TEXT) then @lpLVDispInfo.item.pszText = _ gptable(((@lpLVDispInfo.item.iitem + 1)* gncols) + @lpLVDispInfo.item.iSubItem) end if end select end select end function '-------------------------------------------------------------------------------------- function ShowDIALOG1(byval hParent as dword) as long local lRslt as long local hDlg as dword local w, h as long dialog new pixels, hParent, gtitle, gX, gY, 0, gD, _ %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or _ %ws_clipsiblings or %ws_visible or %ds_modalframe or _ %ds_3dlook or %ds_nofailcreate or %ds_setfont, _ %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _ to hDlg dialog get client hDlg to w, h control add "SysListView32", hDlg, %IDC_LV, "SysListView32_1", 0, 0, w, h, _ %DEFAULT_LV_STYLES or %lvs_ownerdata, %DEFAULT_LV_EX_STYLES 'OR %LVS_OWNERDATA dialog show modal hDlg, call ShowDIALOG1Proc to lRslt function = lRslt end function '-------------------------------------------------------------------------------------- function mypopuplv alias "MyPopupLV"_ (title as string, X as long, Y as long, D as long, byval presults as dword, nrows as long, ncols as long, ColumnNames as string) _ export as long gX = X gY = Y gD = D gtitle = title gResultSetPtr = presults gColumnList = ColumnNames gnrows = nrows gncols = ncols redim gptable(0 to nrows*ncols-1) at presults function = ShowDIALOG1( %hwnd_desktop) end function '------------------------------------------------------------------------------- global ghInstance as dword global gszdbpath as asciz * %max_path '------------------------------------------------------------------------------- ' Main DLL entry point called by Windows... ' function libmain (byval hInstance as long, _ byval fwdReason as long, _ byval lpvReserved as long) as long select case fwdReason case %DLL_PROCESS_ATTACH 'Indicates that the DLL is being loaded by another process (a DLL 'or EXE is loading the DLL). DLLs can use this opportunity to 'initialize any instance or global data, such as arrays. ghInstance = hInstance InitCommonControls function = 1 'success! 'FUNCTION = 0 'failure! This will prevent the EXE from running. case %DLL_PROCESS_DETACH 'Indicates that the DLL is being unloaded or detached from the 'calling application. DLLs can take this opportunity to clean 'up all resources for all threads attached and known to the DLL. function = 1 'success! 'FUNCTION = 0 'failure! case %DLL_THREAD_ATTACH 'Indicates that the DLL is being loaded by a new thread in the 'calling application. DLLs can use this opportunity to 'initialize any thread local storage (TLS). function = 1 'success! 'FUNCTION = 0 'failure! case %DLL_THREAD_DETACH 'Indicates that the thread is exiting cleanly. If the DLL has 'allocated any thread local storage, it should be released. function = 1 'success! 'FUNCTION = 0 'failure! end select end functionLeave a comment:
-
A PBCC application using SQLite to populate a ListView
Application - DLL is further down this post
Discussion here. Also a zipped dll in case you don't have the PBWin compiler necessary to compile it.
You will need the SQLite3.dll from www.sqlite.org. And the include file from www.jose.it-berater.org/. Or you could just convert the few API calls used here from the Sqlite3.inc on the www.SQlite.org website and define the functions in the PBCC source code - bad I know...
The DLL does not need any access to the database. The call from the PBCC application passes a pointer to the query results.
SQLite is about as easy to deploy as you can get, asd I hope this example also shows.
DLL:Code:' ' A PBCC application using SQLite to populate a ListView ' 1. Create (if it does not exist) a SQLITE database ' 2. Create a table (if it does not exist) called TESTME ' 3. Add test data if it not already there ' 4. Call the MyPopupLV function from the MyPopUpLV library. ' This displays the results of a SQL query in a list view and lets the user choose a row ' 5. Display the results and exit. ' ' Chris Holbrook Oct 2009 #compile exe #dim all #include "sqlite3.inc" declare function mypopuplv lib "mypopuplvlib.dll" alias _ "MyPopupLV" (gtitle as string, X as long, Y as long, byval presults as dword, nrows as long, ncols as long, ColumnNames as string) as long function pbmain () as long local presults as dword ' pointer to SQLite's results set local hdb as dword ' database handle local psz() as asciz ptr ' array of pointers to SQLite's result set local nrows, ncols as long ' # of rows and columns returned by SQLite local pzer as asciz ptr ' ptr to SQLite's error msg local szdbpath as asciz * 256 ' database path local SQL as string ' our SQL statement local i, lresult, l as long ' local s as string ' '============================================ ' SPECIFY AND OPEN THE DATABASE szdbpath = "myDB.db" sqlite3_open( szDBpath, hDB ) '============================================ '============================================ ' LOAD TEST DATA if not already loaded sql = "create table if not exists TESTME (animal, keeper, feed, budget, primary key (animal, keeper))" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('ant', 'Mr Blenkinsop', 'carrion', '550')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('bat', 'Mr Blenkinsop', 'moths', '150')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('anaconda', 'Mr Blenkinsop', 'donkeys', '550')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('barracuda', 'Mr Blenkinsop', 'chips', '250')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('garlic monkey', 'Mr Blenkinsop', 'garlic', '4550')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE sql = "insert or ignore into TESTME values('jaberwock', 'Mr Blenkinsop', 'toves', '550')" gosub do_sql: sqlite3_free_table(presults)' free resources - results discarded by SQLITE '========================================================= '========================================================= ' QUERY THE DATABASE sql = "select * from TESTME" gosub do_sql ' NB this time the results are not discarded! '========================================================= '========================================================= ' SHOW THE POPUP LISTBOX AND GET THE USER'S SELECTION s = "The Animal|100|0,The Keeper|100|0,Feed|70,Budget||1" l = MyPopupLV("select an animal", 300, 300, byval presults, nrows, ncols, s) ' now we know the selection made from the list view if l = 0 then ? "you did not select an item!" else ? "you selected number" + str$(l) + ", the " + ucase$(@psz(l*ncols)) + "!" end if '========================================================= '========================================================= ' CLOSE THE DATABASE sqlite3_free_table(presults) ' free resources sqlite3_close( hDB ) '========================================================= '========================================================= ' WAIT FOR THE USER TO END THE APPLICATION ? "press a key to close the application waitkey$ exit function '========================================================= '''''''''''''''''''''''''''' do_sql: ' do the query, get the results lresult = SQLite3_Get_Table( byval hDB, byval strptr(SQL), presults, _ nRows, nCols, byval varptr(pzer) ) if lresult <> 0 then ? "SQLiteTest: error in query! :" + @pzer + $crlf + sql,%mb_systemmodal, "Error!" sqlite3_free(pzer) waitkey$ exit function end if ' SQLite puts the results in memory and gives us a pointer to it. ' the pointer points to an array of asciz pointers, (rows * columns) in size. ' the first row contains the SQL column headings ' this maps our array onto the results index in SQLite's memory redim psz(0 to nrows*ncols -1) at presults return end function
Code:' ' Popup listview DLL ' ' It is called using a pointer to an asciz array of pointers to data ' which is treated as a 2D array. This is how SQLite returns query results, ' although this library function doesn't care who created the array. ' ' The other parameters locate the ListView on the screen and manage ' its presentation. ' ' The value returned is the row which was selected plus 1, to make it compatible ' with the DDT convention for numbering rows. ' ' Chris Holbrook Oct 1009 #compile dll #dim all #include "WIN32API.INC" #include "COMMCTRL.INC" %IDD_DIALOG1 = 101 %IDC_LV = 1002 %DEFAULT_LV_STYLES = %ws_child or %ws_tabstop or %ws_visible or %lvs_nosortheader or %lvs_showselalways or %lvs_report %DEFAULT_LV_EX_STYLES = %lvs_ex_gridlines or %ws_ex_left or %ws_ex_rightscrollbar global gResultSetPtr as dword ' as returned by SQLite global gColumnList as string ' csv list of column names global gnrows as long global gncols as long global gerror as string global gtitle as string global gptable() as asciz ptr global gX, gY as long '------------------------------------------------------------------------------ function QLVCustomDraw ( byval ptlvcd as NMLVCUSTOMDRAW ptr ) as long local szItem as asciiz * %MAX_PATH ' item text local trcItem as RECT ' bounding rectangle of item/subitem local tlv_item as LV_ITEM ' listview item information local tlb as LOGBRUSH ' specifies information used to create background brush local hWndHdr as dword ' handle of header child control local hBrush as dword local hBrushOld as dword local hPenOld as dword local dwBackColor as dword local nBkModeOld as integer local hwin as dword local lresult as long ' Get the item or subitem info tlv_item.mask = %LVIF_TEXT or %LVIF_IMAGE or %LVIF_STATE tlv_item.stateMask = %LVIS_FOCUSED or %LVIS_SELECTED tlv_item.iItem = @ptlvcd.nmcd.dwItemSpec tlv_item.iSubItem = @ptlvcd.iSubItem tlv_item.pszText = varptr(szItem) tlv_item.cchTextMax = %MAX_PATH SendMessage @ptlvcd.nmcd.hdr.hwndFrom, %lvm_getitem, 0, byval varptr(tlv_item) ' Get the bounding rectangle of the subitem(cell) trcItem.nLeft = %LVIR_BOUNDS trcItem.nTop = @ptlvcd.iSubItem lresult = SendMessage( @ptlvcd.nmcd.hdr.hwndFrom, %lvm_getsubitemrect, @ptlvcd.nmcd.dwItemSpec, byval varptr(trcItem)) ' Color the background if @ptlvcd.nmcd.dwItemSpec mod 2 = 0 then dwBackColor = %rgb_lightblue ' background else dwBackColor = %white ' white background end if tlb.lbStyle = %BS_SOLID tlb.lbColor = dwBackColor tlb.lbHatch = 0 hBrush = CreateBrushIndirect(tlb) FillRect @ptlvcd.nmcd.hdc, trcItem, hBrush DeleteObject hBrush ' Draw the text nBkModeOld = SetBkMode(@ptlvcd.nmcd.hdc, %TRANSPARENT) DrawTextEx @ptlvcd.nmcd.hdc, szItem, len(szItem), trcItem, %DT_SINGLELINE or %DT_LEFT or %DT_VCENTER or %DT_END_ELLIPSIS, byval %NULL SetBkMode @ptlvcd.nmcd.hdc, nBkModeOld function = %CDRF_SKIPDEFAULT end function '-------------------------------------------------- callback function ShowDIALOG1Proc() local i, j as long local h, lcols, lresult, n, w as long local sz as asciz * 512 local pnmh as nmhdr ptr local pnm as NMLVCUSTOMDRAW ptr local p as pointapi local lpLVDispInfo as LV_DISPINFO ptr local lpia as NMITEMACTIVATE ptr local s as string select case as long cbmsg case %wm_initdialog local alignment, pxwidth as long for i = 1 to gncols ' listview columns s = parse$(GColumnList,i) alignment = val(parse$(s, "|", 3)) pxwidth = val(parse$(s, "|", 2)) s = parse$(s, "|", 1) if s = "" then listview insert column cb.hndl, %IDC_LV, i, @gptable(i-1), pxwidth, alignment else listview insert column cb.hndl, %IDC_LV, i, s, pxwidth, alignment end if if pxwidth = 0 then listview fit header cb.hndl, %IDC_LV, i listview get column cb.hndl, %IDC_LV, i to n w = w + n + 2 next control get size cb.hndl, %IDC_LV to n, h w = w + GetSystemMetrics(%SM_CXVSCROLL) h = h + GetSystemMetrics(%SM_CYVSCROLL) dialog set client cb.hndl, w, h control set size cb.hndl, %IDC_LV, w, h for i = 1 to gnrows listview insert item cb.hndl, %IDC_LV, i, 0, @gptable(i * gncols -1) for j = 2 to gncols listview set text cb.hndl, %IDC_LV, i * gncols, j, @gptable(i * gncols + j -1) next next case %wm_notify pnmh = cblparam select case @pnmh.code if lowrd(cbwparam) <> %IDC_LV then exit select lpia=cblparam case %nm_click n = @lpia.iitem + 1 if n = 0 then ' did not click in 1st column ? "please click on the left-hand item!" exit select end if listview get text cb.hndl, %IDC_LV, n, 1 to s dialog end cb.hndl, n case %nm_customdraw ' Here you can specify font and color. pnm = cblparam select case @pnm.nmcd.dwDrawStage case %CDDS_PREPAINT ' The following statement ensures that the relevant ' messages are coming back to Windows, so Windows ' can respond appropriately. ' The following statement makes Windows happy: SetWindowLong cbhndl,%DWL_MSGRESULT,%CDRF_NOTIFYITEMDRAW ' This statement makes the DDT engine happy: function = 1: exit function case %CDDS_ITEMPREPAINT SetWindowLong cbhndl,%DWL_MSGRESULT,%CDRF_NOTIFYSUBITEMDRAW function = 1: exit function case %CDDS_SUBITEM or %CDDS_ITEMPREPAINT function = QLVCustomDraw(byval pnm) exit function end select case %lvn_getdispinfo 'Virtual ListView ask for Item text lpLVDispInfo = cblparam @lpLVDispInfo.item.pszText = varptr(sz) if (@lpLVDispInfo.item.mask and %LVIF_TEXT) then @lpLVDispInfo.item.pszText = _ gptable(((@lpLVDispInfo.item.iitem + 1)* gncols) + @lpLVDispInfo.item.iSubItem) end if end select end select end function '-------------------------------------------------------------------------------------- function ShowDIALOG1(byval hParent as dword) as long local lRslt as long local hDlg as dword dialog new pixels, hParent, gtitle, gX, gY, 400, 120, _ %ws_popup or %ws_border or %ws_dlgframe or %ws_sysmenu or _ %ws_clipsiblings or %ws_visible or %ds_modalframe or _ %ds_3dlook or %ds_nofailcreate or %ds_setfont, _ %ws_ex_controlparent or %ws_ex_left or %ws_ex_ltrreading or %ws_ex_rightscrollbar, _ to hDlg control add "SysListView32", hDlg, %IDC_LV, "SysListView32_1", 0, 0, 100, 111, _ %DEFAULT_LV_STYLES or %lvs_ownerdata, %DEFAULT_LV_EX_STYLES 'OR %LVS_OWNERDATA dialog show modal hDlg, call ShowDIALOG1Proc to lRslt function = lRslt end function '-------------------------------------------------------------------------------------- function mypopuplv alias "MyPopupLV"_ (title as string, X as long, Y as long, byval presults as dword, nrows as long, ncols as long, ColumnNames as string) _ export as long gX = X gY = Y gtitle = title gResultSetPtr = presults gColumnList = ColumnNames gnrows = nrows gncols = ncols redim gptable(0 to nrows*ncols-1) at presults function = ShowDIALOG1( %hwnd_desktop) end function '------------------------------------------------------------------------------- global ghInstance as dword global gszdbpath as asciz * %max_path '------------------------------------------------------------------------------- ' Main DLL entry point called by Windows... ' function libmain (byval hInstance as long, _ byval fwdReason as long, _ byval lpvReserved as long) as long select case fwdReason case %DLL_PROCESS_ATTACH 'Indicates that the DLL is being loaded by another process (a DLL 'or EXE is loading the DLL). DLLs can use this opportunity to 'initialize any instance or global data, such as arrays. ghInstance = hInstance InitCommonControls function = 1 'success! 'FUNCTION = 0 'failure! This will prevent the EXE from running. case %DLL_PROCESS_DETACH 'Indicates that the DLL is being unloaded or detached from the 'calling application. DLLs can take this opportunity to clean 'up all resources for all threads attached and known to the DLL. function = 1 'success! 'FUNCTION = 0 'failure! case %DLL_THREAD_ATTACH 'Indicates that the DLL is being loaded by a new thread in the 'calling application. DLLs can use this opportunity to 'initialize any thread local storage (TLS). function = 1 'success! 'FUNCTION = 0 'failure! case %DLL_THREAD_DETACH 'Indicates that the thread is exiting cleanly. If the DLL has 'allocated any thread local storage, it should be released. function = 1 'success! 'FUNCTION = 0 'failure! end select end functionLast edited by Chris Holbrook; 22 Oct 2009, 08:26 AM.
Leave a comment: