Using the new DatabaseBlob command..

Fangbeast · Post by **Fangbeast** » Sat Aug 15, 2009 4:17 pm

In the new

SetDatabaseBlob(#Database,  StatementIndex,  *Buffer,  BufferLength)

Is StatementIndex the record number? I am trying to figure out how to successfully store multiple images and don't quite get it.

Also, I want to load an image into memory only once and then stuff it as a blob into a database and then resize it and put it into an imagegadget without having to load it/read it twice.

Can the image data be copied into the blob buffer from a LoadImage command?

netmaestro · Post by **netmaestro** » Sat Aug 15, 2009 4:31 pm

Fangles wrote:Can the image data be copied into the blob buffer from a LoadImage command?

Blobs are read from a memory block referenced by a pointer, so I'd say not. You could read the image file in using the file commands though, as an alternative to IncludeBinary. CatchImage would also work from an image loaded this way.

Code: Select all

If ReadFile(0, #PB_Compiler_Home+"examples\sources\data\purebasiclogo.bmp")
  length = Lof(0)
  *filereadbuffer = AllocateMemory(length)
  ReadData(0,*filereadbuffer,length)
Else
  MessageRequester("oops!","Couldn't read image file")
  End
EndIf

UseSQLiteDatabase() 
; or:
; UseODBCDatabase() 

OpenDatabase(0,":memory:","","") 
; or:
; OpenDatabase(0, "MyTestDSN", "root", "") 

DatabaseUpdate(0, "CREATE TABLE PHOTOS (PICTURE_1 BLOB, SIZE_1 integer)") 

SetDatabaseBlob(0, 0, *filereadbuffer, Length) 
DatabaseUpdate(0, "INSERT INTO PHOTOS (PICTURE_1, SIZE_1) values ( ?, "+"'"+Str(Length)+"');") 


DatabaseQuery(0, "SELECT * FROM PHOTOS") 

If FirstDatabaseRow(0) 
  picsize = GetDatabaseLong(0,1) 
  *blobreadbuffer = AllocateMemory(picsize)
  GetDatabaseBlob(0, 0, *blobreadbuffer, picsize) 
  FinishDatabaseQuery(0) 
  If CatchImage(0, *blobreadbuffer) 
    OpenWindow(0,0,0,ImageWidth(0),ImageHeight(0),"",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
    ImageGadget(0,0,0,0,0,ImageID(0)) 
    Repeat:Until WaitWindowEvent()=#PB_Event_CloseWindow 
  EndIf 
EndIf 

CloseDatabase(0) 

End

Fangbeast · Post by **Fangbeast** » Sun Aug 16, 2009 3:14 am

Blobs are read from a memory block referenced by a pointer, so I'd say not. You could read the image file in using the file commands though, as an alternative to IncludeBinary. CatchImage would also work from an image loaded this way.

Thanks, that answers one question. I had loaded an image to display in an ImageGadget and stored it as a blob separately, worked.

Not sure about the StatementIndex as I managed to store two images and then blanks so I am misunderstanding something about that.

Fangbeast · Post by **Fangbeast** » Tue Aug 18, 2009 2:31 pm

Code: Select all

SetDatabaseBlob(#Database,  StatementIndex,  *Buffer,  BufferLength)

Can anyone show me an example of using this new command to store multiple mixed blob and text data in the same table during the current session?

When I tried, I was able to store two images during one program run and subsequent images were blank.

netmaestro · Post by **netmaestro** » Wed Aug 19, 2009 1:16 am

Okay Fangsey, give this a try. It has (I believe) everything you need:

Code: Select all

; Blob Demo: Multiple blobs/record with text and numbers 

Declare ShowRecord() 
Declare InitWindow() 

CreateImage(0, 32,32,24):StartDrawing(ImageOutput(0)):Box(0,0,32,32,#Red):StopDrawing() 
CreateImage(1, 32,32,24):StartDrawing(ImageOutput(1)):Box(0,0,32,32,#Green):StopDrawing() 
CreateImage(2, 32,32,24):StartDrawing(ImageOutput(2)):Box(0,0,32,32,#Blue):StopDrawing() 
CreateImage(3, 32,32,24):StartDrawing(ImageOutput(3)):Box(0,0,32,32,#Yellow):StopDrawing() 

SaveImage(0, GetTemporaryDirectory()+"redbox.bmp") 
SaveImage(1, GetTemporaryDirectory()+"greenbox.bmp") 
SaveImage(2, GetTemporaryDirectory()+"bluebox.bmp") 
SaveImage(3, GetTemporaryDirectory()+"yellowbox.bmp") 

If ReadFile(0, GetTemporaryDirectory()+"redbox.bmp") 
  length0 = Lof(0) : *filebuffer0 = AllocateMemory(length0) : ReadData(0,*filebuffer0,length0) : CloseFile(0) 
EndIf 
If ReadFile(0, GetTemporaryDirectory()+"greenbox.bmp") 
  length1 = Lof(0) : *filebuffer1 = AllocateMemory(length1) : ReadData(0,*filebuffer1,length1) : CloseFile(0) 
EndIf 
If ReadFile(0, GetTemporaryDirectory()+"bluebox.bmp") 
  length2 = Lof(0) : *filebuffer2 = AllocateMemory(length2) : ReadData(0,*filebuffer2,length2) : CloseFile(0) 
EndIf 
If ReadFile(0, GetTemporaryDirectory()+"yellowbox.bmp") 
  length3 = Lof(0) : *filebuffer3 = AllocateMemory(length3) : ReadData(0,*filebuffer3,length3) : CloseFile(0) 
EndIf 

; Now there's a different image file in each of *buffers 0,1,2,3 


UseSQLiteDatabase() 

OpenDatabase(0,":memory:","","") 
DatabaseUpdate(0, "CREATE TABLE PHOTOS (PIC_1 BLOB, SIZE_1 integer, DESC_1 varchar, PIC_2 BLOB, SIZE_2 integer, DESC_2 varchar)") 

SetDatabaseBlob(0, 0, *filebuffer0, Length0) 
SetDatabaseBlob(0, 1, *filebuffer1, Length1) 
desc_1$ = "Red Box" 
desc_2$ = "Green Box" 

sql$ = "INSERT INTO PHOTOS (PIC_1, SIZE_1, DESC_1, PIC_2, SIZE_2, DESC_2 ) values ( ?, " + "'" + Str(Length0) + "', '" + desc_1$+"', ?, " + "'" + Str(Length1) +"', '" + desc_2$ + "');" 
DatabaseUpdate(0, sql$) 

SetDatabaseBlob(0, 0, *filebuffer2, Length2) 
SetDatabaseBlob(0, 1, *filebuffer3, Length3) 
desc_1$ = "Blue Box" 
desc_2$ = "Yellow Box" 

sql$ = "INSERT INTO PHOTOS (PIC_1, SIZE_1, DESC_1, PIC_2, SIZE_2, DESC_2 ) values ( ?, " + "'" + Str(Length2) + "', '" + desc_1$+"', ?, " + "'" + Str(Length3) +"', '" + desc_2$ + "');" 
DatabaseUpdate(0, sql$) 


; It's all in there, now let's get it back out...
DatabaseQuery(0, "SELECT * FROM PHOTOS") 

InitWindow() 
ShowRecord() 

Repeat 
  EventID = WaitWindowEvent() 
  Select EventID 
    Case #PB_Event_Gadget 
      If EventGadget() = 4 
        ShowRecord() 
      EndIf 
  EndSelect 
Until EventID = #PB_Event_CloseWindow 

FinishDatabaseQuery(0) 
CloseDatabase(0) 

End 

Procedure ShowRecord() 
  If Not NextDatabaseRow(0): FirstDatabaseRow(0) : EndIf 
  size0 = GetDatabaseLong(0,1) 
  size1 = GetDatabaseLong(0,4) 
  *blob0 = AllocateMemory(size0) 
  *blob1 = AllocateMemory(size1) 
  GetDatabaseBlob(0, 0, *blob0, size0) 
  GetDatabaseBlob(0, 3, *blob1, size1) 
  text0$ = GetDatabaseString(0,2) 
  text1$ = GetDatabaseString(0,5) 
  CatchImage(0, *blob0) 
  CatchImage(1, *blob1) 
  FreeMemory(*blob0)
  FreeMemory(*blob1)
  SetGadgetState(0, ImageID(0)) 
  SetGadgetText(1, text0$) 
  SetGadgetState(2, ImageID(1)) 
  SetGadgetText(3, text1$) 
EndProcedure 

Procedure InitWindow() 
  OpenWindow(0,0,0,400,300,"Pix and descriptions",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 
  ImageGadget(0,20,20,0,0,0) 
  TextGadget(1,55,20,100,20,"") 
  ImageGadget(2,20,60,0,0,0) 
  TextGadget(3,55,60,100,20,"") 
  ButtonGadget(4, 20,275,360,20,"Next record") 
EndProcedure

Note that SetDatabaseBlob() differs from GetDatabaseBlob() in one important aspect: Get references the column# whereas Set does not. Set references the "statement index", which is simply which occurrence of a question mark you want. Regardless of what column the question marks fall into, your first blob always has a statement index of 0, the next blob has a statement index of 1 and so on.

Fangbeast · Post by **Fangbeast** » Wed Aug 19, 2009 1:56 am

Fangsey?? I'll have to check how many fangs I have left to qualify for that name.

Thank you for the example nettasuaurus, I will study it most ASS-siduously when everyone is finally ASS-sleep tonight.

/me falls off the chair, again!

Fangbeast · Post by **Fangbeast** » Fri Aug 21, 2009 8:13 am

Thanks to the big green tree frog with the huge dentures, I whipped up a small program for my wife to use to take pictures to work and just scroll through them. Not everything is done and there might be bugs but it's free.

Code: Select all

; Author      = "PeriTek Visions"                                     ; Author's name
; CopyRight   = "PeriTek Visions 2009"                                ; Copyright holder
; Versionpr   = "v0.00.1"                                             ; Program version
; License     = " --* Freeware *-- "                                  ; Registration string

;==============================================================================================================
; Visual designer created constants and window code
;==============================================================================================================

; XIncludeFile "Piccy_Constants.pb"

Enumeration 1
  #Window_piccy
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #Gadget_piccy_fmain
  #Gadget_piccy_dbpic
  #Gadget_piccy_fcontrol
  #Gadget_piccy_first
  #Gadget_piccy_previous
  #Gadget_piccy_next
  #Gadget_piccy_last
  #Gadget_piccy_add
  #Gadget_piccy_delete
  #Gadget_piccy_edit
  #Gadget_piccy_save
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #StatusBar_piccy
EndEnumeration

#StatusBarIndex = #PB_Compiler_EnumerationValue

#StatusBar_piccy_messages = 0
#StatusBar_piccy_records  = 1

Enumeration 1
  #Image_piccy_dbpic
  #Image_piccy_first
  #Image_piccy_previous
  #Image_piccy_next
  #Image_piccy_last
  #Image_piccy_add
  #Image_piccy_delete
  #Image_piccy_edit
  #Image_piccy_save
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue

CatchImage(#Image_piccy_dbpic,    ?_OPT_piccy_dbpic)
CatchImage(#Image_piccy_first,    ?_OPT_piccy_first)
CatchImage(#Image_piccy_previous, ?_OPT_piccy_previous)
CatchImage(#Image_piccy_next,     ?_OPT_piccy_next)
CatchImage(#Image_piccy_last,     ?_OPT_piccy_last)
CatchImage(#Image_piccy_add,      ?_OPT_piccy_add)
CatchImage(#Image_piccy_delete,   ?_OPT_piccy_delete)
CatchImage(#Image_piccy_edit,     ?_OPT_piccy_edit)
CatchImage(#Image_piccy_save,     ?_OPT_piccy_save)

DataSection
  _OPT_piccy_dbpic:     IncludeBinary "Images\nopicture1.jpg"
  _OPT_piccy_first:     IncludeBinary "Images\first48x48.ico"
  _OPT_piccy_previous:  IncludeBinary "Images\previous48x48.ico"
  _OPT_piccy_next:      IncludeBinary "Images\next48x48.ico"
  _OPT_piccy_last:      IncludeBinary "Images\last48x48.ico"
  _OPT_piccy_add:       IncludeBinary "Images\add48x48.ico"
  _OPT_piccy_delete:    IncludeBinary "Images\delete48x48.ico"
  _OPT_piccy_edit:      IncludeBinary "Images\edit48x48.ico"
  _OPT_piccy_save:      IncludeBinary "Images\save48x48.ico"
EndDataSection

; XIncludeFile "Piccy_Windows.pb"

Procedure.l Window_piccy()
  If OpenWindow(#Window_piccy,80,80,477,490,"Add, edit, delete and view pictures in a database",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      Frame3DGadget(#Gadget_piccy_fmain,7,0,465,375,"")
      ImageGadget(#Gadget_piccy_dbpic,16,15,442,347,ImageID(#Image_piccy_dbpic),#PB_Image_Border)
      ResizeGadget(#Gadget_piccy_dbpic,16,15,442,347)
      ResizeImage(#Image_piccy_dbpic,442,347)
      SetGadgetState(#Gadget_piccy_dbpic,ImageID(#Image_piccy_dbpic))
      Frame3DGadget(#Gadget_piccy_fcontrol,7,375,465,87,"")
      ButtonImageGadget(#Gadget_piccy_first,19,395,55,55,ImageID(#Image_piccy_first))
      ButtonImageGadget(#Gadget_piccy_previous,74,395,55,55,ImageID(#Image_piccy_previous))
      ButtonImageGadget(#Gadget_piccy_next,129,395,55,55,ImageID(#Image_piccy_next))
      ButtonImageGadget(#Gadget_piccy_last,184,395,55,55,ImageID(#Image_piccy_last))
      ButtonImageGadget(#Gadget_piccy_add,239,395,55,55,ImageID(#Image_piccy_add))
      ButtonImageGadget(#Gadget_piccy_delete,294,395,55,55,ImageID(#Image_piccy_delete))
      ButtonImageGadget(#Gadget_piccy_edit,349,395,55,55,ImageID(#Image_piccy_edit))
      ButtonImageGadget(#Gadget_piccy_save,404,395,55,55,ImageID(#Image_piccy_save))
      CreateStatusBar(#StatusBar_piccy,WindowID(#Window_piccy))
        AddStatusBarField(377)
        AddStatusBarField(100)
      HideWindow(#Window_piccy,0)
      ProcedureReturn WindowID(#Window_piccy)
  EndIf
EndProcedure

; XIncludeFile "Piccy_MyDeclarations.pb"

Declare   AddPicture()

; Declare   DeletePicture()
; Declare   EditPicture()
; Declare   SavePicture()
; Declare   ShowFullScreen

Declare   GetFirstRecordNumber()
Declare   GetLastRecordNumber()
Declare   GetLastRecordId()

Declare   OpenSystemDatabase()

Declare   MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)
Declare   SetStat(Flag, Message.s)

Declare   ShowDroppedPicture()
Declare   ShowFirstPicture()
Declare   ShowLastPicture()
Declare   ShowPreviousPicture()
Declare   ShowNextPicture()

; XIncludeFile "Piccy_MyConstants.pb"

#Author                         = "PeriTek Visions"                                     ; Author's name
#CopyRight                      = "PeriTek Visions 2009"                                ; Copyright holder
#Versionpr                      = "v0.00.1"                                             ; Program version
#Regstring                      = " --* Freeware *-- "                                  ; Registration string
#Progname                       = "Picture Database "                                   ; The programs' name
#Fish                           = "<°)))o><²³  "                                        ; My little fishy
#Program                        = #Fish + #Progname + #Versionpr + #Regstring           ; Copyright string
#Database                       = #Progname + #Versionpr + ".Ptk"                       ; Name of the database with version string
#Eol                            = Chr(10) + Chr(13)                                     ; End of line marker

Structure ToolTipData                                                                   ; If any tooltips setup, leep track of gadgets that have them so you can remove them if needed
  Window.i
  Gadget.i
  Handle.i
EndStructure

UseSQLiteDatabase()

Structure ProgramData
  ProgramQuit.i
  FirstTime.i
  CurrentDirectory.s
  DatabaseName.s
  DatabaseHandle.i
  DatabaseFileHandle.i
  DatabaseDirectory.s
  ;
  FirstRecordNumber.i
  LastRecordNumber.i
  LastRecordInserted.i
  CurrentRecord.i
EndStructure

Global Program.ProgramData, NewList Tooltips.TooltipData()                                                         ; All tool tip handles and data here

Program\CurrentDirectory  = GetCurrentDirectory()                                               ; Give the variable enough space
Program\DatabaseDirectory = Program\CurrentDirectory + "Database\"                              ; Database directory

MakeSureDirectoryPathExists_(Program\DatabaseDirectory)                                         ; Database directory

Program\DatabaseName      = Program\DatabaseDirectory + #Database                               ; Database filename and directory

Enumeration #GadgetIndex
  #Shortcut_piccy_first
  #Shortcut_piccy_previous
  #Shortcut_piccy_next
  #Shortcut_piccy_last
  #Shortcut_piccy_add
  #Shortcut_piccy_delete
  #Shortcut_piccy_edit
  #Shortcut_piccy_save
  #Shortcut_piccy_exit
EndEnumeration

Enumeration #ImageIndex                                                                        ; Use last image enumeration, continued from visual designer created form
  #Image_piccy_messages
  #Image_piccy_records
  #Image_piccy_temp1                                                                            ; Temporary image resize variable
EndEnumeration

CatchImage(#Image_piccy_messages,    ?_PTK_piccy_messages)
CatchImage(#Image_piccy_records,     ?_PTK_piccy_records)

DataSection
  _PTK_piccy_messages    : IncludeBinary "Images\messages16x16.ico"
  _PTK_piccy_records     : IncludeBinary "Images\records16x16.ico"
EndDataSection

Procedure AddPicture()
  PictureFile.s = OpenFileRequester("Add new photograph", "*.jpg", "JPEG (*.jpg)|*.jpg", 1)
  If PictureFile.s
    FileIdIn = ReadFile(#PB_Any, PictureFile.s)
    If FileIdIn
      FileLength = Lof(FileIdIn)
      *PhotoBuffer = AllocateMemory(FileLength)
      BytesRead = ReadData(FileIdIn, *PhotoBuffer, FileLength)
      If BytesRead
        If SetDatabaseBlob(Program\DatabaseHandle,  0,  *PhotoBuffer,  FileLength)
          CloseFile(FileIdIn)
          Query.s = "INSERT INTO photographs(photofile, photosize)"
          Query.s + "VALUES (?, " + "'" + Str(FileLength) + "')"
          If DatabaseUpdate(Program\DatabaseHandle,  Query.s)
            Program\LastRecordNumber + 1
            Program\CurrentRecord    = Program\LastRecordNumber
            PictureId = LoadImage(#Image_piccy_temp1, PictureFile.s)
            If PictureId
              ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
              SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
            Else
              SetStat(3, "Could not read the picture data from the file.")
            EndIf
            SetStat(1, "Showing newly added record >>")
            SetStat(2, Str(Program\CurrentRecord))
          Else
            SetStat(3, "Could not insert picture data into database.")
          EndIf
        Else
          SetStat(3, "Could not store the picture data.")
        EndIf
      Else
        SetStat(3, "No data read into memory, problem with photograph")
      EndIf
      If FreeMemory(*PhotoBuffer)
      EndIf
    Else
      SetStat(3, "Could not open the requested picture.")
    EndIf
  Else
    SetStat(3, "No picture to load, user cancelled.")
  EndIf
EndProcedure

; XIncludeFile "Modules\_DeletePicture.pbi"
; XIncludeFile "Modules\_EditPicture.pbi"
; XIncludeFile "Modules\_SavePicture.pbi"
; XIncludeFile "Modules\_ShowFullScreen.pbi"

Procedure GetFirstRecordNumber()
  Query.s = "Select record FROM photographs ORDER BY record LIMIT 1"
  If DatabaseQuery(Program\DatabaseHandle, Query.s)
    While NextDatabaseRow(Program\DatabaseHandle)
      Program\FirstRecordNumber = Val(GetDatabaseString(Program\DatabaseHandle, 0))
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  EndIf
  If Program\FirstRecordNumber = 0
    Program\FirstRecordNumber = 1
  EndIf
EndProcedure

Procedure GetLastRecordNumber()
  Query.s = "Select record FROM photographs ORDER BY record DESC LIMIT 1"
  If DatabaseQuery(Program\DatabaseHandle, Query.s)
    While NextDatabaseRow(Program\DatabaseHandle)
      Program\LastRecordNumber = Val(GetDatabaseString(Program\DatabaseHandle, 0))
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  EndIf
  If Program\LastRecordNumber = 0
    Program\LastRecordNumber = 1
  EndIf
EndProcedure

Procedure GetLastRecordId()
  If DatabaseQuery(Program\DatabaseHandle, "SELECT last_insert_rowid()")
    While NextDatabaseRow(Program\DatabaseHandle)
      Program\LastRecordInserted = Val(GetDatabaseString(Program\DatabaseHandle, 0))
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  EndIf
EndProcedure

Procedure OpenSystemDatabase()
  Protected DatabaseFileHandle
  DatabaseFileHandle = OpenFile(#PB_Any, Program\DatabaseName)
  If DatabaseFileHandle
    CloseFile(DatabaseFileHandle)
    Program\DatabaseHandle = OpenDatabase(#PB_Any, Program\DatabaseName, "", "")
    If Program\DatabaseHandle
      Query.s = "CREATE TABLE IF NOT EXISTS photographs(photofile BLOB, photosize integer, "
      Query.s + "record INTEGER PRIMARY KEY AUTOINCREMENT)"
      If DatabaseUpdate(Program\DatabaseHandle, Query.s)
      Else
        Debug "Could not create the table or it already exists."
      EndIf
    Else
      Debug "Could not open the database file on disk."
    EndIf
  Else
    Debug "Could not create the database file on disk."
  EndIf
EndProcedure

Procedure MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)
  ForEach ToolTips()
    If ToolTips()\Window = btWindow And ToolTips()\Gadget = btGadget
      ProcedureReturn
    EndIf
  Next
  ToolTipControl = CreateWindowEx_(0, "ToolTips_Class32", "", #WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, WindowID(btWindow), 0, GetModuleHandle_(0), 0)
  SetWindowPos_(ToolTipControl, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)
  SendMessage_(ToolTipControl,  #TTM_SETTIPTEXTCOLOR, 0, 0)
  SendMessage_(ToolTipControl,  #TTM_SETTIPBKCOLOR, $F58C0A, 0)
  SendMessage_(ToolTipControl,  #TTM_SETMAXTIPWIDTH, 0, 290)
  Button.TOOLINFO\cbSize  = SizeOf(TOOLINFO)
  Button\uFlags           = #TTF_IDISHWND | #TTF_SUBCLASS
  Button\hwnd             = WindowID(btWindow)
  Button\uID              = GadgetID(btGadget)
  Button\hInst            = 0
  Button\lpszText         = @btText
  SendMessage_(ToolTipControl, #TTM_ADDTOOL, 0, Button)
  SendMessage_(ToolTipControl, #TTM_UPDATE, 0, 0)
  AddElement(tooltips())
    ToolTips()\Window = btWindow
    ToolTips()\Gadget = btGadget
    ToolTips()\Handle = ToolTipControl
EndProcedure

Procedure SetStat(Flag, Message.s)                                                             ; 1 is info, 2 is error
  If Flag = 1                                                                                   ; If flag =1, no error and report it to user
    StatusBarText(#StatusBar_piccy, #StatusBar_piccy_messages, "Info: " + Message.s)            ; Since not error, write "information"
  ElseIf Flag = 2                                                                               ; If flag =2, error, report it to user and write it to the log
    StatusBarText(#StatusBar_piccy, #StatusBar_piccy_records, "Photo " + Message.s)              ; Show fatal error on status bar
  ElseIf Flag = 3                                                                               ; If flag =2, error, report it to user and write it to the log
    StatusBarText(#StatusBar_piccy, #StatusBar_piccy_messages, "Error! " + Message.s)            ; Since not error, write "information"
  EndIf                                                                                         ; End test
EndProcedure

Procedure ShowDroppedPicture()
  DroppedFile.s = EventDropFiles()
  DroppedCount  = CountString(DroppedFile.s, Chr(10))
  If DroppedCount = 0 And DroppedFile.s <> ""
    PictureFile.s = DroppedFile.s
  ElseIf DroppedCount <> 0 And DroppedFile.s <> ""
    PictureFile.s = StringField(DroppedFile.s, 1, Chr(10))
  EndIf
  If PictureFile.s
    FileIdIn = ReadFile(#PB_Any, PictureFile.s)
    If FileIdIn
      FileLength = Lof(FileIdIn)
      *PhotoBuffer = AllocateMemory(FileLength)
      BytesRead = ReadData(FileIdIn, *PhotoBuffer, FileLength)
      If BytesRead
        If SetDatabaseBlob(Program\DatabaseHandle,  0,  *PhotoBuffer,  FileLength)
          CloseFile(FileIdIn)
          Query.s = "INSERT INTO photographs(photofile, photosize)"
          Query.s + "VALUES (?, " + "'" + Str(FileLength) + "')"
          If DatabaseUpdate(Program\DatabaseHandle,  Query.s)
            Program\LastRecordNumber + 1
            Program\CurrentRecord    = Program\LastRecordNumber
            PictureId = LoadImage(#Image_piccy_temp1, PictureFile.s)
            If PictureId
              ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
              SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
            Else
              SetStat(3, "Could not read the picture data from the file.")
            EndIf
            SetStat(1, "Showing newly added record >>")
            SetStat(2, Str(Program\CurrentRecord))
          Else
            SetStat(3, "Could not insert picture data into database.")
          EndIf
        Else
          SetStat(3, "Could not store the picture data.")
        EndIf
      Else
        SetStat(3, "No data read into memory, problem with photograph")
      EndIf
      If FreeMemory(*PhotoBuffer)
      EndIf
    Else
      SetStat(3, "Could not open the requested picture.")
    EndIf
  Else
    SetStat(3, "No picture to load, user cancelled.")
  EndIf
EndProcedure

Procedure ShowFirstPicture()
  If Program\FirstRecordNumber
    Program\CurrentRecord = Program\FirstRecordNumber
    Query.s = "SELECT * FROM photographs WHERE record='" + Str(Program\CurrentRecord) + "'"
    DatabaseQuery(Program\DatabaseHandle, Query.s)
    While NextDatabaseRow(Program\DatabaseHandle)
      PictureSize = GetDatabaseLong(Program\DatabaseHandle, 1)
      If PictureSize
        *PhotoBuffer = AllocateMemory(PictureSize)
        GetDatabaseBlob(Program\DatabaseHandle, 0, *PhotoBuffer, PictureSize)
        CatchImage(#Image_piccy_temp1, *PhotoBuffer)
        ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
        SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
        SetStat(1, "Showing first record >>")
        SetStat(2, Str(Program\FirstRecordNumber))
      Else
        SetStat(3, "Could not get the picture size from the database")
      EndIf
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  Else
    StatusBarText(#StatusBar_piccy, #StatusBar_piccy_messages, "There are no pictures to display")
  EndIf
EndProcedure

Procedure ShowPreviousPicture()
  If Program\CurrentRecord = Program\FirstRecordNumber
    RecordNumber.s = Str(Program\LastRecordNumber)
    Program\CurrentRecord = Program\LastRecordNumber
  Else
    Program\CurrentRecord - 1
    RecordNumber.s = Str(Program\CurrentRecord)
  EndIf
  Query.s = "SELECT * FROM photographs WHERE record='" + RecordNumber.s + "'"
  DatabaseQuery(Program\DatabaseHandle, Query.s)
  While NextDatabaseRow(Program\DatabaseHandle)
    PictureSize = GetDatabaseLong(Program\DatabaseHandle, 1)
    If PictureSize
      *PhotoBuffer = AllocateMemory(PictureSize)
      GetDatabaseBlob(Program\DatabaseHandle, 0, *PhotoBuffer, PictureSize)
      CatchImage(#Image_piccy_temp1, *PhotoBuffer)
      ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
      SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
      SetStat(1, "Showing previous record >>")
      SetStat(2, RecordNumber.s)
    Else
      SetStat(3, "Could not get the picture size from the database")
    EndIf
  Wend
  FinishDatabaseQuery(Program\DatabaseHandle)
EndProcedure

Procedure ShowLastPicture()
  If Program\LastRecordNumber
    Program\CurrentRecord = Program\LastRecordNumber
    Query.s = "SELECT * FROM photographs WHERE record='" + Str(Program\CurrentRecord) + "'"
    DatabaseQuery(Program\DatabaseHandle, Query.s)
    While NextDatabaseRow(Program\DatabaseHandle)
      PictureSize = GetDatabaseLong(Program\DatabaseHandle, 1)
      If PictureSize
        *PhotoBuffer = AllocateMemory(PictureSize)
        GetDatabaseBlob(Program\DatabaseHandle, 0, *PhotoBuffer, PictureSize)
        CatchImage(#Image_piccy_temp1, *PhotoBuffer)
        ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
        SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
        SetStat(1, "Showing last record >>")
        SetStat(2, Str(Program\LastRecordNumber))
      Else
        SetStat(3, "Could not get the picture size from the database")
      EndIf
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  Else
    SetStat(3, "There are no pictures to display")
  EndIf
EndProcedure

Procedure ShowNextPicture()
  If Program\CurrentRecord = Program\LastRecordNumber
    RecordNumber.s = Str(Program\FirstRecordNumber)
    Program\CurrentRecord = Program\FirstRecordNumber
  Else
    Program\CurrentRecord + 1
    RecordNumber.s = Str(Program\CurrentRecord)
  EndIf
  Query.s = "SELECT * FROM photographs WHERE record='" + RecordNumber.s + "'"
  DatabaseQuery(Program\DatabaseHandle, Query.s)
  While NextDatabaseRow(Program\DatabaseHandle)
    PictureSize = GetDatabaseLong(Program\DatabaseHandle, 1)
    If PictureSize
      *PhotoBuffer = AllocateMemory(PictureSize)
      GetDatabaseBlob(Program\DatabaseHandle, 0, *PhotoBuffer, PictureSize)
      CatchImage(#Image_piccy_temp1, *PhotoBuffer)
      ResizeImage(#Image_piccy_temp1, 442, 347, #PB_Image_Smooth)
      SetGadgetState(#Gadget_piccy_dbpic, ImageID(#Image_piccy_temp1))
      SetStat(1, "Showing next record >>")
      SetStat(2, RecordNumber.s)
    Else
      SetStat(3, "Could not get the picture size from the database")
    EndIf
  Wend
  FinishDatabaseQuery(Program\DatabaseHandle)
EndProcedure

If Window_piccy()

  Program\ProgramQuit = 0

  Program\FirstTime = 0

  StatusBarImage(#StatusBar_piccy, #StatusBar_piccy_messages, ImageID(#Image_piccy_messages))
  StatusBarImage(#StatusBar_piccy, #StatusBar_piccy_records,  ImageID(#Image_piccy_records))

  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Home,     #Shortcut_piccy_first)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Left,     #Shortcut_piccy_previous)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Right,    #Shortcut_piccy_next) 
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_End,      #Shortcut_piccy_last)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Control | #PB_Shortcut_A, #Shortcut_piccy_add)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Control | #PB_Shortcut_D, #Shortcut_piccy_delete)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Control | #PB_Shortcut_E, #Shortcut_piccy_edit)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Control | #PB_Shortcut_S, #Shortcut_piccy_save)
  AddKeyboardShortcut(#Window_piccy, #PB_Shortcut_Alt     | #PB_Shortcut_X, #Shortcut_piccy_exit)

  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_dbpic,     "Double left click on the photo to show it in a full screen preview." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Drag pictures one at a time from elsewhere to add them to the database.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_first,     "Go to the first picture in the database")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_previous,  "Go to the previous picture in the database." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Wraps around to the last picture when at the first picture.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_next,      "Go to the next picture in the database." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Wraps around to the first picture when at the last picture.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_last,      "Go to the last picture in the database")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_add,       "Add a new picture to the database.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_delete,    "Delete the current picture from the database." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Feature inactive as yet.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_edit,      "Edit the current picture in the database." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Feature inactive as yet.")
  MyBalloonToolTips(#Window_piccy, #Gadget_piccy_save,      "Save the current picture to disk." + Chr(13) + Chr(10) + Chr(13) + Chr(10) + "Exports the currently selected photograph from the database and saves it as a physical disk file.")

  OpenSystemDatabase()

  GetFirstRecordNumber()
  GetLastRecordNumber()
  ShowFirstPicture()

  EnableGadgetDrop(#Gadget_piccy_dbpic, #PB_Drop_Files, #PB_Drag_Copy)
  SetActiveWindow(#Window_piccy)
  
  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Select EventWindow()
          Case #Window_piccy                      : Program\ProgramQuit = 1
        EndSelect
      Case #PB_Event_Menu
        Select EventMenu()
          Case #Shortcut_piccy_first              : ShowFirstPicture()
          Case #Shortcut_piccy_previous           : ShowPreviousPicture()
          Case #Shortcut_piccy_next               : ShowNextPicture()
          Case #Shortcut_piccy_last               : ShowLastPicture()
          Case #Shortcut_piccy_add                : AddPicture()
          Case #Shortcut_piccy_delete             : ; DeletePicture()
          Case #Shortcut_piccy_edit               : ; EditPicture()
          Case #Shortcut_piccy_save               : ; SavePicture()
          Case #Shortcut_piccy_exit               : Program\ProgramQuit = 1
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Gadget_piccy_dbpic
            Select EventType()
              Case #PB_EventType_LeftDoubleClick  : ; ShowFullScreen()
            EndSelect
          Case #Gadget_piccy_first                : ShowFirstPicture()
          Case #Gadget_piccy_previous             : ShowPreviousPicture()
          Case #Gadget_piccy_next                 : ShowNextPicture()
          Case #Gadget_piccy_last                 : ShowLastPicture()
          Case #Gadget_piccy_add                  : AddPicture()
          Case #Gadget_piccy_delete               : ; DeletePicture()
          Case #Gadget_piccy_edit                 : ; EditPicture()
          Case #Gadget_piccy_save                 : ; SavePicture()
        EndSelect
      Case #PB_Event_GadgetDrop
        Select EventGadget()
          Case #Gadget_piccy_dbpic                : ShowDroppedPicture()
        EndSelect
    EndSelect
  Until Program\ProgramQuit
  CloseWindow(#Window_piccy)
EndIf
End

Fangbeast · Post by **Fangbeast** » Fri Aug 21, 2009 1:58 pm

Just a quick note. Under PB 4.30 and Windows 7, the statusbar icons show up.

Under PB 4.40 beta 1 and 2 and WIndows 7, they don't show up for some strange reason.

Post by **Fred** » Sun Sep 06, 2009 9:13 pm

Please not than you can use DatabaseColumnSize() to get the size of the blob, so you don't need to store it in a seperate column.

netmaestro · Post by **netmaestro** » Sun Sep 06, 2009 9:38 pm

Forgot that, thanks Fred

Fangbeast · Post by **Fangbeast** » Sat Jun 22, 2013 2:33 pm

Been a looooong time since I started this thread but NetMaestro and others showed me what to do. But, it hasn't been until recently that I actually needed this functionality so I cobbled up some routines that I have been playing with in the hopes that they might be an example to somebody.

Not totally 'fleshed out' but you can see what I am doing here.

Now to edit the 30 or so programs of mine that now need this (sigh)

Code: Select all

; Use for viewing various picture formats

UseJPEG2000ImageDecoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

; Use the SQLite database environment

UseSQLiteDatabase()
  
; Keep track of various program parameters

Structure ProgramData
  DbHandle.i
  CurrentDir.s
  DatabaseName.s
  TestPicture.s
EndStructure

; Database structure

Structure DatabaseData
  BlobData.s
  Name.s
  Path.s
  Description.s
  Record.s
EndStructure

; Make sure the structure data is globally available

Global Program.ProgramData
Global Database.DatabaseData

; 

Program\CurrentDir    = GetCurrentDirectory()
Program\DatabaseName  = Program\CurrentDir + "BlobTest.db3"

; 

Declare   OpenSystemDatabase()
Declare.s DatabaseLastInsertRowId()

Declare   StoreBlob(FileNameToStore.s, RecordNumber.s)
Declare   DeleteBlob(RecordNumber.s)
Declare   DisplayBlob(RecordNumber.s)
Declare   SaveBlob(RecordNumber.s)
Declare   SaveBlobRecord()

; Get the ID of the last inserted record

Procedure.s DatabaseLastInsertRowId()
  ; 
  If DatabaseQuery(Program\DbHandle, "SELECT last_insert_rowid()")
    ; 
    If FirstDatabaseRow(Program\DbHandle)
      RecordId.s = GetDatabaseString(Program\DbHandle, 0)
    EndIf
    ; 
    FinishDatabaseQuery(Program\DbHandle)
    ; 
  Else
    RecordId.s = ""
  EndIf
  ; 
  ProcedureReturn RecordId.s
  ; 
EndProcedure

; Try to open the system database and create missing tables

Procedure OpenSystemDatabase()
  ; Create the database if it doesn't already exist.
  DbFileHandle.i = OpenFile(#PB_Any, Program\DatabaseName)
  ; 
  If DbFileHandle.i
    ; 
    CloseFile(DbFileHandle.i)
    ; 
    Program\DbHandle = OpenDatabase(#PB_Any, Program\DatabaseName, "", "")
    ; 
    If Program\DbHandle
      ; Turn on auto database vacuum
      If Not DatabaseUpdate(Program\DbHandle, "PRAGMA auto_vacuum = on")
        Debug "Could not turn on automatic wasted space vacuuming." + DatabaseError()
      EndIf
      ; Write the Hive table out
      Query.s = "CREATE TABLE IF NOT EXISTS blobtest("
      Query.s + "BlobData BLOB, Name TEXT, Path TEXT, Description TEXT, "
      Query.s + "Record INTEGER PRIMARY KEY AUTOINCREMENT)"
      If Not DatabaseUpdate(Program\DbHandle, Query.s)
        Debug "Could not add missing tables to blobtest database." + DatabaseError()
      EndIf
      ; We had a problem getting the database handle
    Else
      MessageRequester("Database open error", "Error attempting to connect to system database.", #PB_MessageRequester_Ok)
    EndIf 
    ; 
  Else
    MessageRequester("Database open error", "Could not open or create raw database file.", #PB_MessageRequester_Ok)
  EndIf
  ; 
EndProcedure

; Store a disk file into the designated record blob field AFTER initial record insertion

Procedure StoreBlob(FileNameToStore.s, RecordNumber.s)
  ; 
  FileIn.i = ReadFile(#PB_Any, FileNameToStore.s)
  ; 
  If FileIn.i
    ; 
    FileInSize.i = Lof(FileIn.i)
    ; 
    *Buffer = AllocateMemory(FileInSize.i)
    ; 
    If *Buffer
      ; 
      If ReadData(FileIn.i, *Buffer, FileInSize.i) = FileInSize.i
        ; 
        SetDatabaseBlob(Program\DbHandle, 0, *Buffer, FileInSize.i)
        ; 
        If DatabaseUpdate(Program\DbHandle, "UPDATE blobtest SET BlobData = ? WHERE Record = '" + RecordNumber.s + "'")
          Result = #True
        Else
          Debug "Database update failed: " + DatabaseError()
        EndIf
        ; 
      Else
        Debug "Could not read data from designated input file"
      EndIf
      ; 
      FreeMemory(*Buffer)
      ; 
    Else
      Debug "Could not allocate memory to the input buffer"
    EndIf
    ; 
    CloseFile(FileIn.i)
    ; 
  Else
    Debug "Could not open the designated file to read from"
  EndIf
  ; 
  ProcedureReturn Result
  ; 
EndProcedure

; Delete a blob data in the designated record

Procedure DeleteBlob(RecordNumber.s)
  ;
  If DatabaseUpdate(Program\DbHandle, "UPDATE blobtest SET BlobData = '' WHERE Record = '" + RecordNumber.s + "'")
    Result = #True
  Else
    Debug "Database update failed: " + DatabaseError()
  EndIf
  ;
EndProcedure

; Display a blob from the database

Procedure DisplayBlob(RecordNumber.s)
  ; 
  If DatabaseQuery(Program\DbHandle, "SELECT BlobData FROM blobtest WHERE Record = '" + RecordNumber.s + "'"
    ; 
    While NextDatabaseRow(Program\DbHandle)
      ; 
      BlobImageSize.i = DatabaseColumnSize(Program\DbHandle, 0)
      ; 
      *Buffer = AllocateMemory(imageSize)
      ; 
      If *Buffer
        ; 
        If GetDatabaseBlob(Program\DbHandle, 0, *Buffer, BlobImageSize.i)
          ; 
          BlobImageId.i = CatchImage(#PB_Any, *Buffer, BlobImageSize.i)
          ; 
          If BlobImageId.i
            ; Display the image in an image gadget
            
            ; 
            Debug "We caught an image from the retrieved blob buffer"
            ; 
          Else
            Debug "We didn't get the image back from the blob buffer"
          EndIf
          ; 
        Else
          Debug "Could not retrieve the blob data from the database"
        EndIf
        ; 
        FreeMemory(*Buffer)
        ; 
      Else
        Debug "Could not allocate a buffer for the blob data"
      EndIf
      ; 
    Wend
    ; 
    FinishDatabaseQuery(Program\DbHandle)
    ; 
  Else
    Debug "The database query failed"
  EndIf
  ; 
EndProcedure

; Save a blob from the database

Procedure SaveBlob(RecordNumber.s)
  ; 
  If DatabaseQuery(Program\DbHandle, "SELECT * FROM blobtest WHERE Record = '" + RecordNumber.s + "'"
    ; 
    While NextDatabaseRow(Program\DbHandle)
      ; 
      BlobImageSize.i   = DatabaseColumnSize(Program\DbHandle, 0)
      ; 
      *Buffer = AllocateMemory(imageSize)
      ; 
      If *Buffer
        ; 
        If GetDatabaseBlob(Program\DbHandle, 0, *Buffer, BlobImageSize.i)
          ; 
          BlobName.s        = GetDatabaseString((Program\DbHandle, 1) ; Original filename
;         BlobPath.s        = GetDatabaseString((Program\DbHandle, 2) ; Original path
;         BlobDescription.s = GetDatabaseString((Program\DbHandle, 3) ; Original description
          BlobFileId.i = CreateFile(#PB_Any, GetCurrentDirectory() + BlobName.s)
          ; 
          If BlobFileId.i
            WriteData(BlobFileId.i, *Buffer, BlobImageSize.i)
            Debug "We caught an image from the retrieved blob buffer"
            CloseFile(BlobFileId.i)
          Else
            Debug "We didn't get the image back from the blob buffer"
          EndIf
          ; 
        Else
          Debug "Could not retrieve the blob data from the database"
        EndIf
        ; 
        FreeMemory(*Buffer)
        ; 
      Else
        Debug "Could not allocate a buffer for the blob data"
      EndIf
      ; 
    Wend
    ; 
    FinishDatabaseQuery(Program\DbHandle)
    ; 
  Else
    Debug "The database query failed"
  EndIf
  ; 
EndProcedure

Procedure SaveBlobRecord()
  ; 
  BlobFile.s = OpenFileRequester("Select picture", "", "Jpeg (*.jpg *.jpeg *.jfif)|*.jpg;*.jpeg;*.jfif|Bitmap (*.bmp)|*.bmp|Targa (*.tga)|*.tga|Tiff (*.tif)|*.tif|Png (*.png)|*.png|Icon (*.ico)|*.ico|All files (*.*)|*.*", 0)
  ; 
  If BlobFile.s
    ; 
    Name.s        = GetFilePart(BlobFile.s)
    Path.s        = GetPathPart(BlobFile.s)
    Description.s = "Inserted picture as blob"
    ; 
    FileIn.i = ReadFile(#PB_Any, FileNameToStore.s)
    ; 
    If FileIn.i
      ; 
      FileInSize.i = Lof(FileIn.i)
      ; 
      *Buffer = AllocateMemory(FileInSize.i)
      ; 
      If *Buffer
        ; 
        If ReadData(FileIn.i, *Buffer, FileInSize.i) = FileInSize.i
          ; 
          SetDatabaseBlob(Program\DbHandle, 0, *Buffer, FileInSize.i)
          ; 
          Query.s = "INSERT INTO blobtest (BlobData, Name, Path, Description) "
          Query.s + "VALUES("
          Query.s + "?, "                                   ; This is the picture data to be filled in from the buffer
          Query.s + Name.s         + "', '"
          Query.s + Path.s         + "', '"
          Query.s + Description.s  + "',)"
          If DatabaseUpdate(Program\DbHandle, Query.s)
            ; 
            NewRecord.s = DatabaseLastInsertRowId()
            ; 
            If NewRecord.s
              ; New record was inserted okay
            Else
              Debug "Could not get the record number for this stored record???"
            EndIf
            ; 
          Else
            Debug "The database insertion failed"
           EndIf
          ; 
        Else
          Debug "Could not read data from designated input file"
        EndIf
        ; 
        FreeMemory(*Buffer)
        ; 
      Else
        Debug "Could not allocate memory to the input buffer"
      EndIf
      ; 
      CloseFile(FileIn.i)
      ; 
    Else
      Debug "Could not open the designated file to read from"
    EndIf
    ; 
  Else
    Debug "No record to save, user cancelled the process"
  EndIf
  ; 
EndProcedure

; Open or create the system database

OpenSystemDatabase()

; Store a user requested picture as a blob AFTER the original record insertion

; BlobFile.s = OpenFileRequester("Select picture", "", "Jpeg (*.jpg *.jpeg *.jfif)|*.jpg;*.jpeg;*.jfif|Bitmap (*.bmp)|*.bmp|Targa (*.tga)|*.tga|Tiff (*.tif)|*.tif|Png (*.png)|*.png|Icon (*.ico)|*.ico|All files (*.*)|*.*", 0)
; If BlobFile.s
;   Name.s        = GetFilePart(BlobFile.s)
;   Path.s        = GetPathPart(BlobFile.s)
;   Description.s = "Inserted picture as blob"
;   Query.s = "INSERT INTO blobtest (Name, Path, Description) VALUES('"
;   Query.s + Name.s         + "', '"
;   Query.s + Path.s         + "', '"
;   Query.s + Description.s  + "')"
;   If DatabaseUpdate(Program\DbHandle, Query.s)
;     SmellyRecord.s = DatabaseLastInsertRowId()
;     If SmellyRecord.s
;       StoreBlob(Program\TestPicture, SmellyRecord.s)
;     Else
;       Debug "Could not get the record number for this stored record???"
;     EndIf
;   Else
;     Debug "The database insertion failed"
;   EndIf
; Else
;   Debug "No record to save, user cancelled the process"
; EndIf


; DeleteBlob("1")         ; Delete a blob from the database
; DisplayBlob("1")        ; Display a blob from the database
; SaveBlob("1")           ; Save a pictyre back to disk
; SaveBlobRecord()        ; Save a record to database all at once

Fangbeast · Post by **Fangbeast** » Wed Jun 26, 2013 7:16 am

My simple, unoptimised blob database if anyone wants it. Or not.

Code: Select all

;- Window Constants

Enumeration 1
  #Window_Blobby
  #Window_BlobbyData
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

;- Gadget Constants

Enumeration 1
  ; Window_Blobby
  #Gadget_Blobby_cBlobList
  #Gadget_Blobby_BlobList
  #Gadget_Blobby_cPicture
  #Gadget_Blobby_Picture
  #Gadget_Blobby_cDetails
  #Gadget_Blobby_cControl
  #Gadget_Blobby_Add
  #Gadget_Blobby_Delete
  #Gadget_Blobby_Edit
  #Gadget_Blobby_Save
  #Gadget_Blobby_cMessages
  #Gadget_Blobby_Details
  #Gadget_Blobby_iMessages
  #Gadget_Blobby_Messages
  #Gadget_Blobby_Exit

  ; Window_BlobbyData
  #Gadget_BlobbyData_cPicture
  #Gadget_BlobbyData_Picture
  #Gadget_BlobbyData_cDetails
  #Gadget_BlobbyData_Details
  #Gadget_BlobbyData_cControl
  #Gadget_BlobbyData_Save
  #Gadget_BlobbyData_Camera
  #Gadget_BlobbyData_Exit
  #Gadget_BlobbyData_Mode
  #Gadget_BlobbyData_Record
  #Gadget_BlobbyData_lMode
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

;- Image Constants

Enumeration 1
  #Image_Blobby_Add
  #Image_Blobby_Delete
  #Image_Blobby_Edit
  #Image_Blobby_Save
  #Image_Blobby_iMessages
  #Image_Blobby_Exit

  #Image_BlobbyData_Save
  #Image_BlobbyData_Camera
  #Image_BlobbyData_Exit
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue

;- Load Images
CatchImage(#Image_Blobby_Add,         ?_OPT_Blobby_Add)
CatchImage(#Image_Blobby_Delete,      ?_OPT_Blobby_Delete)
CatchImage(#Image_Blobby_Edit,        ?_OPT_Blobby_Edit)
CatchImage(#Image_Blobby_Save,        ?_OPT_Blobby_Save)
CatchImage(#Image_Blobby_iMessages,   ?_OPT_Blobby_iMessages)
CatchImage(#Image_Blobby_Exit,        ?_OPT_Blobby_Exit)
CatchImage(#Image_BlobbyData_Save,    ?_OPT_Blobby_Save)
CatchImage(#Image_BlobbyData_Camera,  ?_OPT_BlobbyData_Camera)
CatchImage(#Image_BlobbyData_Exit,    ?_OPT_Blobby_Exit)

DataSection
  _OPT_Blobby_Add         : IncludeBinary "Images\add32x32.ico"
  _OPT_Blobby_Delete      : IncludeBinary "Images\delete32x32.ico"
  _OPT_Blobby_Edit        : IncludeBinary "Images\edit32x32.ico"
  _OPT_Blobby_Save        : IncludeBinary "Images\save32x32.ico"
  _OPT_Blobby_iMessages   : IncludeBinary "Images\messages16x16.ico"
  _OPT_Blobby_Exit        : IncludeBinary "Images\exit32x32.ico"
  _OPT_BlobbyData_Camera  : IncludeBinary "Images\camera32x32.ico"
EndDataSection

Procedure.l Window_Blobby()
  If OpenWindow(#Window_Blobby, 52, 73, 805, 650, "View BLOB picture in database", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      SetWindowColor(#Window_Blobby, $A2A2A2)
      ContainerGadget(#Gadget_Blobby_cBlobList, 5, 5, 300, 545, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_Blobby_cBlobList, #PB_Gadget_BackColor, $BFBFBF)
      ListIconGadget(#Gadget_Blobby_BlobList, 5, 5, 290, 535, "Picture name", 286, #PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        SetGadgetColor(#Gadget_Blobby_BlobList, #PB_Gadget_BackColor, $DBDBDB)
        AddGadgetColumn(#Gadget_Blobby_BlobList, 1, "Record", 0)
        SetGadgetFont(#Gadget_Blobby_BlobList, LoadFont(#Gadget_Blobby_BlobList, "Comic Sans MS", 10, 0))
      CloseGadgetList()
      ContainerGadget(#Gadget_Blobby_cPicture, 310, 5, 490, 440, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_Blobby_cPicture, #PB_Gadget_BackColor, $BFBFBF)
      ImageGadget(#Gadget_Blobby_Picture, 5, 5, 480, 430, 0)
      CloseGadgetList()
      ContainerGadget(#Gadget_Blobby_cDetails, 310, 450, 490, 100, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_Blobby_cDetails, #PB_Gadget_BackColor, $BFBFBF)
      EditorGadget(#Gadget_Blobby_Details, 5, 5, 480, 90, #PB_Editor_ReadOnly|#PB_Editor_WordWrap)
        SetGadgetColor(#Gadget_Blobby_Details, #PB_Gadget_BackColor, $DBDBDB)
        SetGadgetFont(#Gadget_Blobby_Details, LoadFont(#Gadget_Blobby_Details, "Comic Sans MS", 10, 0))
      CloseGadgetList()
      ContainerGadget(#Gadget_Blobby_cControl, 5, 555, 795, 60, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_Blobby_cControl, #PB_Gadget_BackColor, $BFBFBF)
      ButtonImageGadget(#Gadget_Blobby_Add, 5, 5, 45, 45, ImageID(#Image_Blobby_Add))
      ButtonImageGadget(#Gadget_Blobby_Delete, 50, 5, 45, 45, ImageID(#Image_Blobby_Delete))
      ButtonImageGadget(#Gadget_Blobby_Edit, 95, 5, 45, 45, ImageID(#Image_Blobby_Edit))
      ButtonImageGadget(#Gadget_Blobby_Save, 140, 5, 45, 45, ImageID(#Image_Blobby_Save))
      ButtonImageGadget(#Gadget_Blobby_Exit, 745, 5, 45, 45, ImageID(#Image_Blobby_Exit))
      CloseGadgetList()
      ContainerGadget(#Gadget_Blobby_cMessages, 5, 620, 795, 24, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_Blobby_cMessages, #PB_Gadget_BackColor, $BFBFBF)
      ImageGadget(#Gadget_Blobby_iMessages, 5, 3, 16, 16, ImageID(#Image_Blobby_iMessages))
      StringGadget(#Gadget_Blobby_Messages, 25, 0, 765, 21, "", #PB_String_BorderLess)
        SetGadgetColor(#Gadget_Blobby_Messages, #PB_Gadget_BackColor, $BFBFBF)
        SetGadgetFont(#Gadget_Blobby_Messages, LoadFont(#Gadget_Blobby_Messages, "Comic Sans MS", 11, 0))
      CloseGadgetList()
      HideWindow(#Window_Blobby, 0)
    ProcedureReturn WindowID(#Window_Blobby)
  EndIf
EndProcedure

Procedure.l Window_BlobbyData()
  If OpenWindow(#Window_BlobbyData, 80, 75, 500, 630, "", #PB_Window_SystemMenu|#PB_Window_ScreenCentered|#PB_Window_Invisible, WindowID(#Window_Blobby))
      SetWindowColor(#Window_BlobbyData, $A2A2A2)
      ContainerGadget(#Gadget_BlobbyData_cPicture, 5, 5, 490, 440, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_BlobbyData_cPicture, #PB_Gadget_BackColor, $BFBFBF)
      ImageGadget(#Gadget_BlobbyData_Picture, 5, 5, 480, 430, 0)
      CloseGadgetList()
      ContainerGadget(#Gadget_BlobbyData_cDetails, 5, 450, 490, 110, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_BlobbyData_cDetails, #PB_Gadget_BackColor, $BFBFBF)
      EditorGadget(#Gadget_BlobbyData_Details, 5, 5, 480, 100, #PB_Editor_WordWrap)
        SetGadgetColor(#Gadget_BlobbyData_Details, #PB_Gadget_BackColor, $DBDBDB)
        SetGadgetFont(#Gadget_BlobbyData_Details, LoadFont(#Gadget_BlobbyData_Details, "Comic Sans MS", 10, 0))
      CloseGadgetList()
      ContainerGadget(#Gadget_BlobbyData_cControl, 5, 565, 490, 60, #PB_Container_Flat|#PB_Container_BorderLess)
        SetGadgetColor(#Gadget_BlobbyData_cControl, #PB_Gadget_BackColor, $BFBFBF)
      ButtonImageGadget(#Gadget_BlobbyData_Save, 5, 5, 45, 45, ImageID(#Image_BlobbyData_Save))
      ButtonImageGadget(#Gadget_BlobbyData_Camera, 50, 5, 45, 45, ImageID(#Image_BlobbyData_Camera))
      ButtonImageGadget(#Gadget_BlobbyData_Exit, 440, 5, 45, 45, ImageID(#Image_BlobbyData_Exit))
      StringGadget(#Gadget_BlobbyData_Mode, 105, 10, 145, 20, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_BlobbyData_Mode, #PB_Gadget_BackColor, $DBDBDB)
        SetGadgetColor(#Gadget_BlobbyData_Mode, #PB_Gadget_FrontColor, $FF0000)
        SetGadgetFont(#Gadget_BlobbyData_Mode, LoadFont(#Gadget_BlobbyData_Mode, "Comic Sans MS", 10, 0))
      StringGadget(#Gadget_BlobbyData_Record, 285, 10, 145, 20, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_BlobbyData_Record, #PB_Gadget_BackColor, $DBDBDB)
        SetGadgetColor(#Gadget_BlobbyData_Record, #PB_Gadget_FrontColor, $FF0000)
        SetGadgetFont(#Gadget_BlobbyData_Record, LoadFont(#Gadget_BlobbyData_Record, "Comic Sans MS", 10, 0))
      TextGadget(#Gadget_BlobbyData_lMode, 105, 35, 325, 15, " Current mode                                     Record number")
        SetGadgetColor(#Gadget_BlobbyData_lMode, #PB_Gadget_BackColor, $BFBFBF)
        SetGadgetFont(#Gadget_BlobbyData_lMode, LoadFont(#Gadget_BlobbyData_lMode, "Comic Sans MS", 8, 0))
      CloseGadgetList()
      HideWindow(#Window_BlobbyData, 0)
    ProcedureReturn WindowID(#Window_BlobbyData)
  EndIf
EndProcedure

; 

Declare   OpenSystemDatabase()                                                          ; Try to open the system database and create missing tables
Declare.s DatabaseLastInsertRowId()                                                     ; Get the ID of the last inserted record

; 

Declare.s ByteCalc(Byte.q, NbDecimals = 2)                                              ; AND51's correct file size calculation code
Declare   CloseMyWindow(WindowId.i)                                                     ; Fade the window out gently, close it and reset the mutex
Declare.s KillQuote(Instring.s)                                                         ; Kill double quotes in strings for display purposes
Declare   LastLine(Gadget.i, LineNumber.i)                                              ; Go to the last line of a ListIconGadget
Declare.s LastRecord(TableField.s, TableName.s)                                         ; Find the last record number in the database, not necessarily the last record though due to deletions (fang)
Declare.s RepQuote(Instring.s)                                                          ; Uncle Berikco's routine to properly replace single quotes with double for SQL passing

; 

Declare   ListPicturesMainForm()                                                        ; Load and display all pictures in the database
Declare   DisplayPictureMainForm()                                                      ; Show the picture for a selected record

; 

Declare   AddPicture()                                                                  ; Add a new picture to the database
Declare   DeletePictureFromDatabase()                                                   ; Delete a picture from the database
Declare   EditPicture()                                                                 ; Edit the currently selected picture
Declare   LoadPictureFromDisk()                                                         ; Load a picture from disk into the data form
Declare   SavePictureToDatabase()                                                       ; Save a new or edited picture to the database
Declare   SavePictureToDisk()                                                           ; Save a picture back to disk from the database

; Use for viewing various picture formats

UseJPEG2000ImageDecoder()
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()

; Use the SQLite database environment

UseSQLiteDatabase()
  
; Keep track of various program parameters

Structure ProgramData
  QuitFlag.i
  MutexVal.i
  
  LastWindow.s
  
  DatabaseHandle.i
  DatabaseName.s
  
  CurrentDir.s
  CurrentLine.i
  CurrentRecord.s
  
  ImageWidth.i
  ImageHeight.i
  
  OldPictureName.s
  NewPictureName.s
EndStructure

; Database structure

Structure DatabaseData
  BlobData.s     ; 0
  BlobName.s     ; 1
  BlobPath.s     ; 2
  BlobSize.s     ; 3
  BlobDate.s     ; 4
  BlobComment.s  ; 5
  BlobRecord.s   ; 6
EndStructure

; Make sure the structure data is globally available

Global Program.ProgramData
Global Database.DatabaseData

; 

Program\CurrentDir    = GetCurrentDirectory()
Program\DatabaseName  = Program\CurrentDir + "Database\Blobby.db3"

; 

Program\ImageWidth    = 480
Program\ImageHeight   = 430
  
; 

Enumeration #ImageIndex
  #Image_Blobby_BlobList
EndEnumeration

; 

CatchImage(#Image_Blobby_BlobList, ?_OPT_Blobby_BlobList)

; 

DataSection
  _OPT_Blobby_BlobList  : IncludeBinary "Images\blob16x16.ico"
EndDataSection

; Get the ID of the last inserted record

Procedure.s DatabaseLastInsertRowId()
  If DatabaseQuery(Program\DatabaseHandle, "SELECT last_insert_rowid()")
    If FirstDatabaseRow(Program\DatabaseHandle)
      RecordId.s = GetDatabaseString(Program\DatabaseHandle, 0)
    EndIf
    FinishDatabaseQuery(Program\DatabaseHandle)
  Else
    RecordId.s = ""
  EndIf
  ProcedureReturn RecordId.s
EndProcedure

; Find the last record number in the database, not necessarily the last record though due to deletions (fang)

Procedure.s LastRecord(TableField.s, TableName.s)
  ; Always create long winded queries for readability
  SqlQueryString.s = "SELECT MAX(" + TableField.s + ") As LASTREC FROM " + TableName.s + ""
  If DatabaseQuery(Program\DatabaseHandle, SqlQueryString.s)
    While NextDatabaseRow(Program\DatabaseHandle)
      LastRecord.s = GetDatabaseString(Program\DatabaseHandle,  0)
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
    ProcedureReturn LastRecord.s
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "Failed to get the last record inserted: " + DatabaseError())
  EndIf  
EndProcedure

; Try to open the system database and create missing tables

Procedure OpenSystemDatabase()
  ; Create the database if it doesn't already exist.
  DbFileHandle.i = OpenFile(#PB_Any, Program\DatabaseName)
  If DbFileHandle.i
    CloseFile(DbFileHandle.i)
    Program\DatabaseHandle = OpenDatabase(#PB_Any, Program\DatabaseName, "", "")
    If Program\DatabaseHandle
      ; Turn on auto database vacuum
      If Not DatabaseUpdate(Program\DatabaseHandle, "PRAGMA auto_vacuum = on")
        SetGadgetText(#Gadget_Blobby_Messages, "Could not turn on automatic wasted space vacuuming." + DatabaseError())
      EndIf
      ; Write the Blobby table out
      SqlQueryString.s = "CREATE TABLE IF NOT EXISTS Blobby("
      SqlQueryString.s + "BlobData BLOB, BlobName Text, BlobPath Text, BlobSize Text, BlobDate Text, "
      SqlQueryString.s + "BlobComment Text, "
      SqlQueryString.s + "BlobRecord INTEGER PRIMARY KEY AUTOINCREMENT)"
      If Not DatabaseUpdate(Program\DatabaseHandle, SqlQueryString.s)
        SetGadgetText(#Gadget_Blobby_Messages, "Could not add missing tables to blobtest database." + DatabaseError())
      EndIf
      ; We had a problem getting the database handle
    Else
      MessageRequester("Database open error", "Error attempting to connect to system database.", #PB_MessageRequester_Ok)
    EndIf 
  Else
    MessageRequester("Database open error", "Could not open or create raw database file.", #PB_MessageRequester_Ok)
  EndIf
EndProcedure

; AND51's correct file size calculation code

Procedure.s ByteCalc(Byte.q, NbDecimals = 2)
  Protected Unit.b = Round(Log(Byte) / Log(1024), 0)
  ProcedureReturn StrD(Byte / Pow(1024, Unit), NbDecimals * (Unit & 1)) + " " + StringField("Byte,KB,MB,GB,TB,PB,EB", Unit + 1, ",")
EndProcedure

; Fade the window out gently, close it and reset the mutex

Procedure CloseMyWindow(WindowId.i)
  ; Close the requested form window if it is not the master window
  If WindowId.i <> #Window_Blobby
    ; Close the specified window
    CloseWindow(WindowId.i)
    ; Re-enable main window
    DisableWindow(#Window_Blobby, 0)
    ; Set focus on main window
    SetActiveWindow(#Window_Blobby)
    ; Activate the item list
    SetActiveGadget(#Gadget_Blobby_BlobList)
    ; Go to the previously selected line
    LastLine(#Gadget_Blobby_BlobList, Program\CurrentLine)
    ; Activate the previously selected line
    SetGadgetState(#Gadget_Blobby_BlobList, Program\CurrentLine)
    ; Trigger a change event on the selected line
    SetGadgetItemState(#Gadget_Blobby_BlobList, Program\CurrentLine, #PB_ListIcon_Selected)
    ; Clean up all loose variables
    Program\MutexVal        =  0                                                                    ; Make sure other windows can open now  
    Program\CurrentLine     = -1                                                                    ; Make sure no line can be selected accidentally
    Program\CurrentRecord   = ""                                                                    ; Nullify the current record number to avoid mistakes
    Program\LastWindow      = ""                                                                    ; Clear last used windows state
    Program\NewPictureName  = ""                                                                    ; Clear the new picture name on any exit
    Program\OldPictureName  = ""                                                                    ; Clear the old picture name on any exit
  EndIf
EndProcedure

; Kill double quotes in strings for display purposes

Procedure.s KillQuote(Instring.s)
  ProcedureReturn ReplaceString(Instring.s, "''", "'", 1, 1)
EndProcedure

; Go to the last line of a ListIconGadget

Procedure LastLine(Gadget.i, LineNumber.i)
  ; Make sure the current line is visible
  SendMessage_(GadgetID(Gadget.i), #LVM_ENSUREVISIBLE, LineNumber.i, 0)
EndProcedure

; Uncle Berikco's routine to properly replace single quotes with double for SQL passing

Procedure.s RepQuote(Instring.s)
  For i = 1 To Len(Instring.s)
    If Mid(Instring.s, i, 1) = "'"
      TemporaryString.s = TemporaryString.s + "''"
    Else
      TemporaryString.s = TemporaryString.s + Mid(Instring.s, i, 1)
    EndIf
  Next i
  ProcedureReturn TemporaryString.s
EndProcedure

; Show the picture for a selected record

Procedure DisplayPictureMainForm()
  ; Get the currently selected line
  Program\CurrentLine = GetGadgetState(#Gadget_Blobby_BlobList)
  ; Only proceed if there is a current line
  If  Program\CurrentLine <> -1
    ; Get the record number from the selected line
    Program\CurrentRecord = GetGadgetItemText(#Gadget_Blobby_BlobList, Program\CurrentLine, 1)
    ; Only proceed if there was a valid record number
    If Program\CurrentRecord
      SqlQueryString.s = "SELECT BlobData, BlobComment FROM Blobby WHERE BlobRecord = '" + Program\CurrentRecord + "'"
      If DatabaseQuery(Program\DatabaseHandle, SqlQueryString.s)
        While NextDatabaseRow(Program\DatabaseHandle)
          BlobImageSize.i   = DatabaseColumnSize(Program\DatabaseHandle, 0)
          If BlobImageSize.i
            *BlobbyBuffer = AllocateMemory(BlobImageSize)
            If *BlobbyBuffer
              If GetDatabaseBlob(Program\DatabaseHandle, 0, *BlobbyBuffer, BlobImageSize.i)
                ImageNumber.i = CatchImage(#PB_Any, *BlobbyBuffer)
                If ImageNumber.i
                  ResizeImage(ImageNumber.i, Program\ImageWidth, Program\ImageHeight, #PB_Image_Smooth)
                  SetGadgetState(#Gadget_Blobby_Picture, ImageID(ImageNumber.i))
                  SetGadgetText(#Gadget_Blobby_Details, KillQuote(GetDatabaseString(Program\DatabaseHandle, 1)))
                Else
                  SetGadgetText(#Gadget_Blobby_Messages, "Did not get a valid image handle to display this picture")
                EndIf
              Else
                SetGadgetText(#Gadget_Blobby_Messages, "Could not retrieve the blob data from the database")
              EndIf
              FreeMemory(*BlobbyBuffer)
            Else
              SetGadgetText(#Gadget_Blobby_Messages, "Could not allocate a buffer for the blob data")
            EndIf
          Else
            SetGadgetText(#Gadget_Blobby_Messages, "There is no image data stored in that recprd")
          EndIf
        Wend
        FinishDatabaseQuery(Program\DatabaseHandle)
      Else
        SetGadgetText(#Gadget_Blobby_Messages, "The database query failed: " + DatabaseError())
      EndIf
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "Could not get a record number from the first line")
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "No active line selected")
  EndIf
EndProcedure

; Load and display all pictures in the database

Procedure ListPicturesMainForm()
  SqlQueryString.s = "SELECT * FROM Blobby"
  If DatabaseQuery(Program\DatabaseHandle, SqlQueryString.s)
    While NextDatabaseRow(Program\DatabaseHandle)
;     BlobData.s    =  ?
      BlobName.s    =  KillQuote(GetDatabaseString(Program\DatabaseHandle, 1))
      BlobPath.s    =  KillQuote(GetDatabaseString(Program\DatabaseHandle, 2))
      BlobSize.s    =            GetDatabaseString(Program\DatabaseHandle, 3) 
      BlobDate.s    =            GetDatabaseString(Program\DatabaseHandle, 4) 
      BlobComment.s =            GetDatabaseString(Program\DatabaseHandle, 5) 
      BlobRecord.s  =            GetDatabaseString(Program\DatabaseHandle, 6) 
      AddGadgetItem(#Gadget_Blobby_BlobList, -1, BlobName.s + Chr(10) + BlobRecord.s, ImageID(#Image_Blobby_BlobList))
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
  EndIf
  If CountGadgetItems(#Gadget_Blobby_BlobList) <> 0
    SetActiveGadget(#Gadget_Blobby_BlobList)
    SetGadgetState(#Gadget_Blobby_BlobList, 0)
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "No items in the list to display pictures for")
  EndIf
EndProcedure

; Add a new picture to the database

Procedure AddPictureWindow()
  If Program\MutexVal <> 1
    If Window_BlobbyData()
      Program\MutexVal = 1
      DisableWindow(#Window_Blobby, 1)
      ; Get the last record number in the database and give the next probable record number
      NextRecord.i = Val(LastRecord("BlobRecord", "Blobby")) + 1      
      ; Setup the common window message
      Message.s = "Add New BlobTest Entry"
      Program\LastWindow = Message.s
      SetWindowTitle(#Window_BlobbyData, Message.s + "  -  (Record: " + Str(NextRecord.i) + " ?)")
      SetGadgetText(#Gadget_BlobbyData_Mode, "Add new picture")
      SetGadgetText(#Gadget_BlobbyData_Record, Str(NextRecord.i) + " ?")
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "Could not open the blobby data window.")
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "Another program window is already open, close that one first.")
  EndIf
EndProcedure

; Delete a picture from the database

Procedure DeletePictureFromDatabase()
  ; Get the currently selected line
  Program\CurrentLine = GetGadgetState(#Gadget_Blobby_BlobList)
  ; Only proceed if there is a current line
  If  Program\CurrentLine <> -1
    ; Get the record number from the selected line
    Program\CurrentRecord = GetGadgetItemText(#Gadget_Blobby_BlobList, Program\CurrentLine, 1)
    ; Only proceed if there was a valid record number
    If Program\CurrentRecord
      SqlQueryString.s = "DELETE FROM Blobby WHERE BlobRecord = '" + Program\CurrentRecord + "'"
      If DatabaseUpdate(Program\DatabaseHandle, SqlQueryString.s)
        RemoveGadgetItem(#Gadget_Blobby_BlobList, Program\CurrentLine)
        SetActiveGadget(#Gadget_Blobby_BlobList)
        SetGadgetState(#Gadget_Blobby_BlobList, Program\CurrentLine)
      Else
        SetGadgetText(#Gadget_Blobby_Messages, "Could not delete the selected picture from the database")
      EndIf
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "No record number found on the selected line.")
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "No active line selected")
  EndIf
EndProcedure

; Edit the currently selected picture

Procedure EditPictureWindow()
  ; Get the currently selected line
  Program\CurrentLine = GetGadgetState(#Gadget_Blobby_BlobList)
  ; Only proceed if there is a current line
  If  Program\CurrentLine <> -1
    ; Get the record number from the selected line
    Program\CurrentRecord = GetGadgetItemText(#Gadget_Blobby_BlobList, Program\CurrentLine, 1)
    ; Only proceed if there was a valid record number
    If Program\CurrentRecord
      If Program\MutexVal <> 1
        If Window_BlobbyData()
          Program\MutexVal = 1
          ; Setup the common window message
          Message.s = "Edit Old BlobTest Entry"
          Program\LastWindow = Message.s
          SetWindowTitle(#Window_BlobbyData, Message.s)
          SetGadgetText(#Gadget_BlobbyData_Mode, "Edit record mode")
          SqlQueryString.s = "SELECT * FROM Blobby WHERE BlobRecord = '" + Program\CurrentRecord + "'"
          If DatabaseQuery(Program\DatabaseHandle, SqlQueryString.s)
            While NextDatabaseRow(Program\DatabaseHandle)
              BlobImageSize.i = DatabaseColumnSize(Program\DatabaseHandle, 0)
              If BlobImageSize.i
                *BlobbyBuffer = AllocateMemory(BlobImageSize)
                If *BlobbyBuffer
                  If GetDatabaseBlob(Program\DatabaseHandle, 0, *BlobbyBuffer, BlobImageSize.i)
                    ImageNumber.i = CatchImage(#PB_Any, *BlobbyBuffer)
                    If ImageNumber.i
                      ResizeImage(ImageNumber.i, Program\ImageWidth, Program\ImageHeight, #PB_Image_Smooth)
                      SetGadgetState(#Gadget_BlobbyData_Picture, ImageID(ImageNumber.i))
                      BlobName.s      = KillQuote(GetDatabaseString(Program\DatabaseHandle, 1))
                      BlobPath.s      = KillQuote(GetDatabaseString(Program\DatabaseHandle, 2))
                      BlobSize.s      =           GetDatabaseString(Program\DatabaseHandle, 3) 
                      BlobDate.s      =           GetDatabaseString(Program\DatabaseHandle, 4) 
                      BlobComment.s   = KillQuote(GetDatabaseString(Program\DatabaseHandle, 5))
                      BlobRecord.s    =           GetDatabaseString(Program\DatabaseHandle, 6) 
                      SetGadgetText(#Gadget_BlobbyData_Details, BlobComment.s)
                      SetGadgetText(#Gadget_BlobbyData_Record, BlobRecord.s)
                      Program\OldPictureName = BlobPath.s + BlobName.s
                    Else
                      SetGadgetText(#Gadget_Blobby_Messages, "Did not get a valid image handle to display this picture")
                    EndIf
                  Else
                    SetGadgetText(#Gadget_Blobby_Messages, "Could not retrieve the blob data from the database")
                  EndIf
                  FreeMemory(*BlobbyBuffer)
                Else
                  SetGadgetText(#Gadget_Blobby_Messages, "Could not allocate a buffer for the blob data")
                EndIf
              Else
                SetGadgetText(#Gadget_Blobby_Messages, "There is no image data stored in that recprd")
              EndIf
            Wend
            FinishDatabaseQuery(Program\DatabaseHandle)
          Else
            SetGadgetText(#Gadget_Blobby_Messages, "The database query failed: " + DatabaseError())
          EndIf
        Else
          SetGadgetText(#Gadget_Blobby_Messages, "Could not open the edit picture window")
        EndIf
      Else
        SetGadgetText(#Gadget_Blobby_Messages, "Another program window is already open, close that one first.")
      EndIf
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "No record number found on the selected line.")
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "No active line selected")
  EndIf
EndProcedure

; Load a picture from disk into the data form

Procedure LoadPictureFromDisk()
  PictureToLoad.s = OpenFileRequester("Select picture", "", "Jpeg (*.jpg *.jpeg *.jfif)|*.jpg;*.jpeg;*.jfif|Bitmap (*.bmp)|*.bmp|Targa (*.tga)|*.tga|Tiff (*.tif)|*.tif|Png (*.png)|*.png|Icon (*.ico)|*.ico|All files (*.*)|*.*", 0)
  If PictureToLoad.s
    ImageNumber.i = LoadImage(#PB_Any, PictureToLoad.s)
    If ImageNumber.i
      ResizeImage(ImageNumber.i, Program\ImageWidth, Program\ImageHeight, #PB_Image_Smooth)
      SetGadgetState(#Gadget_BlobbyData_Picture, ImageID(ImageNumber.i))
      Program\NewPictureName = PictureToLoad.s
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "Could not get the image handle, nothing loaded")
      Program\NewPictureName = ""
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "Nothing to load, user cancelled the process")
  EndIf
EndProcedure

; Save a new or edited picture to the database

Procedure SavePictureToDatabase()
  ; BlobData.s                                                  The actual binary data to be stored
  BlobName.s    = RepQuote(GetFilePart(Program\NewPictureName))
  BlobPath.s    = RepQuote(GetPathPart(Program\NewPictureName))
  BlobSize.s    = ByteCalc(FileSize(BlobFile.s), 2)
  BlobDate.s    = FormatDate("%dd/%mm/%yyyy", GetFileDate(BlobFile.s, #PB_Date_Created))
  BlobComment.s = RepQuote(GetGadgetText(#Gadget_BlobbyData_Details))
; Record.s                                                    Automatically generated field
  Select Program\LastWindow
    Case "Add New BlobTest Entry"
      If Program\NewPictureName <> ""
        FileIn.i = ReadFile(#PB_Any, Program\NewPictureName)
        If FileIn.i
          FileInSize.i = Lof(FileIn.i)
          *Buffer = AllocateMemory(FileInSize.i)
          If *Buffer
            If ReadData(FileIn.i, *Buffer, FileInSize.i) = FileInSize.i
              SetDatabaseBlob(Program\DatabaseHandle, 0, *Buffer, FileInSize.i)
              SqlQueryString.s = "INSERT INTO Blobby ("
              SqlQueryString.s + "BlobData, BlobName, BlobPath, BlobSize, BlobDate, BlobComment) "
              SqlQueryString.s + "VALUES ("
              SqlQueryString.s + "?, '"                                  ; This is the picture data to be filled in from the buffer
              SqlQueryString.s + BlobName.s         + "', '"
              SqlQueryString.s + BlobPath.s         + "', '"
              SqlQueryString.s + BlobSize.s         + "', '"
              SqlQueryString.s + BlobDate.s         + "', '"
              SqlQueryString.s + BlobComment.s      + "'"
              SqlQueryString.s +                      ")"
              If DatabaseUpdate(Program\DatabaseHandle, SqlQueryString.s)
                NewRecord.s = DatabaseLastInsertRowId()
                If NewRecord.s
                  AddGadgetItem(#Gadget_Blobby_BlobList, -1, BlobName.s + Chr(10) + NewRecord.s, ImageID(#Image_Blobby_BlobList))
                  ; New record was inserted okay
                Else
                  SetGadgetText(#Gadget_Blobby_Messages, "Could not get the record number for this stored record???" + DatabaseError())
                EndIf
              Else
                SetGadgetText(#Gadget_Blobby_Messages, "The database insertion failed: " + DatabaseError())
              EndIf
            Else
              SetGadgetText(#Gadget_Blobby_Messages, "Could not read data from designated input file")
            EndIf
            FreeMemory(*Buffer)
          Else
            SetGadgetText(#Gadget_Blobby_Messages, "Could not allocate memory to the input buffer")
          EndIf
          CloseFile(FileIn.i)
        Else
          SetGadgetText(#Gadget_Blobby_Messages, "Could not open the designated file to read from")
        EndIf
      Else
        SetGadgetText(#Gadget_Blobby_Messages, "Nothing to save, user didn't choose a picture")
      EndIf
    Case "Edit Old BlobTest Entry"
      If Program\NewPictureName <> ""
        FileIn.i = ReadFile(#PB_Any, Program\NewPictureName)
        If FileIn.i
          FileInSize.i = Lof(FileIn.i)
          *Buffer = AllocateMemory(FileInSize.i)
          If *Buffer
            If ReadData(FileIn.i, *Buffer, FileInSize.i) = FileInSize.i
              SetDatabaseBlob(Program\DatabaseHandle, 0, *Buffer, FileInSize.i)
              SqlQueryString.s = "UPDATE Blobby SET "
              SqlQueryString.s + "BlobData = ?, "                                  ; This is the picture data to be filled in from the buffer
              SqlQueryString.s + "BlobName = '"         + BlobName.s            + "', '"
              SqlQueryString.s + "BlobName = '"         + BlobName.s            + "', '"
              SqlQueryString.s + "BlobPath = '"         + BlobPath.s            + "', '"
              SqlQueryString.s + "BlobSize = '"         + BlobSize.s            + "', '"
              SqlQueryString.s + "BlobDate = '"         + BlobDate.s            + "', '"
              SqlQueryString.s + "BlobComment = '"      + BlobComment.s         + "' "
              SqlQueryString.s + "WHERE BlobRecord = '" + Program\CurrentRecord + "'"
              If DatabaseUpdate(Program\DatabaseHandle, SqlQueryString.s)
                SetGadgetText(#Gadget_Blobby_Messages, "The changed record was saved back to the database.")
              Else
                SetGadgetText(#Gadget_Blobby_Messages, "The database record update failed: " + DatabaseError())
              EndIf
            Else
              SetGadgetText(#Gadget_Blobby_Messages, "Could not read data from designated input file")
            EndIf
            FreeMemory(*Buffer)
          Else
            SetGadgetText(#Gadget_Blobby_Messages, "Could not allocate memory to the input buffer")
          EndIf
          CloseFile(FileIn.i)
        Else
          SetGadgetText(#Gadget_Blobby_Messages, "Could not open the designated file to read from")
        EndIf
      Else
        SqlQueryString.s = "UPDATE Blobby SET "
        SqlQueryString.s + "BlobComment = '"      + BlobComment.s         + "' "
        SqlQueryString.s + "WHERE BlobRecord = '" + Program\CurrentRecord + "'"
        If DatabaseUpdate(Program\DatabaseHandle, SqlQueryString.s)
          SetGadgetText(#Gadget_Blobby_Messages, "The changed comment was saved back to the database.")
        Else
          SetGadgetText(#Gadget_Blobby_Messages, "The database comment update failed: " + DatabaseError())
        EndIf
      EndIf
  EndSelect
  CloseMyWindow(#Window_BlobbyData)
EndProcedure

; Save a picture back to disk from the database

Procedure SavePictureToDisk()
  ; Get the currently selected line
  Program\CurrentLine = GetGadgetState(#Gadget_Blobby_BlobList)
  ; Only proceed if there is a current line
  If  Program\CurrentLine <> -1
    ; Get the record number from the selected line
    Program\CurrentRecord = GetGadgetItemText(#Gadget_Blobby_BlobList, Program\CurrentLine, 1)
    ; Only proceed if there was a valid record number
    If Program\CurrentRecord
      SqlQueryString.s = "SELECT * FROM Blobby WHERE BlobRecord = '" + Program\CurrentRecord + "'"
      If DatabaseQuery(Program\DatabaseHandle, SqlQueryString.s)
        While NextDatabaseRow(Program\DatabaseHandle)
          BlobImageSize.i   = DatabaseColumnSize(Program\DatabaseHandle, 0)
          If BlobImageSize.i
            *BlobbyBuffer = AllocateMemory(BlobImageSize)
            If *BlobbyBuffer
              If GetDatabaseBlob(Program\DatabaseHandle, 0, *BlobbyBuffer, BlobImageSize.i)
                BlobColumnSize.i  = DatabaseColumnSize(Program\DatabaseHandle, 0) 
                BlobName.s        = KillQuote(GetDatabaseString(Program\DatabaseHandle, 1))
                BlobPath.s        = KillQuote(GetDatabaseString(Program\DatabaseHandle, 2))
                BlobSize.s        =           GetDatabaseString(Program\DatabaseHandle, 3) 
                BlobDate.s        =           GetDatabaseString(Program\DatabaseHandle, 4) 
                BlobComment.s     = KillQuote(GetDatabaseString(Program\DatabaseHandle, 5))
                BlobRecord.s      =           GetDatabaseString(Program\DatabaseHandle, 6) 
                BlobFileId.i      = CreateFile(#PB_Any, Program\CurrentDir  + BlobName.s)
                If BlobFileId.i
                  WriteData(BlobFileId.i, *BlobbyBuffer, BlobColumnSize.i)
                  SetGadgetText(#Gadget_Blobby_Messages, "We saved: " + BlobName.s  + " to disk")
                  CloseFile(BlobFileId.i)
                Else
                  SetGadgetText(#Gadget_Blobby_Messages, "We didn't get the image back from the blob buffer")
                EndIf
              Else
                SetGadgetText(#Gadget_Blobby_Messages, "Could not retrieve the blob data from the database")
              EndIf
              FreeMemory(*BlobbyBuffer)
            Else
              SetGadgetText(#Gadget_Blobby_Messages, "Could not allocate a buffer for the blob data")
            EndIf
          Else
            SetGadgetText(#Gadget_Blobby_Messages, "There is no image data stored in that record")
          EndIf
        Wend
        FinishDatabaseQuery(Program\DatabaseHandle)
      Else
        SetGadgetText(#Gadget_Blobby_Messages, "The database query failed: " + DatabaseError())
      EndIf
    Else
      SetGadgetText(#Gadget_Blobby_Messages, "No record number found on the selected line.")
    EndIf
  Else
    SetGadgetText(#Gadget_Blobby_Messages, "No active line selected")
  EndIf
EndProcedure

; Main program event handler

If Window_Blobby()
  Program\QuitFlag = 0
  OpenSystemDatabase()
  ListPicturesMainForm()
  SetGadgetText(#Gadget_Blobby_Messages, "Hello, Blobby is ready to work!")
  Repeat
    EventID  = WaitWindowEvent()
    MenuID   = EventMenu()
    GadgetID = EventGadget()
    WindowID = EventWindow()
    Select EventID
      Case #PB_Event_CloseWindow
        Select WindowID
          Case #Window_Blobby                       : Program\QuitFlag = 1
          Case #Window_BlobbyData                   : CloseMyWindow(#Window_BlobbyData)
        EndSelect
      Case #PB_Event_Gadget
        Select GadgetID
          Case #Gadget_Blobby_BlobList
            Select EventType()
              Case #PB_EventType_LeftDoubleClick    : EditPictureWindow()
              Case #PB_EventType_RightDoubleClick   : AddPictureWindow()
              Case #PB_EventType_Change             : DisplayPictureMainForm()
            EndSelect
            ; Main form controls
          Case #Gadget_Blobby_Add                   : AddPictureWindow()
          Case #Gadget_Blobby_Delete                : DeletePictureFromDatabase()
          Case #Gadget_Blobby_Edit                  : EditPictureWindow()
          Case #Gadget_Blobby_Save                  : SavePictureToDisk()
          Case #Gadget_Blobby_Exit                  : Program\QuitFlag = 1
          ; Data form controls
          Case #Gadget_BlobbyData_Save              : SavePictureToDatabase()
          Case #Gadget_BlobbyData_Camera            : LoadPictureFromDisk()
          Case #Gadget_BlobbyData_Exit              : CloseMyWindow(#Window_BlobbyData)
        EndSelect
    EndSelect
  Until Program\QuitFlag
  CloseWindow(#Window_Blobby)
EndIf
End

electrochrisso · Post by **electrochrisso** » Thu Jun 27, 2013 3:24 am

Good stuff Fang, got a link to download the correct icons.

Fangbeast · Post by **Fangbeast** » Thu Jun 27, 2013 5:10 am

electrochrisso wrote:Good stuff Fang, got a link to download the correct icons.

Lazy sod, call yourself a programmer??? Get your own icons!! (VERY EVIL GRIN).

NOOO!!! Don't bash me!!! MWUAHAHAHAHAH

Just stick your own boring icons in there for now, this isn't meant to be a project, just a follow on to the advice I got years ago from NetMaestro that I was too busy (cancer) to do anything about for now.

I'm going to add this functionality now to my movie database manager (that is a postable project and was added to my web site) and then upload that onto my web pages. After I chase my wife around the house.

P.S. The movie database (simple though it is) has search features etc.

electrochrisso · Post by **electrochrisso** » Thu Jun 27, 2013 11:47 am

Lazy sod, call yourself a programmer??? Get your own icons!! (VERY EVIL GRIN).

Yeah! I know, but I have a lot on at the moment.

And stop chasing your missus around, and get that Bin2Data working.

PureBasic Forums - English

Using the new DatabaseBlob command..

Using the new DatabaseBlob command..

Example program using NetMaestro's help

Re: Using the new DatabaseBlob command..

Re: Using the new DatabaseBlob command..

Re: Using the new DatabaseBlob command..

Re: Using the new DatabaseBlob command..

Re: Using the new DatabaseBlob command..