Code:
' DBTree: treeview for a SQLite database ' needs sqlite3.dll from www.sqlite.org ' uses SQLite3 PB wrappers from Jose Roca's website ' Chris Holbrook 20-MAY-2008 ' #COMPILE EXE #DIM ALL #INCLUDE "commctrl.inc" #INCLUDE "comdlg32.inc" #INCLUDE "\sqlite\work\SQLite3.inc" #INCLUDE "RICHEDIT.INC" $VERSION = "0.1" %IDC_TV = 1100 %IDC_BUTTON1 = 1101 ' dimensions of query results arrays %rows = 1 %columns = 2 ' GLOBAL gsDBPath, gDDLPath AS STRING GLOBAL ghDB AS DWORD GLOBAL gDBOpen AS LONG ' bool to indicate open status of database ' icons GLOBAL icon_table, icon_column, icon_index, icon_lh AS LONG '---------------------------------------------------------------------------------- ' icon identifiers for treeview imagelist %ico_lh = 1000 %ico_table = 1001 %ico_column = 1002 %ico_index = 1003 '------------------------------------------------------------------------------------ FUNCTION MakeFont(BYVAL fName AS STRING, BYVAL ptSize AS LONG, _ OPT BYVAL attr AS STRING) AS DWORD '-------------------------------------------------------------------- ' Create a desired font and return its handle. ' attr = "biu" for bold, italic, and underlined (any order) '-------------------------------------------------------------------- LOCAL hDC AS DWORD, CharSet AS LONG, CyPixels AS LONG LOCAL bold, italic, uLine AS LONG IF LEN(attr) THEN IF INSTR(LCASE$(attr), "b") THEN bold = %FW_BOLD IF INSTR(LCASE$(attr), "i") THEN italic = 1 IF INSTR(LCASE$(attr), "u") THEN uLine = 1 END IF hDC = GetDC(%HWND_DESKTOP) CyPixels = GetDeviceCaps(hDC, %LOGPIXELSY) ReleaseDC %HWND_DESKTOP, hDC PtSize = 0 - (ptSize * CyPixels) \ 72 FUNCTION = CreateFont(ptSize, 0, 0, 0, bold, italic, uLine, _ %FALSE, CharSet, %OUT_TT_PRECIS, _ %CLIP_DEFAULT_PRECIS, %DEFAULT_QUALITY, _ %FF_DONTCARE , BYCOPY fName) END FUNCTION ' ------------------------------------------------------ ' Egbert Zijlema's code to centre the dialog SUB CenterMainDialog(BYVAL hDlg AS DWORD, smeasure AS STRING) ' centers a dialog on the desktop LOCAL xScr AS LONG, yScr AS LONG, xDlg AS LONG, yDlg AS LONG xScr = GetSystemMetrics(%SM_CXSCREEN) yScr = GetSystemMetrics(%SM_CYSCREEN) IF smeasure = "UNITS" THEN DIALOG PIXELS hDlg, xScr, yScr TO UNITS xScr, yScr DIALOG GET SIZE hDlg TO xDlg, yDlg DIALOG SET LOC hDlg, (xScr - xDlg) / 2, (yScr - yDlg) / 2 END SUB '-------------------------------------------------------- ' Egbert Zijlema's code to measure a text string SUB GetTextDimensions(BYVAL hWnd AS DWORD, BYVAL sText AS STRING, cx AS LONG, cy AS LONG) LOCAL hDC AS DWORD, hFnt AS DWORD, hOldFt AS DWORD LOCAL siz AS SIZEL sText = sText & "W" hDC = GetDC(hWnd) hFnt = SendMessage (hWnd, %WM_GETFONT, 0, 0) hOldFt = SelectObject(hDC, hFnt) IF SetMapMode (hDC, %MM_TEXT) THEN GetTextExtentPoint32 hDC, BYVAL STRPTR(sText), LEN(sText), siz END IF SelectObject hDC, hOldFt ReleaseDC hWnd, hDC cx = siz.cx cy = siz.cy END SUB '---------------------------------------------------------------------- 'Check to see whether a file or directory exists. Found on the PB forums. FUNCTION IsDir(sObj AS STRING) AS DWORD ' If not a 2, then not a dir at least not one you can use. ' CASE 1: STDOUT "File" ' CASE 2: STDOUT "Dir" ' CASE 53: STDOUT "No such file/directory" ' CASE 70: STDOUT "Permission denied" ' CASE 75: STDOUT "No such volume" #REGISTER NONE LOCAL dwAttr AS DWORD, lErr AS DWORD ERRCLEAR dwAttr = GETATTR(sObj) lErr = ERR ! mov eax, lErr ;Error ! Or eax, eax ! jne Done ! mov eax, dwAttr ! And eax, 16 ! jz File Dir: ! mov eax, 2 ;dir ! jmp Done File: ! mov eax, 1 ;file Done: ! mov Function, eax END FUNCTION '-------------------------------------------------------------- FUNCTION SelDBFile (hD AS DWORD) AS STRING LOCAL buf, spath, sfile AS STRING LOCAL dwstyle AS DWORD LOCAL hFile AS LONG '------------------------ get database file dwStyle = %OFN_EXPLORER OR %OFN_FILEMUSTEXIST OR %OFN_HIDEREADONLY Buf = "Database files (*.SDB)|*.SDB|" 'spath = gddlpath IF OpenFileDialog (hD, "Locate SDB file ", sfile, spath, buf, "SDB", dwstyle) = 0 THEN EXIT FUNCTION ' returning null END IF FUNCTION = sfile END FUNCTION '------------------------------------------------------------------------------ ' thank you Chris Boss! SUB CopyToClipboard(BYVAL Txt AS STRING) LOCAL hClip AS LONG, lpAddress AS LONG Txt = Txt + CHR$(0) hClip=GlobalAlloc(%GMEM_MOVEABLE, LEN(Txt)) lpAddress=GlobalLock(hClip) POKE$ lpAddress, Txt GlobalUnlock hClip IF OpenClipboard(%NULL) THEN EmptyClipboard SetClipboardData %CF_TEXT, hClip CloseClipboard ELSE GlobalFree hClip END IF END SUB '--------------------------------------------------------------- '////////////////////////////////////////////////////////////////////////// '// Icon loading '////////////////////////////////////////////////////////////////////////// TYPE TAGICONDIR idReserved AS WORD '// Reserved (must be 0) idType AS WORD '// Resource Type (1 For icons) idCount AS WORD '// How many images? END TYPE TYPE TAGICONDIRENTRY bWidth AS BYTE '// Width, In Pixels, of the Image bHeight AS BYTE '// Height, In Pixels, of the Image bColorCount AS BYTE '// Number of colors In Image (0 If >=8bpp) bReserved AS BYTE '// Reserved ( must be 0) wPlanes AS WORD '// Color Planes wBitCount AS WORD '// Bits per pixel dwBytesInRes AS DWORD '// How many bytes In this resource? dwImageOffset AS DWORD '// Where In the file is this image? END TYPE '// Creates an icon using plain filedata, like the 766 Bytes .ICO files. '// Returns a iconhandle. FUNCTION SetIconFileBits( BYVAL lpMem AS LONG ) AS LONG DIM pIconDir AS TAGICONDIR PTR DIM IconDirEntry AS TAGICONDIRENTRY PTR pIconDir = lpMem IF @pIconDir.idCount < 1 THEN EXIT FUNCTION IconDirEntry = pIconDir + LEN( @pIconDir ) FUNCTION = CreateIconFromResource( _ BYVAL pIconDir + @IconDirEntry.dwImageOffset _ , @IconDirEntry.dwBytesInRes _ , @pIconDir.idType _ , &H30000& _ ) END FUNCTION '////////////////////////////////////////////////////////////////////////// '------------------------------------------------------------------------------- ' dbcolumn data FUNCTION BinBasColumn( ) AS DWORD LOCAL a AS LONG LOCAL t, t2 AS STRING FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a FOR a = 1 TO LEN( T ) STEP 2 T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) ) NEXT a FUNCTION = STRPTR(T2) DATA 0000010001001010100001000400280100001600000028000000100000002000000001 DATA 000400000000000000000000000000000000000000000000000000000000004080FF00 DATA 0000000000000000000000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000000000000011110011001111001 DATA 0000100101000001000010010100000100001001010000010000100101000001000010 DATA 0101000001111001100100000000000000000000000000000000000000000000000000 DATA 000000000000000000FFFF0000FFFF0000FFFF0000FFFF0000FFFF000086610000BDAF DATA 0000BDAF0000BDAF0000BDAF0000BDAF0000866F0000FFFF0000FFFF0000FFFF0000FF DATA FF0000 END FUNCTION '------------------------------------------------------------------------------- FUNCTION BinBasTable AS DWORD LOCAL a AS LONG LOCAL t, t2 AS STRING FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a FOR a = 1 TO LEN( T ) STEP 2 T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) ) NEXT a FUNCTION = STRPTR(T2) DATA 0000010001001010100001000400280100001600000028000000100000002000000001 DATA 00040000000000000000000000000000000000000000000000000000000000FF800000 DATA 80400000FF808000000000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000000000000000000011111113333 DATA 3300010000033333333001022223333333300100000333333330010222233333333001 DATA 0000033333333001022223333333300100000300000030010222222222201001000000 DATA 0000001001111111111111100100000000000010010000000000001001111111111111 DATA 100000000000000000FFFF000080030000BE010000A0010000BE010000A0010000BE01 DATA 0000A0010000BEFD0000A0050000BFFD000080010000BFFD0000BFFD000080010000FF DATA FF0000 END FUNCTION '------------------------------------------------------------------------------- FUNCTION BinBasIndex AS DWORD LOCAL a AS LONG LOCAL t, t2 AS STRING FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a FOR a = 1 TO LEN( T ) STEP 2 T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) ) NEXT a FUNCTION = STRPTR(T2) DATA 0000010001001010100001000400280100001600000028000000100000002000000001 DATA 000400000000000000000000000000000000000000000000000000000000004080FF00 DATA 0000000000000000000000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000001000000000000000010000000 DATA 0011111111000000001000001000000000100001000000000010000000000000001000 DATA 0000000000001000000000000000100000000000000010000000000000001000000000 DATA 000000000000000000FFFF0000FFC10000FFFD0000FFFD0000FFBD0000FFDD0000F00D DATA 0000F7DD0000F7BD0000F7FD0000F7FD0000F7FD0000F7FD0000F7FD0000F7C10000FF DATA FF0000 END FUNCTION '------------------------------------------------------------------------------- FUNCTION BinBasLH AS DWORD LOCAL a AS LONG LOCAL t, t2 AS STRING FOR a = 1 TO DATACOUNT: T = T & READ$( a ): NEXT a FOR a = 1 TO LEN( T ) STEP 2 T2 = T2 & CHR$( VAL( "&H" & MID$( T, a , 2 ) ) ) NEXT a FUNCTION = STRPTR(T2) DATA 0000010001001010100001000400280100001600000028000000100000002000000001 DATA 0004000000000000000000000000000000000000000000000000000000000000008000 DATA 0080000000B5FF00800000008000800080800000808080000000FF0000DD000000FFFF DATA 00FF2E2C00FF00FF00FFA37400C0C0C000FFFFFF00999999999999999999999999F0FF DATA FFBBBBFFFFFFFFFFFFBBBBFFFFFFFF1111BBBBFFFFFFFFBBBBBBBBBFFF0FFBBBBBBBBB DATA BFFFFFFBBBBBBBBBBFFFFFFBBBBBBBBBBBFFFFBBBBBBBBABBBFFFFBBBBBAAAAAABFFFF DATA BAAAAAAA333AA7A7AA333333AAABFFFFBAAAAAAAABBBBFFBBBBBBAAABBBBBBBBBBBBBB DATA BBBBBBBBBBBBBBBBBB0000000000000000000000000000000000000000000000000000 DATA 0000000000000000000000000000000000000000000000000000000000000000000000 DATA 000000 END FUNCTION '------------------------------------------------------------------------------- FUNCTION DBBTreeViewInsertItem(BYVAL hTree AS DWORD, BYVAL hParent AS DWORD, sItem AS STRING, licon AS LONG, bCB AS LONG) AS LONG LOCAL tTVItem AS TV_ITEM LOCAL tTVInsert AS TV_INSERTSTRUCT IF hParent THEN tTVItem.mask = %TVIF_CHILDREN OR %TVIF_HANDLE tTVItem.hItem = hParent tTVItem.cchildren = 1 TreeView_SetItem hTree, tTVItem END IF tTVInsert.hParent = hParent tTVInsert.Item.Item.mask = %TVIF_TEXT OR %TVIF_IMAGE OR %TVIF_SELECTEDIMAGE OR %TVIF_STATE OR %TVIF_HANDLE tTVInsert.Item.Item.pszText = STRPTR(sItem) tTVInsert.Item.Item.cchTextMax = LEN(sItem) ttvinsert.Item.Item.iImage = licon ttvinsert.Item.Item.iSelectedImage = licon ttvinsert.Item.Item.stateMask = %TVIS_STATEIMAGEMASK ' so we can change the checkbox state SHIFT LEFT BCB, 12 ttvinsert.Item.Item.state = bCB ' expect 0 for no CB 1 for unchecked FUNCTION = TreeView_InsertItem(hTree, tTVInsert) END FUNCTION '------------------------------------------------------------------------------ ' execute SQL against database & return rows in a string array ' parameters: 1st is DB handle, ' 2nd, SQL to execute, ' 3rd, max # of rows to return, ' 4th, ptr to 1st element of array to populate ' NB 1st row is index 1 and contains column names! ' returned value is the error code ' 0 = OK ' -1 = prepare error ' -2 = counting error ' -3 = re-prepare error ( after counting) ' FUNCTION SQL2array ( hDB AS LONG, sSQL AS STRING, lmax AS LONG, sResults() AS STRING) AS LONG LOCAL lresult AS LONG LOCAL lchunksize AS LONG LOCAL pzTail AS ASCIZ PTR ' unprocessed tail of SQL statement, apparently ' I suspect that the sqlite engine now handles ' a query string including comments & whitespace ' and that this is redundant. But I'm not certain. LOCAL pzPrepared AS ASCIZ PTR ' the tokenized query LOCAL pzErmsg AS ASCIZ PTR LOCAL azcols() AS ASCIZ PTR ' array of dword pointers to column name strings LOCAL azvals() AS ASCIZ PTR ' array of dword pointers to column values LOCAL ncols AS LONG ' the column count LOCAL s AS STRING LOCAL i, l AS LONG LOCAL lrowcount, lrowlimit AS LONG ' lresult = sqlite3_prepare ( hDB, BYVAL STRPTR(sSQL), -1, pzPrepared, pzTail) IF lresult <> %SQLITE_OK THEN GOTO PrepFailed IF pzPrepared = 0 THEN GOTO PrepFailed ncols = sqlite3_column_count(pzPrepared) REDIM azvals(0 TO ncols-1) REDIM azcols(0 TO ncols-1) ' get column names FOR i = 0 TO ncols -1 azcols(i) = sqlite3_column_name(pzPrepared, i) NEXT WHILE 1 = 1 lresult = sqlite3_step(pzPrepared) SELECT CASE lresult CASE %SQLITE_ROW INCR lrowcount ' if the limit is exceeded, don't bother counting the rest! IF lmax > 0 THEN IF lrowcount >= lmax THEN GOTO DoneCounting END IF ' CASE %SQLITE_DONE INCR lrowcount GOTO DoneCounting ' CASE ELSE FUNCTION = -2 EXIT FUNCTION END SELECT WEND DoneCounting: lrowlimit = lrowcount REDIM sResults(0 TO ncols-1, 0 TO lrowcount) ' column names in 0th row FOR i = 0 TO ncols -1 sresults(i, 0) = @azcols(i) NEXT lrowcount = 1 ' 0'th element is for column names ' get the table again now we know how many rows to get lresult = sqlite3_prepare ( hDB, BYVAL STRPTR(sSQL), -1, pzPrepared, pzTail) IF lresult <> %SQLITE_OK THEN GOTO RePrepFailed IF pzPrepared = 0 THEN GOTO RePrepFailed WHILE 1 IF lrowcount = lrowlimit THEN GOTO Finish lresult = sqlite3_step(pzPrepared) SELECT CASE lresult CASE %SQLITE_ROW FOR i = 0 TO ncols - 1 azvals(i) = sqlite3_column_text(pzPrepared, i) sresults(i, lrowcount) = @azvals(i) NEXT INCR lrowcount ' if the limit is exceeded, don't bother counting the rest! IF lrowcount >= lrowLimit THEN GOTO Finish ' CASE %SQLITE_DONE INCR lrowcount GOTO Finish ' CASE ELSE FUNCTION = -2 EXIT FUNCTION END SELECT WEND ''''''''''''''' PrepFailed: FUNCTION = -1 EXIT FUNCTION RePrepFailed: FUNCTION = -3 EXIT FUNCTION finish: EXIT FUNCTION END FUNCTION '------------------------------------------------------------------------------ FUNCTION DBTreeView(ghDB AS LONG, BYVAL hDlg AS DWORD, BYVAL lID AS LONG) AS LONG LOCAL i AS LONG LOCAL j AS LONG LOCAL k AS LONG LOCAL hCtl AS DWORD LOCAL hRoot, hParent, hchild AS DWORD LOCAL s, sSQL AS STRING LOCAL stablelistSQL, sColumnListSQL, sIndexListSQL, sIndexInfoSQL AS STRING stableListSQL = "select name from sqlite_master where type = 'table'" sIndexListSQL = "select name from sqlite_master where type = 'index' and tbl_name = '@@@@@'" sColumnListSQL = "select * from @@@@@" LOCAL sTableList() AS STRING : REDIM sTableList() LOCAL sIndexList() AS STRING : REDIM sIndexList() LOCAL sColumnList() AS STRING : REDIM sColumnList() sql2Array ( ghDB, stableListSQL, 0, sTableList()) ' load table list CONTROL HANDLE hDlg, lID TO hCtl FOR i = 1 TO UBOUND(sTableList, %columns) -1 ' 0th row holds the column name sSQL = sIndexListSQL REPLACE "@@@@@" WITH sTableList(0, i) IN sSQL sql2Array ( ghDB, sSQL, 0, sIndexList())' load index list for table hRoot = DBBTreeViewInsertItem(hCtl, %NULL, sTableList(i, 0), 1, 3)' insert table in tree no CB IF UBOUND(sIndexList, %columns) > 1 THEN hParent = DBBTreeViewInsertItem(hCtl, hRoot, "", 3, 3)' index, no CB FOR k = 1 TO UBOUND(sIndexList, %columns) -1 hchild = DBBTreeViewInsertItem(hCtl, hparent, sIndexList( k, 0), 2, 3)' column, no CB NEXT END IF ' 'hParent = DBBTreeViewInsertItem(hCtl, hRoot, "check all columns", %ico_wildcard, 3) ' wildcard, no CB ' ' sSQL = sColumnListSQL REPLACE "@@@@@" WITH sTableList(0, i) IN sSQL sql2Array ( ghDB, sSQL, 1, sColumnList())' load index list for table FOR j = 0 TO UBOUND(sColumnList, %rows) hchild = DBBTreeViewInsertItem(hCtl, hroot, sColumnList(j, 0), 2, 3)' columnname NEXT NEXT i END FUNCTION '-------------------------------------------------------------------------------- SUB Open_Database ( hd AS DWORD ) LOCAL sz AS ASCIZ * 512 ' can only call sqlite3_close once! IF gDBOPEN = 1 THEN sqlite3_close(ghDB) ' in case one is already open ' choose a DB sz = SelDBFile(hD) IF sqlite3_open( sz, BYREF ghDB) <> %SQLITE_OK THEN ? "unable to open database", %mb_applmodal,"Warning" gDBOPEN = 0 EXIT SUB END IF gDBOPEN = 1 END SUB '------------------------------------------------------------------------------ SUB addTreeView ( hD AS DWORD, x AS LONG, y AS LONG) CONTROL ADD "SysTreeView32", hD,%IDC_TV, "SysTreeView32_1", _ 0, 0, x, y, _ %WS_CHILD OR %WS_VISIBLE OR %WS_TABSTOP OR _ %TVS_HASBUTTONS OR %TVS_HASLINES _ 'OR %TVS_CHECKBOXES _ OR %TVS_LINESATROOT OR %TVS_SHOWSELALWAYS, _ %WS_EX_CLIENTEDGE OR %WS_EX_LEFT OR _ %WS_EX_LTRREADING OR %WS_EX_RIGHTSCROLLBAR END SUB '------------------------------------------------------------------------------ CALLBACK FUNCTION DBBrowser_dialogProc() STATIC hmenu, hparent, hTVWnd, hedit AS DWORD LOCAL r AS rect LOCAL s, s1 AS STRING LOCAL hfile, i, l, lresult, x, y AS LONG LOCAL sz AS ASCIIZ*8192 LOCAL psz AS ASCIZ PTR LOCAL lpTV AS NM_TREEVIEW PTR LOCAL treeItem AS TV_ITEM LOCAL pTVITEM AS tv_item PTR STATIC hTreeImgLst AS LONG LOCAL hOldFnt AS DWORD, szText AS ASCIIZ * 128 LOCAL dis AS DRAWITEMSTRUCT PTR, hPen AS DWORD, hBrush AS DWORD LOCAL rc AS RECT LOCAL oldbkmode, oldTxtClr AS LONG SELECT CASE AS LONG CBMSG CASE %WM_INITDIALOG CASE %WM_SYSCOMMAND SELECT CASE CBCTL CASE %SC_MINIMIZE DIALOG SHOW STATE CBHNDL, %SW_MINIMIZE FUNCTION = 1 EXIT FUNCTION END SELECT CASE %wm_size IF CBWPARAM <> %SIZE_MINIMIZED THEN DIALOG GET CLIENT CBHNDL TO x, y CONTROL SET SIZE CBHNDL, %IDC_TV, x, y - 20 CONTROL SET LOC CBHNDL, %IDC_BUTTON1, 5, y - 18 END IF CASE %WM_LBUTTONDOWN SendMessage CBHNDL, %WM_NCLBUTTONDOWN, %HTCAPTION, BYVAL %NULL ' force drag ' CASE %WM_COMMAND SELECT CASE CBCTL CASE %IDC_BUTTON1 IF CBCTLMSG = %BN_CLICKED OR CBCTLMSG = 1 THEN sqlite3_close(ghdb) open_database(CBHNDL) CONTROL KILL CBHNDL, %IDC_TV DIALOG GET CLIENT CBHNDL TO x, y addTreeView ( CBHNDL, x, y - 20 ) hTVWnd = getdlgitem(CBHNDL, %IDC_TV ) ' Add icons to image list hTreeImgLst = ImageList_Create(16, 16, %ILC_COLOR32 OR %ILC_MASK, 4, 1) l = GetModuleHandle(BYVAL 0) lresult = ImageList_AddIcon (hTreeImgLst, icon_LH) lresult = ImageList_AddIcon (hTreeImgLst, icon_table) lresult = ImageList_AddIcon (hTreeImgLst, icon_column) lresult = ImageList_AddIcon (hTreeImgLst, icon_index) ' Add image list to TreeView CONTROL SEND CBHNDL, %IDC_TV, %TVM_SETIMAGELIST, %TVSIL_NORMAL, hTreeImgLst DBTreeView(ghDB, CBHNDL, %IDC_TV ) END IF END SELECT ' CASE %WM_DESTROY END SELECT END FUNCTION '------------------------------------------------------------------------------ FUNCTION DBBrowser(BYVAL hParent AS DWORD) AS LONG LOCAL hfont, hfont1, lRslt, x, y AS LONG LOCAL hDlg AS DWORD LOCAL s AS STRING DIALOG NEW hParent, "DBTree for SQLite V" + $version, _ 50, 50, 180, 224, _ %WS_POPUP OR %WS_THICKFRAME OR _ %WS_CLIPSIBLINGS OR %WS_VISIBLE OR %WS_SYSMENU OR %WS_MINIMIZEBOX OR _ %DS_NOFAILCREATE OR %WS_CAPTION OR %DS_SETFONT, _ %WS_EX_CONTROLPARENT TO hdlg centermaindialog(hdlg, "UNITS") ' mDKW_DLG (HDLG) DIALOG SET COLOR hDlg, -1, RGB(155, 255, 255) DIALOG SEND hDlg, %WM_SETICON, %ICON_SMALL, icon_LH DIALOG GET CLIENT hDlg TO x, y CONTROL ADD BUTTON, hDlg, %IDC_BUTTON1, "Select Database", _ 5, y - 18, 68, 15, _ %WS_CHILD OR %WS_VISIBLE addTreeView ( hDlg, x, y) '------------------------------------------------------------------ ' create a fixed-width font as default for LV & editbox '------------------------------------------------------------------ 'fontName = "Courier New": fontSize = 8 hFont = MakeFont("Courier New", 9) hFont1 = MakeFont("Courier New", 8) ' CONTROL SEND hDlg, %IDC_QR_STATS, %WM_SETFONT, hFont1, 0 DIALOG SHOW MODAL hDlg, CALL DBBrowser_dialogProc TO lRslt deleteObject hFont deleteObject hFont1 FUNCTION = lRslt END FUNCTION ' ------------------------------------------------------------------------- SUB LoadIcons ' BinBasLH T1 Icon_LH = SetIconFileBits(BinBasLH) Icon_Table = SetIconFileBits(BinBasTable) Icon_Column = SetIconFileBits(BinBasColumn) Icon_INdex = SetIconFileBits(BinBasIndex) END SUB '================================================================================= FUNCTION PBMAIN () AS LONG InitCommonControls LoadIcons ' dbbrowser(0) IF icon_LH THEN destroyicon(icon_LH) IF icon_table THEN destroyicon(icon_table) IF icon_column THEN destroyicon(icon_column) IF icon_index THEN destroyicon(icon_index) END FUNCTION
Comment