Tweet
Code:
#COMPILE EXE
#DIM ALL
' This application is just to try out storing images in a SQLite database
' and uses the GDIplus library to manipulate the images. It's not a
' masterclass, more of an exploration!
'
' How to use
' 1. download the sqlite3.dll from the downloads page
' at www.sqlite.org into the same directory as the executable.
' 2. Change the database path in the PBMAIN to suit your system.
' It has to be the full path.
' 3. Compile under PB Windows 8.04
'
' tested on Windows XP
'
' May be used or copied at your own risk.
'
' PLAN B
' -------
'FILE <<<<<<< APP >>>>>>> DB <<<<<<<<<<< APP >>>>>>>>>>
'image file -> -------------------------> blob ---------> temp image file
' | |
' | istream
' | |
' +------------------> GDI+ image <------------------------+
'
' we're on PLAN B!!
'
' It would be good to get rid of the temporary file and load direct from the blob
' into the stream, but I don't know how to - suggestions welcome!
'
#INCLUDE "WIN32API.INC"
#INCLUDE "comdlg32.inc"
#INCLUDE "sqlite3.inc"
%IDD_DIALOG1 = 101
%IDC_getpic_bn = 1004
%IDC_picDB_bn = 1005
%IDC_savepicDB_bn = 1006
%IDC_LABEL3 = 1007
%IDC_LABEL4 = 1008
%IDC_LISTBOX1 = 1009
'------------------------------------------------------------------------------
' GDI+ status (error) codes
%StatusOk = 0
%StatusGenericError = 1
%StatusInvalidParameter = 2
%StatusOutOfMemory = 3
%StatusObjectBusy = 4
%StatusInsufficientBuffer = 5
%StatusNotImplemented = 6
%StatusWin32Error = 7
%StatusWrongState = 8
%StatusAborted = 9
%StatusFileNotFound = 10
%StatusValueOverflow = 11
%StatusAccessDenied = 12
%StatusUnknownImageFormat = 13
%StatusFontFamilyNotFound = 14
%StatusFontStyleNotFound = 15
%StatusNotTrueTypeFont = 16
%StatusUnsupportedGdiplusVersion = 17
%StatusGdiplusNotInitialized = 18
%StatusPropertyNotFound = 19
%StatusPropertyNotSupported = 20
'---------------------------------------------------------------------
TYPE GdiplusStartupInput
GdiplusVersion AS DWORD '// Must be 1
DebugEventCallback AS DWORD '// Ignored on free builds
SuppressBackgroundThread AS LONG '// FALSE unless you're prepared to call
'// the hook/unhook functions properly
SuppressExternalCodecs AS LONG '// FALSE unless you want GDI+ only to use
'// its internal image codecs.
END TYPE
'---------------------------------------------------------------------
'
TYPE GdiplusStartupOutput
' // The following 2 fields are NULL if SuppressBackgroundThread is FALSE.
' // Otherwise, they are functions which must be called appropriately to
' // replace the background thread.
' //
' // These should be called on the application's main message loop - i.e.
' // a message loop which is active for the lifetime of GDI+.
' // "NotificationHook" should be called before starting the loop,
' // and "NotificationUnhook" should be called after the loop ends.
NotificationHook AS DWORD
NotificationUnhook AS DWORD
END TYPE
'
DECLARE FUNCTION GdipDrawImageRectI LIB "gdiplus.dll" ALIAS "GdipDrawImageRectI" (BYVAL graphics AS LONG, BYVAL nImage AS LONG, BYVAL x AS LONG, BYVAL y AS LONG, BYVAL nWidth AS LONG, BYVAL Height AS LONG) AS LONG
DECLARE FUNCTION GdipDeleteGraphics LIB "gdiplus.dll" ALIAS "GdipDeleteGraphics" (BYVAL graphics AS LONG) AS LONG
DECLARE FUNCTION GdipCreateFromHDC LIB "gdiplus.dll" ALIAS "GdipCreateFromHDC" (BYVAL hdc AS LONG, graphics AS LONG) AS LONG
DECLARE FUNCTION GdipGetImagePixelFormat LIB "gdiplus.dll" ALIAS "GdipGetImagePixelFormat" _
(BYVAL nImage AS LONG, PixelFormat AS LONG) AS LONG
DECLARE FUNCTION GdipGetImageDimension LIB "gdiplus.dll" ALIAS "GdipGetImageDimension" _
(BYVAL nImage AS LONG, nWidth AS SINGLE, Height AS SINGLE) AS LONG
DECLARE FUNCTION GdiplusStartup LIB "GDIPLUS.DLL" ALIAS "GdiplusStartup" _
(token AS DWORD, inputbuf AS GdiplusStartupInput, outputbuf AS GdiplusStartupOutput) AS LONG
DECLARE SUB GdiplusShutdown LIB "GDIPLUS.DLL" ALIAS "GdiplusShutdown" _
(BYVAL token AS DWORD)
DECLARE FUNCTION GdipLoadImageFromFile LIB "GDIPLUS.DLL" ALIAS "GdipLoadImageFromFile" _
(BYVAL flname AS STRING, lpImage AS DWORD) AS LONG
DECLARE FUNCTION GdipGraphicsClear LIB "gdiplus.dll" ALIAS "GdipGraphicsClear" _
(BYVAL graphics AS LONG, BYVAL lColor AS LONG) AS LONG
DECLARE FUNCTION GdipDisposeImage LIB "GDIPLUS.DLL" ALIAS "GdipDisposeImage" _
(BYVAL lpImage AS DWORD) AS LONG
DECLARE FUNCTION GdipLoadImageFromStream LIB "gdiplus.dll" ALIAS "GdipLoadImageFromStream" _
(BYVAL pStream AS DWORD, BYREF pImage AS DWORD) AS LONG
DECLARE SUB skIconise (BYVAL xPic AS LONG, BYVAL yPic AS LONG, _ picture dimensions
BYVAL xCell AS LONG, BYVAL yCell AS LONG, _ FRAME dimensions
BYREF xOfs AS LONG, BYREF yOfs AS LONG, _ calc'd offset in frame
BYREF xSize AS LONG, BYREF ySize AS LONG) ' thumbnail dimensions
DECLARE FUNCTION CreateStreamOnHGlobal LIB "ole32.dll" ALIAS "CreateStreamOnHGlobal" _
(BYVAL hGlobal AS DWORD, BYVAL fDeleteOnRelease AS DWORD, pstm AS DWORD) AS LONG
GLOBAL gsPicPath AS STRING ' current image file
GLOBAL gszDBpath AS ASCIZ * 256 ' DB path must be full path! initialised in PBMAIN
GLOBAL ghDB AS DWORD ' PIX database handle
GLOBAL ghPicWnd AS DWORD ' handle of image dialog
GLOBAL ghImage AS DWORD ' handle of current image
'
TYPE process_memory_counters
cb AS DWORD '// size of the structure, in bytes.
pagefaultcount AS DWORD '// number of page faults.
peakworkingsetsize AS DWORD '// peak working set size.
workingsetsize AS DWORD '// current working set size.
quotapeakpagedpoolusage AS DWORD '// peak paged pool usage.
quotapagedpoolusage AS DWORD '// current paged pool usage.
quotapeaknonpagedpoolusage AS DWORD '// peak nonpaged pool usage.
quotanonpagedpoolusage AS DWORD '// current nonpaged pool usage.
pagefileusage AS DWORD '// current space allocated for the pagefile.
'// those pages may or may not be in memory.
peakpagefileusage AS DWORD '// peak space allocated for the pagefile.
END TYPE
DECLARE FUNCTION GetProcessMemoryInfo LIB "PSAPI.DLL" ALIAS "GetProcessMemoryInfo" ( _
BYVAL hProcess AS DWORD, _
ppsmemCounters AS PROCESS_MEMORY_COUNTERS, _
BYVAL cb AS DWORD _
) AS LONG
'---------------------------------------------------------------------------------
FUNCTION CurrentProcessMemory() AS LONG
LOCAL tMC AS Process_Memory_Counters
tMC.cb = SIZEOF(tMC)
IF GetProcessMemoryInfo(GetCurrentProcess, BYVAL VARPTR(tMC), SIZEOF(tMC)) THEN
FUNCTION = tMC.WorkingSetSize
ELSE
FUNCTION = -1
END IF
END FUNCTION
'--------------------------------------------------------------------
TYPE tQuerystuff ' query attributes
' hDB AS DWORD ' database handle
hWnd AS DWORD ' window handle
pszSQL AS ASCIZ PTR ' pointer to query string
nQrows AS LONG ' # of rows returned by last query
nQcols AS LONG ' # of columns returned by last query
pQresults AS DWORD ' ptr to array of ptrs provided by sqlite3_get_table
pQzErms AS ASCIZ PTR ' ptr to sqlite3 error message
selection AS STRING * 1024 ' string of selected data
pBlobData AS DWORD ' ptr to blob data in application (not in SQLite)
lBlobBuffersize AS LONG ' length of blob buffer
END TYPE
'-------------------------------------------------------------------------------------------------------
' Computes location and size to stretch a bitmap preserving its aspect.
'
SUB skIconise (BYVAL xPic AS LONG, BYVAL yPic AS LONG, _ picture dimensions
BYVAL xCell AS LONG, BYVAL yCell AS LONG, _ FRAME dimensions
BYREF xOfs AS LONG, BYREF yOfs AS LONG, _ calc'd offset in frame
BYREF xSize AS LONG, BYREF ySize AS LONG) EXPORT ' thumbnail dimensions
LOCAL SCALE AS SINGLE
IF xPIC& THEN scale! = xCell& / xPic&
IF scale! > 1 THEN scale! = 1
xSize& = xPic& * scale!: ySize& = yPic& * scale!
' In case Height > 150 compute new scale factor
IF ySize& > yCell& THEN
IF yPic& THEN scale! = yCell& / yPic&
xSize& = xPic& * scale!: ySize& = yPic& * scale!
END IF
xOfs& = (xCell& - xSize&) \ 2
yOfs& = (yCell& - ySize&) \ 2
END SUB
'---------------------------------------------------------------------
' calls COM object's release method to decrement the reference count
FUNCTION IUnknown_Release (BYVAL pthis AS DWORD PTR) AS DWORD
LOCAL DWRESULT AS DWORD
IF pthis THEN
CALL DWORD @@pthis[2] USING IUnknown_Release(pthis) TO DWRESULT
FUNCTION = DWRESULT
END IF
END FUNCTION
'---------------------------------------------------------------------
' get a jpg filename
FUNCTION getpic (hD AS LONG) 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 = "Picture files (*.JPG)|*.JPG|"
'IF gddlpath <> "" THEN spath = gddlpath
IF OpenFileDialog (hD, "Locate JPG file ", sfile, spath, buf, "JPG", dwstyle) = 0 THEN
EXIT FUNCTION
END IF
FUNCTION = sfile
END FUNCTION
'--------------------------------------------------------------------
FUNCTION sqlErrMsg( BYVAL hDB AS LONG ) AS DWORD ' ptr to asciz error msg
DIM pzErr AS ASCIIZ PTR
' get the SQLite error message
pzErr = sqlite3_errmsg(hDB)
FUNCTION = pzErr
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION DoSQL ( BYVAL dwQStuff AS DWORD) AS LONG
LOCAL pQstuff AS tQueryStuff PTR
LOCAL lresult AS LONG
LOCAL s AS STRING
LOCAL pszErms, pszQuery, psz AS ASCIZ PTR
pQstuff = dwQstuff
psz = @pQstuff.pszSQL
s = @psz
' if the last query using this buffer has not been freed, free it!
IF @pQstuff.pQresults <> 0 THEN
sqlite3_free_table(@pQstuff.pQresults)
@pQstuff.pQresults = 0
END IF
' ? "DB=" + str$(@pQstuff.hDB) + " query= " + s, %MB_TASKMODAL,"debug"
lresult = sqlite3_get_table(BYVAL ghdb, BYVAL @pQstuff.pszSQL, @pQstuff.pQresults, @pQstuff.nQrows, @pQstuff.nQcols, BYVAL @pQstuff.pQzErms)
FUNCTION = lresult
IF lresult <> %SQLITE_OK THEN
pszErms = SQLErrMsg(ghdb)
pszQuery = @pQstuff.pszSQL
? TRIM$(@pszErms) + $CRLF + _
"SQL was: " + @pszQuery + $CRLF
sqlite3_free ( @pQstuff.pQzErms)
END IF
END FUNCTION
'----------------------------------------------------------------------------
' write the image file to pictures table
' first parameter is pointer to a buffer containing the image
' second parameter is image buffer length
FUNCTION ImgFile2Blob ( BYVAL psBuffer AS DWORD, imagesize AS LONG) AS LONG
LOCAL hfile AS LONG
LOCAL sbuffer AS STRING
LOCAL i, lresult AS LONG
LOCAL Qstuff AS tQueryStuff
LOCAL ppStmt AS DWORD
LOCAL psz1, psz2, pzTail, pszErms, pszQuery AS ASCIZ PTR
LOCAL sSQL AS STRING
LOCAL pzresults() AS ASCIZ PTR
'
IF gspicpath = "" THEN
? "That image is already in the database!" _
+ $CRLF + $CRLF + "no action!",%MB_TASKMODAL,"warning"
FUNCTION = 1
EXIT FUNCTION
END IF
sSQL = "create table if not exists pictures (key, content blob)"
Qstuff.pszSQL = STRPTR(sSQL)
IF DoSQL (BYVAL VARPTR(Qstuff)) <> %SQLITE_OK THEN
FUNCTION = 3
GOTO done
END IF
' does the key supplied already exist? if so, warn & exit
sSQL = "select count(1) from pictures where key = '" + PARSE$(gspicpath,"\",-1) + "'"
Qstuff.pszSQL = STRPTR(sSQL)
IF DoSQL (BYVAL VARPTR(Qstuff)) <> %SQLITE_OK THEN
FUNCTION = 4
GOTO done
END IF
DIM pzresults(0 TO Qstuff.nQrows * Qstuff.nQcols -1) AS ASCIZ PTR AT QStuff.pQResults
IF VAL(TRIM$( @pzresults(1))) > 0 THEN
? "database already contains an image of that name (" + PARSE$(gspicpath,"\",-1) + ")!" _
+ $CRLF + $CRLF + "no action!",%MB_TASKMODAL,"warning"
FUNCTION = 5
EXIT FUNCTION
END IF
sqlite3_free_table(Qstuff.pQResults)
' write the bitmap thus extracted into bitbuffer to the database
sSQL = "insert into pictures values (?,?)"
i = INSTR(sSQL, "?")
sSQL = LEFT$(sSQL, i - 1) + "'" + PARSE$(gspicpath,"\",-1) + "'" + MID$(sSQL, i + 1)
lresult = sqlite3_prepare_v2(BYVAL ghDB, BYVAL STRPTR(sSQL), BYVAL -1, ppStmt, pzTail)
IF lresult <> %SQLITE_OK THEN
psz1 = SQLErrMsg(ghDB)
? "savePic:" + TRIM$(@psz1) + $CRLF + _
"SQL was: " + sSQL + $CRLF,%MB_TASKMODAL,"warning"
sqlite3_free ( Qstuff.pQzErms)
FUNCTION = 6
GOTO done
END IF
lresult = sqlite3_bind_blob( ppStmt, 1, BYVAL psbuffer, imagesize, %SQLITE_STATIC )
GOSUB checkresult
DO
sqlite3_step(ppStmt)
IF lresult <> %SQLITE_ROW THEN EXIT LOOP
LOOP
GOSUB checkresult
lresult = sqlite3_reset(ppStmt)
GOSUB checkresult
done:
EXIT FUNCTION
checkresult:
IF lresult <> %SQLITE_OK THEN
? "Error binding SQLite variable! " + STR$(lresult), %MB_TASKMODAL,"Warning"
END IF
RETURN
END FUNCTION
'------------------------------------------------------------------------
CALLBACK FUNCTION PicDlgCB()
STATIC ghimage AS DWORD
LOCAL hDC, pgraphics AS DWORD
LOCAL r AS rect
LOCAL W, H, lPixelFormat AS LONG
LOCAL l, framex, framey AS LONG
STATIC ofsx, ofsy, tX, tY AS LONG
LOCAL maxwidth, maxheight AS LONG
LOCAL origwidth, origheight AS SINGLE
STATIC sGDIPStatusCodes() AS STRING ' table of error codes referenced by GDIP status codes
LOCAL sGDIPfn AS STRING ' GDIP function name for error reporting
STATIC hGlobal, pGlobalBuffer, iImageStream AS DWORD
LOCAL imagesize, hfile AS LONG
STATIC simagebuffer AS STRING ' loaded with image when file is selected for viewing
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
' clear down the previous stream, buffer and image, if any
GOSUB clearstreamstuff
' initialise static variables
ghimage = 0
hdc = 0
pgraphics = 0
ghPicWnd = CBHNDL
ofsx = 0: ofsy = 0: tX = 0: tY = 0
' load GDIPlus error messages
GOSUB LoadGDIPERMS
'
CASE %WM_ERASEBKGND
IF ghimage = 0 THEN FUNCTION = 0 : EXIT SELECT
hdc = getdc(CBHNDL)
l = GdipCreatefromHDC ( hDC, pGraphics)
IF l THEN sGDIPfn = "GdipCreatefromHDC": GOSUB gdiperror
' this image may be smaller than the last one
' so clear the client area before displaying it
GdipGraphicsClear ( pGraphics, -1)
' draw image
l = GdipDrawImageRectI(pGraphics, ghimage, ofsX, ofsY, tX, tY)
IF l THEN sGDIPfn = "GdipDrawImageRectI": GOSUB gdiperror
releaseDC (CBHNDL, hDC)
l = gdipdeletegraphics(pgraphics)
IF l THEN sGDIPfn = "gdipdeletegraphics": GOSUB gdiperror
FUNCTION = 1
' '
CASE %WM_USER + 401 ' GET IMAGE
' user has pressed the load picture button
' clear down the previous stream, buffer and image, if any
GOSUB clearstreamstuff
gspicpath = GetPic(CBHNDL) 'ucode$
' load file to image buffer
TRY
hfile = FREEFILE
OPEN gspicpath FOR BINARY ACCESS READ AS hfile 'gsPicPath
imagesize = INT(LOF(hfile))
simagebuffer = SPACE$(imagesize)
GET #hfile, 1, simagebuffer
CLOSE #hfile
'? "IF2B 2" + gspicpath + $CRLF + "image size" + STR$(imagesize),%MB_TASKMODAL,"debug"
CATCH
? "error reading image file " + gspicpath + $CRLF + ERROR$,%MB_TASKMODAL,"warning"
CLOSE #hfile
EXIT FUNCTION
END TRY
IF ghimage THEN
l = gdipdisposeimage (ghimage)
IF l THEN sGDIPfn = "gdipdisposeimage": GOSUB gdiperror
END IF
l = GDIPLoadImageFromFile (BYVAL UCODE$(gspicPath), BYREF ghimage)
IF l THEN sGDIPfn = "GDIPLoadImageFromFile": GOSUB gdiperror
CONTROL SET TEXT getparent(CBHNDL), %IDC_LABEL4, TRIM$(gsPicPath)
GOSUB showpic
'
CASE %WM_USER + 402 ' LOAD FROM DB
' clear down the previous stream, buffer and image, if any
GOSUB clearstreamstuff
' user has loaded a file from the DB
' a ptr to it is in wparam, length in lparam
' set up a buffer must be GlobalAlloc etc
hGlobal = GlobalAlloc(%GMEM_MOVEABLE OR %GMEM_NODISCARD, CBLPARAM)
IF hGlobal THEN
pGlobalBuffer = GlobalLock(hGlobal)
IF pGlobalBuffer THEN
' copy the image into the stream
CopyMemory pGlobalBuffer, BYVAL CBWPARAM, CBLPARAM
' create a stream on the buffer
IF CreateStreamOnHGlobal(hGlobal, BYVAL 0&, iImageStream) = 0 THEN
' load the image from the stream
l = GdipLoadImageFromStream (iImageStream, ghImage)
IF l THEN sGDIPfn = "GdipLoadImageFromStream": GOSUB gdiperror
'CALL IUnknown_Release(iImageStream)
END IF
'GlobalUnlock pGlobalBuffer
END IF
'GlobalFree hGlobal
END IF
'gspicpath = ucode$(gspicpath)
GOSUB showpic
'
CASE %WM_USER + 403 ' SAVE TO DB
IF ImgFile2Blob ( BYVAL STRPTR(simageBuffer), LEN(simageBuffer)) = 0 THEN
GOSUB clearstreamstuff
CONTROL SET TEXT getparent(CBHNDL), %IDC_LABEL4, TRIM$(gspicpath) + $CRLF + " saved to database"
END IF
'
CASE %WM_DESTROY
' clear down the previous stream, buffer and image, if any
GOSUB clearstreamstuff
releaseDC( CBHNDL, hdc )
END SELECT
EXIT FUNCTION
''''''''''''
showpic:
IF ghimage = 0 THEN EXIT FUNCTION
getClientrect(CBHNDL, r)
' get image height, width & pixel format
l = GdipGetImageDimension (BYVAL ghimage, BYREF origwidth, BYREF origheight)
IF l THEN sGDIPfn = "GdipGetImageDimension": GOSUB gdiperror
maxwidth = r.nright - r.nleft : maxheight = r.nbottom - r.ntop
l = GdipGetImagePixelFormat (BYVAL ghimage, BYREF lPixelFormat)
IF l THEN sGDIPfn = "GdipGetImagePixelFormat": GOSUB gdiperror
' derive new image size for display on the dailog, preserving aspect ratio
' the results are declared STATIC so that the %WM_ERASEBKGND handler can use them
skIconise ( BYVAL origwidth, BYVAL origheight, BYVAL maxwidth, BYVAL maxheight, _
BYREF ofsX, BYREF ofsY, BYREF tX, BYREF tY)
' tidy up
'gdipdeletegraphics pGraphics
'IF l THEN sGDIPfn = "GdipDeleteGraphics": GOSUB gdiperror
'releaseDC( CBHNDL, hdc )
' force redraw via WM_ERASEBKGND
invalidaterect CBHNDL, r, %TRUE
RETURN
''''''''''''
clearstreamstuff:
' clear down the previous stream, buffer and image, if any
IF ghimage THEN
' assumption here that we are only referencing the iImageStream once
IF iImageStream <> 0 THEN
l = IUnknown_Release(BYVAL iImageStream)
IF GlobalUnlock (pGlobalBuffer) <> 0 THEN
l = getlasterror()
IF l <> 0 THEN ? "global memory not unlocked!" + STR$(l), %MB_TASKMODAL,"debug"
END IF
IF globalfree (hglobal) <> 0 THEN
? "global memory not freed!", %MB_TASKMODAL,"debug"
END IF
pGlobalBuffer = 0
iImageStream = 0
END IF
l = gdipdisposeimage(ghimage)
ghimage = 0
IF l THEN sGDIPfn = "GdipDisposeImage": GOSUB gdiperror
END IF
RETURN
gdiperror:
? sGDIPfn + ":" + sGDIPStatusCodes(l), %MB_TASKMODAL,"warning"
EXIT FUNCTION
RETURN
''''''''''''''''''''''
LoadGDIPERMS:
DIM sGDIPStatusCodes(0 TO 20) AS STATIC STRING
sGDIPStatusCodes(%StatusOk ) = "Ok
sGDIPStatusCodes(%StatusGenericError ) = "Generic Error
sGDIPStatusCodes(%StatusInvalidParameter ) = "Invalid Parameter
sGDIPStatusCodes(%StatusOutOfMemory ) = "Out Of Memory
sGDIPStatusCodes(%StatusObjectBusy ) = "Object Busy
sGDIPStatusCodes(%StatusInsufficientBuffer ) = "Insufficient Buffer
sGDIPStatusCodes(%StatusNotImplemented ) = "Not Implemented
sGDIPStatusCodes(%StatusWin32Error ) = "Win32 Error
sGDIPStatusCodes(%StatusWrongState ) = "Wrong State
sGDIPStatusCodes(%StatusAborted ) = "Aborted
sGDIPStatusCodes(%StatusFileNotFound ) = "File Not Found
sGDIPStatusCodes(%StatusValueOverflow ) = "Value Overflow
sGDIPStatusCodes(%StatusAccessDenied ) = "Access Denied
sGDIPStatusCodes(%StatusUnknownImageFormat ) = "Unknown Image Format
sGDIPStatusCodes(%StatusFontFamilyNotFound ) = "Font Family Not Found
sGDIPStatusCodes(%StatusFontStyleNotFound ) = "Font Style Not Found
sGDIPStatusCodes(%StatusNotTrueTypeFont ) = "Not TrueType Font
sGDIPStatusCodes(%StatusUnsupportedGdiplusVersion ) = "Unsupported Gdiplus Version
sGDIPStatusCodes(%StatusGdiplusNotInitialized ) = "Gdiplus Not Initialized
sGDIPStatusCodes(%StatusPropertyNotFound ) = "Property Not Found
sGDIPStatusCodes(%StatusPropertyNotSupported ) = "Property Not Supported
RETURN
END FUNCTION
'--------------------------------------------------------------------
' return the query results concatenated into a single string
' parameters are :
' control id, start row, start column, row count, column count, row seperator, col seperator
FUNCTION GetQResultsasString ( BYVAL pQdw AS DWORD, _
lstartrow AS LONG, lrowcount AS LONG, _
lstartcol AS LONG, lcolcount AS LONG, _
srowsep AS STRING, scolsep AS STRING) AS STRING
LOCAL pQStuff AS tQueryStuff PTR
LOCAL cx AS LONG ' control index
LOCAL i, j, n AS LONG ' ephemeral counter
LOCAL s AS STRING ' ephemeral string
LOCAL ps() AS ASCIZ PTR ' pointer array to map onto sqlite results table
pQstuff = pQDW
DIM ps ( 0 TO (@pQstuff.nQrows * @pQstuff.nQcols) -1) AT @pQstuff.pQresults
FOR i = lstartrow TO lstartrow + lrowcount - 1
FOR j = lstartcol TO lstartcol + lcolcount -1
n = i * lcolcount + j
s = s + scolsep + TRIM$(@ps(i * lcolcount + j))
NEXT
s = s + srowsep
NEXT
IF ASC(s) = ASC(scolsep) THEN s = MID$(s,2)
FUNCTION = s
END FUNCTION
'--------------------------------------------------------------------
' populate a listbox
' parameters - 1st is listbox id, 2nd is true if column headings are required, 3rd is column seperator
FUNCTION q2lB ( BYVAL dwQstuff AS DWORD, lstartrow AS LONG, lendrow AS LONG, scolsep AS STRING, snoresultmsg AS STRING) AS LONG
LOCAL i, lx AS LONG
LOCAL s AS STRING
LOCAL pQstuff AS tQueryStuff PTR
ON ERROR GOTO er99
pQstuff = dwQstuff
sendmessage(@pQstuff.hwnd,%LB_RESETCONTENT, 0, 0 )
IF lendrow = 0 THEN
sendmessage (@pQstuff.hWnd, %LB_ADDSTRING, 0, BYVAL STRPTR(snoresultmsg))
EXIT FUNCTION
END IF
FOR i = lstartrow TO lendrow
s = GetQresultsasString (BYVAL pQstuff, i, 1, 0, @pQstuff.nQcols,"",sColSep)
sendmessage (@pQstuff.hWnd, %LB_ADDSTRING, 0, BYVAL STRPTR(s))
NEXT
FUNCTION = @pQstuff.nQrows
EXIT FUNCTION
er99:
? "error in Q2LB at" + STR$(ERL)+ STR$( ERR),%MB_TASKMODAL
END FUNCTION
''----------------------------------------------------------
'' this is a limited example of the use of sqlite3_column_blob
'' reads a blob in column 0 of a query which returns a singe row
'' won't work with multi-row or multi-column!
SUB ReadBlob ( BYVAL dwQStuff AS DWORD )
LOCAL pQstuff AS tQueryStuff PTR
LOCAL ppStmt AS DWORD
LOCAL pzTail, pszErms, pszQuery AS ASCIZ PTR
LOCAL dwObjAddr AS DWORD
LOCAL lresult AS LONG
LOCAL tempptr AS DWORD PTR
LOCAL n AS LONG
ON ERROR GOTO er99
pQstuff = dwQstuff
IF sqlite3_prepare_v2( ghDB, BYVAL @pQstuff.pszSQL, -1, ppStmt, pzTail ) <> %SQLITE_OK THEN
pszErms = SQLErrMsg(ghDB)
pszQuery = @pQstuff.pszSQL
? "Failed to prepare query when reading Blob!" + $CRLF + $CRLF + _
TRIM$(@pszErms) + $CRLF + _
"SQL was: " + @pszQuery + $CRLF + $CRLF + _
"...Load form failed!!!!",%MB_TASKMODAL,"Warning"
sqlite3_free ( @pQstuff.pQzErms)
GOTO done
END IF
'
pszQuery = @pQstuff.pszSQL
DO
lresult = sqlite3_step(ppStmt)
' ? "<" + @pszquery + ">",%MB_TASKMODAL,"debug"
SELECT CASE lresult
CASE %SQLITE_ROW : EXIT LOOP
CASE ELSE
pszErms = SQLErrMsg(ghDB)
pszQuery = @pQstuff.pszSQL
'? TRIM$(@pszErms) + $CRLF + "SQL was: " + @pszQuery + $CRLF
sqlite3_free ( @pQstuff.pQzErms)
GOTO done
END SELECT
LOOP
tempptr = sqlite3_column_blob(BYVAL ppStmt, BYVAL 0) ' load blob into allocated memory & return pointer
n = sqlite3_column_bytes(BYVAL ppStmt, BYVAL 0) ' Get Blob size
IF n > @pQstuff.lBlobBuffersize THEN
n = @pQstuff.lBlobBuffersize ' avoid overrun
ELSE
@pQstuff.lBlobBuffersize = n ' buffer size may have changed, tell caller
END IF
movememory (BYVAL @pQstuff.pBlobdata, BYVAL Tempptr, n) ' Copy the Blob from SQLite's space to our own
done:
IF sqlite3_finalize(ppStmt) <> %SQLITE_OK THEN
? "Failed to finalize query when reading Blob!" + $CRLF + $CRLF + _
"...Load form may have failed!!!!",%MB_TASKMODAL,"Warning"
EXIT SUB
END IF
EXIT SUB
er99:
? "error in READBLOB at" + STR$(ERL)+ STR$( ERR),%MB_TASKMODAL
END SUB
'----------------------------------------------------------
' return the length of the blob in in column 0 of query
FUNCTION GetBlobLen ( BYVAL dwQStuff AS DWORD ) AS LONG
LOCAL pQstuff AS tQueryStuff PTR
LOCAL llen AS LONG ' length of dynamic string array
LOCAL ppStmt AS DWORD
LOCAL pzTail, pszErms, pszQuery AS ASCIZ PTR
LOCAL dwObjAddr AS DWORD
LOCAL lresult AS LONG
LOCAL tempptr AS DWORD PTR
LOCAL n AS LONG
ON ERROR GOTO er99
pQstuff = dwQstuff
IF sqlite3_prepare_v2( ghDB, BYVAL @pQstuff.pszSQL, -1, ppStmt, pzTail ) <> %SQLITE_OK THEN
pszErms = SQLErrMsg(ghDB)
pszQuery = @pQstuff.pszSQL
? "Failed to prepare query when reading Blob!" + $CRLF + $CRLF + _
TRIM$(@pszErms) + $CRLF + _
"SQL was: " + @pszQuery + $CRLF + $CRLF _
,%MB_TASKMODAL,"Warning"
GOTO done
END IF
'
pszQuery = @pQstuff.pszSQL
DO
lresult = sqlite3_step(ppStmt)
SELECT CASE lresult
CASE %SQLITE_ROW : EXIT LOOP
CASE ELSE
pszErms = SQLErrMsg(ghDB)
pszQuery = @pQstuff.pszSQL
? TRIM$(@pszErms) + $CRLF + "SQL was: " + @pszQuery ,%MB_TASKMODAL,"Warning"
sqlite3_free ( @pQstuff.pQzErms)
GOTO done
END SELECT
LOOP
tempptr = sqlite3_column_blob(BYVAL ppStmt, BYVAL 0) ' load blob into allocated memory & return pointer
n = sqlite3_column_bytes(BYVAL ppStmt, BYVAL 0) ' Get Blob size
@pQstuff.lBlobBuffersize = n ' buffer size may have changed, tell caller
FUNCTION = n
done:
IF sqlite3_finalize(ppStmt) <> %SQLITE_OK THEN
? "Failed to finalize query when reading Blob!" + $CRLF + $CRLF _
,%MB_TASKMODAL,"Warning"
EXIT FUNCTION
END IF
EXIT FUNCTION
er99:
? "error in GETBLOBLEN at" + STR$(ERL)+ STR$( ERR),%MB_TASKMODAL
END FUNCTION
'------------------------------------------------------------------------------
SUB loadfromDB ( hD AS DWORD, skey AS STRING)
LOCAL i, hfile, l, lcx, lex, lret, n, nrecs, x, y _
AS LONG ', x, y AS LONG
LOCAL Qstuff AS tQueryStuff
LOCAL spath, sAppName, sType AS STRING
LOCAL sTemp() AS STRING
LOCAL s, squery AS STRING
LOCAL imagesize AS LONG
LOCAL dwobjaddr AS DWORD PTR
LOCAL pszresults() AS ASCIZ PTR
LOCAL hdc AS DWORD
LOCAL r AS rect
LOCAL hglobal, iImageStream, pGlobalBuffer AS DWORD
ON ERROR GOTO er99
'--- load the picture into the buffer
sQuery = "select content from pictures where key = '" + TRIM$(sKey) + "'"
Qstuff.pszSQL = STRPTR(squery)
imagesize = getbloblen(BYVAL VARPTR(Qstuff))
s = STRING$(imagesize, $SPC)
Qstuff.pBlobdata = STRPTR(s)
Qstuff.lBlobBufferSize = imagesize
readblob (BYVAL VARPTR(Qstuff))
CONTROL SET TEXT getparent(ghPicWnd), %IDC_LABEL4, STR$(imagesize) + " bytes from database: " + skey
sendmessage ghPicWnd, %WM_USER + 402, BYVAL Qstuff.pBlobdata, imagesize
EXIT SUB
er99:
? "error in LOADFROMDB at" + STR$(ERL)+ STR$( ERR),%MB_TASKMODAL
END SUB
'------------------------------------------------------------------------------
CALLBACK FUNCTION ShowLBCB()
LOCAL sz AS ASCIZ * 64
STATIC sQuery AS STRING
LOCAL lselitem AS LONG
LOCAL s AS STRING
LOCAL lresult AS LONG
STATIC hLB AS DWORD
STATIC Qstuff AS tQueryStuff
LOCAL pbyte AS BYTE PTR
SELECT CASE AS LONG CBMSG
'
CASE %WM_INITDIALOG
'' initialise statics
sQuery = ""
hLB = 0
s = STRING$(SIZEOF(qstuff),0)
POKE$ VARPTR(qstuff), PEEK$(STRPTR(s), LEN(s))
''
Qstuff.hWnd = getdlgitem(CBHNDL, %IDC_LISTBOX1)' window handle
sQuery = "select distinct key from pictures"
Qstuff.pszSQL = STRPTR(sQuery)
IF DoSQL (BYVAL VARPTR(Qstuff)) <> %SQLITE_OK THEN
DIALOG END CBHNDL, 0
EXIT SELECT
END IF
IF Qstuff.nQrows = 0 THEN
?"The database contains no pictures!",%MB_TASKMODAL,"Warning"
DIALOG END CBHNDL, 0
EXIT SELECT
END IF
Qstuff.selection = ""
q2lB ( BYVAL VARPTR(Qstuff), 1, Qstuff.nQrows, "", "")
'
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_LISTBOX1
IF HI(WORD,CBWPARAM) = %LBN_SELCHANGE THEN
' get the index of the selected item
lselitem = sendmessage(Qstuff.hWnd, %LB_GETCURSEL, 0, 0)
'returns the index of the current selection in wparam
sendmessage (Qstuff.hWnd, %LB_GETText, lselitem, BYVAL VARPTR(sz))
loadfromDB(getparent(CBHNDL), TRIM$(sz))
DIALOG END CBHNDL, 0
END IF
END SELECT
CASE %WM_DESTROY
' free SQLite memory
IF Qstuff.pQresults <> 0 THEN sqlite3_free_table(Qstuff.pQresults)
Qstuff.pQresults = 0
END SELECT
END FUNCTION
'------------------------------------------------------------------------------
FUNCTION ShowLB(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "Choose a Picture", _
70, 70, 191, 96, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR _
%WS_CAPTION OR %WS_MINIMIZEBOX 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 LISTBOX, hDlg, %IDC_LISTBOX1, , 0, 0, 190, 95
DIALOG SHOW MODAL hDlg, CALL ShowLBCB TO lRslt
FUNCTION = lRslt
END FUNCTION
'------------------------------------------------------------------------
CALLBACK FUNCTION ShowDIALOG1Proc()
LOCAL s AS STRING
STATIC hPicWnd AS DWORD
SELECT CASE AS LONG CBMSG
CASE %WM_INITDIALOG
DIALOG NEW CBHNDL, "", 85, 5, 190, 125, %WS_POPUP OR %WS_BORDER OR _
%WS_POPUP OR %WS_CHILD OR _
%WS_CLIPSIBLINGS OR %WS_VISIBLE OR %DS_3DLOOK OR %DS_NOFAILCREATE OR _
%DS_SETFONT, %WS_EX_CONTROLPARENT OR %WS_EX_TOOLWINDOW OR _
%WS_EX_TOPMOST OR %WS_EX_LEFT OR %WS_EX_LTRREADING TO hPicWnd
DIALOG SHOW MODELESS hPicWnd, CALL PicDlgCB 'TO lRslt
CASE %WM_COMMAND
SELECT CASE AS LONG CBCTL
CASE %IDC_getpic_bn
IF HI(WORD,CBWPARAM) = %BN_CLICKED THEN
sendmessage hPicWnd, %WM_USER + 401, 0, 0
END IF
CASE %IDC_picDB_bn
' pop up a ListBox of saved queries from which one can be selected
ShowLB(CBHNDL)
CASE %IDC_savepicDB_bn
sendmessage ghPicWnd, %WM_USER + 403, 0, 0
END SELECT
END SELECT
END FUNCTION
'----------------------------------------------------------------------------------------
FUNCTION ShowDIALOG1(BYVAL hParent AS DWORD) AS LONG
LOCAL lRslt AS LONG
LOCAL hDlg AS DWORD
DIALOG NEW hParent, "SQLite blob example ", _
139, 129, 279, 160, _
%WS_POPUP OR %WS_BORDER OR %WS_DLGFRAME OR %WS_SYSMENU OR %WS_MINIMIZEBOX 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 BUTTON, hDlg, %IDC_getpic_bn, "find a picture", 5, 5, 75, 15
CONTROL ADD BUTTON, hDlg, %IDC_picDB_bn, "Load picture from DB", 5, 35, 75, 15
CONTROL ADD BUTTON, hDlg, %IDC_savepicDB_bn, "save pic to DB", 5, 20, 75, 15
CONTROL ADD LABEL, hDlg, %IDC_LABEL3, "by Chris Holbrook August 2008", 5, 105, 65, 25
CONTROL ADD LABEL, hDlg, %IDC_LABEL4, "", _
85, 135, 190, 18, _
%SS_SUNKEN,
DIALOG SHOW MODAL hDlg, CALL ShowDIALOG1Proc TO lRslt
FUNCTION = lRslt
END FUNCTION
'=======================================================================
FUNCTION PBMAIN()
STATIC nstatus AS LONG
STATIC token AS DWORD
STATIC StartupInput AS GdiplusStartupInput
gszdbpath = "c:\PIX.DB" '<<<<<<<<<<<<<<<<<<<<<<<<<<< CHANGE THIS!!!!
StartupInput.GdiplusVersion = 1
nStatus = GdiplusStartup(token, StartupInput, BYVAL %NULL)
IF nStatus THEN
MSGBOX "Error initializing GDI+", %mb_applmodal, "Warning"
EXIT FUNCTION
END IF
sqlite3_open( gszDBpath, ghDB )
ShowDIALOG1 %HWND_DESKTOP
sqlite3_close( ghDB )
GdiplusShutdown token
END FUNCTION