Platforms to show: All Mac Windows Linux Cross-Platform
Required plugins for this example: MBS Images Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Images/JPEG/Picture Database
This example is the version from Thu, 6th Apr 2016.
Project "Picture Database.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
dim f as FolderItem
f=SpecialFolder.Desktop.Child("Picture Database.db")
db=new REALSQLDatabase
db.DatabaseFile=f
if f.Exists then
if db.Connect then
MainWindow.show
else
MsgBox "Failed to open database file"
end if
else
if db.CreateDatabaseFile then
db.SQLExecute "create table pictures (name varchar, pic blob)"
if db.Error then
MsgBox db.ErrorMessage
Return
end if
mainwindow.show
else
MsgBox "Failed to create database file"
end if
end if
End EventHandler
Property DB As REALSQLDatabase
End Class
Class mainwindow Inherits Window
Control List Inherits ListBox
ControlInstance List Inherits ListBox
EventHandler Sub Change()
dim rowid as string
dim r as RecordSet
dim data as string
if me.ListIndex=-1 then
Canvas1.Backdrop=nil
else
rowid=me.Celltag(me.ListIndex,0)
// find database record
r=app.db.SQLSelect("select pic from pictures where ROWID="+rowid)
// load blob value into string
data=r.Field("pic").Value
// decode jpeg picture
Canvas1.Backdrop=JPEGStringToPictureMBS(data)
end if
End EventHandler
EventHandler Sub DropObject(obj As DragItem, action As Integer)
dim f as FolderItem
dim p as Picture
dim s as string
dim needupdate as Boolean
do
if obj.FolderItemAvailable then
f=obj.FolderItem
// let us load the picture
p=f.OpenAsPicture
if p<>nil then
// make a jpeg from it.
// of course other formats work are possible
// or just loading the file using a binarystream without recompressing
s=PictureToJPEGStringMBS(p,75)
dim r as new DatabaseRecord
r.BlobColumn("pic")=s
r.Column("name")=f.Name
app.db.InsertRecord("pictures",r)
needupdate=true
if app.db.Error then
MsgBox app.db.ErrorMessage
Return
end if
end if
end if
loop until not obj.NextItem
if needupdate then
Update
end if
End EventHandler
EventHandler Sub Open()
me.AcceptFileDrop "any"
End EventHandler
End Control
Control Canvas1 Inherits Canvas
ControlInstance Canvas1 Inherits Canvas
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
EventHandler Sub Open()
Update
End EventHandler
Sub update()
dim r as RecordSet
dim n as integer
n=List.ListIndex
List.DeleteAllRows
r=app.db.SQLSelect("select ROWID, name from pictures")
while not r.eof
List.AddRow r.Field("name").StringValue
List.celltag(List.LastIndex,0)=r.Field("ROWID").StringValue
r.MoveNext
wend
List.ListIndex=n
End Sub
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
FileTypes1
Filetype any
End FileTypes1
End Project
The items on this page are in the following plugins: MBS Images Plugin.