Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Treeview for a SQLite database with icons

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Treeview for a SQLite database with icons

    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

  • #2
    bug fix, better hadling of BinBas icon data

    NB there are now 2 seperate source files, both in this post.

    Code:
    ' DBTree: treeview for a SQLite database
    ' uses SQLite3 PB wrappers from Jose Roca's website
    ' Chris Holbrook 20-MAY-2008
    '
    ' change history
    '  22-5-2008 CJH now handles indexes & index columns correctly
    '                Icon stuff moved to DBTreeBBICO.inc
    '                Icons handled via macro
    '                spurious include for RICHEDIT.INC removed
    '
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "commctrl.inc"
    #INCLUDE "comdlg32.inc"
    #INCLUDE "SQLite3.inc"
    '#INCLUDE "RICHEDIT.INC"
    #INCLUDE "DBTreeBBICO.inc"
    $VERSION = "0.11"
    
    %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, icon_dot 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
    '-------------------------------------------------------------------------------
    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, j, k, l, m AS LONG
        LOCAL hCtl    AS DWORD
        LOCAL hRoot, hParent, hchild AS DWORD
        LOCAL s, sSQL AS STRING
        LOCAL stablelistSQL, sColumnListSQL, sIndexListSQL, sIndexColumnListSQL 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 @@@@@"
        sIndexColumnListSQL  = "pragma index_info ( @@@@@ )"
        LOCAL sTableList() AS STRING : REDIM sTableList()
        LOCAL sIndexList() AS STRING : REDIM sIndexList()
        LOCAL sColumnList() AS STRING : REDIM sColumnList()
        LOCAL sIndexColumnList() AS STRING : REDIM sIndexColumnList()
        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
                FOR k = 1 TO UBOUND(sIndexList, %columns) -1
                    hparent  = DBBTreeViewInsertItem(hCtl, hRoot, sIndexList( k, 0), 3, 3)' index, no CB
                    sSQL = sIndexColumnListSQL
                    REPLACE "@@@@@" WITH sIndexList(k, 0) IN sSQL
                    sql2Array ( ghDB, sSQL, 0, sIndexColumnList())' load index list for table
                    FOR l = 1 TO UBOUND(sIndexColumnList, %columns) - 1
                        hchild   = DBBTreeViewInsertItem(hCtl, hParent, sIndexColumnList( 2, l), 2, 3)' index, no CB
                    NEXT
                NEXT
            END IF
    '        '
            sSQL = sColumnListSQL
            REPLACE "@@@@@" WITH sTableList(0, i) IN sSQL
            sql2Array ( ghDB, sSQL, 1, sColumnList())' load column 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)           '0 = LH
                            lresult = ImageList_AddIcon (hTreeImgLst, icon_table)        '1 = table
                            lresult = ImageList_AddIcon (hTreeImgLst, icon_column)       '2 = column
                            lresult = ImageList_AddIcon (hTreeImgLst, icon_index)        '3 = index
                            lresult = ImageList_AddIcon (hTreeImgLst, icon_dot)          '4 = dot
                            ' 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)
        'Icon_dot    = SetIconFileBits(BinBasDot)
    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)
        'IF icon_dot  THEN destroyicon(icon_dot)
    END FUNCTION
    and the include file DBTreeBBICO.inc

    Code:
    ' Icon stuff for DBTree v0.11
    '---------------------------------------------------------------
    '//////////////////////////////////////////////////////////////////////////
    '// 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
    
    
    '//////////////////////////////////////////////////////////////////////////
    MACRO mBinDataStuff
        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)
    END MACRO
    '-------------------------------------------------------------------------------
    ' dbcolumn data
    FUNCTION BinBasColumn( ) AS DWORD
        mBinDataStuff
    
    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
    
         mBinDataStuff
    
    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
    
        mBinDataStuff
    
    DATA 0000010001001010100001000400280100001600000028000000100000002000000001
    DATA 000400000000000000000000000000000000000000000000000000000000000000FF00
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 0000000000000000000000000000000000000000000000000000000000000100000000
    DATA 0000000010000000011111111100000001000000100000000100000100000000010000
    DATA 0000000000010000000000000001000000000000000100000000000000010000000000
    DATA 000000000000000000FFFF0000FF810000FFFD0000FFFD0000FFFD0000FFBD0000FFDD
    DATA 0000E00D0000EFDD0000EFBD0000EFFD0000EFFD0000EFFD0000EFFD0000EF810000FF
    DATA FF0000
    
    END FUNCTION
    
    '-------------------------------------------------------------------------------
    FUNCTION BinBasLH AS DWORD
    
        mBinDataStuff
    
    DATA 0000010001001010100001000400280100001600000028000000100000002000000001
    DATA 0004000000000000000000000000000000000000000000000000000000000000008000
    DATA 0080000000B5FF00800000008000800080800000808080000000FF0000DD000000FFFF
    DATA 00FF2E2C00FF00FF00FFA37400C0C0C000FFFFFF00999999999999999999999999F0FF
    DATA FFBBBBFFFFFFFFFFFFBBBBFFFFFFFF1111BBBBFFFFFFFFBBBBBBBBBFFF0FFBBBBBBBBB
    DATA BFFFFFFBBBBBBBBBBFFFFFFBBBBBBBBBBBFFFFBBBBBBBBABBBFFFFBBBBBAAAAAABFFFF
    DATA BAAAAAAA333AA7A7AA333333AAABFFFFBAAAAAAAABBBBFFBBBBBBAAABBBBBBBBBBBBBB
    DATA BBBBBBBBBBBBBBBBBB0000000000000000000000000000000000000000000000000000
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 000000
    
    END FUNCTION
    '-------------------------------------------------------------------------------
    FUNCTION BinBasDot AS DWORD
    
        mBinDataStuff
    DATA 0000010001001010100001000400280100001600000028000000100000002000000001
    DATA 000400000000000000000000000000000000000000000000000000000000004080FF00
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 0000000000000000000000000000000000000000000000000000000000000000000000
    DATA 0000000000111100000000000111111000000000111111110000000111111111100000
    DATA 0111111111100000111111111111000011111111111100001111111111110000011111
    DATA 1111100000011111111110000000111111110000000000111100000000000000000000
    DATA 000000000000000000FFFF0000FFFF0000FC3F0000F81F0000F00F0000E0070000E007
    DATA 0000C0030000C0030000C0030000E0070000E0070000F00F0000FC3F0000FFFF0000FF
    DATA FF0000
    
    END FUNCTION

    Comment

    Working...
    X