Platforms to show: All Mac Windows Linux Cross-Platform

/Images/JPEG/Picture Database


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.


The biggest plugin in space...