Create Thumbnail Database
Posted: Mon Sep 21, 2020 8:58 am
Hi to all,
Needed code to produce and store thumbnails in a database found my old code but not complete.
This is a programme that asks for a folder then searches that folder for all files with the .jpg extension.
It creates a thumbnail database in the selected folder.
It then creates thumbnails for all files found and stores then in a database with an Ident and the original filename. The Ident in this case is just a count of the images processed.
You can specify the size of the thumbnail e.g. 150 will create thumbnails 150 X 150.
The aspect ratio of the original image is kept when resizing so the thumbs look correct.
The second programme is just a quick one to check the thumbs have been created OK.
First Create Thumbs
Now Show Thumbs
Hope it is of use to someone.
Regards
CD
Needed code to produce and store thumbnails in a database found my old code but not complete.
This is a programme that asks for a folder then searches that folder for all files with the .jpg extension.
It creates a thumbnail database in the selected folder.
It then creates thumbnails for all files found and stores then in a database with an Ident and the original filename. The Ident in this case is just a count of the images processed.
You can specify the size of the thumbnail e.g. 150 will create thumbnails 150 X 150.
The aspect ratio of the original image is kept when resizing so the thumbs look correct.
The second programme is just a quick one to check the thumbs have been created OK.
First Create Thumbs
Code: Select all
EnableExplicit
UseSQLiteDatabase()
UsePNGImageDecoder()
UseJPEGImageDecoder()
UseGIFImageDecoder()
Global frmThumbs.i,btnChooseFolder, txtStatus, prgStatus, btnDone
Global FolderToUse.s,TotalImages.i,ImageDB.i
;Determines size of thumbnail. Larger size lrger database!
Global ThumbSize.i = 150
Global Count.i
Macro FileExists(filename)
Bool(FileSize(fileName) > -1)
EndMacro
Procedure.i CreateDB()
If CreateFile(0, FolderToUse + "ImageThumbs.db")
CloseFile(0)
ImageDB = OpenDatabase(#PB_Any, FolderToUse + "ImageThumbs.db", "", "")
If ImageDB <> 0
DatabaseUpdate(ImageDB, "CREATE TABLE [Images] (Ident INTEGER,Filename TEXT,[Image] BLOB NULL);")
CloseDatabase(ImageDB)
Else
ProcedureReturn #False
EndIf
Else
ProcedureReturn #False
EndIf
ProcedureReturn #True
EndProcedure
Procedure SearchDirectory(dir$, pattern$, List dList.s(), level.l = 0)
Protected eName$
NewList Dirs.s()
Static FileCount.i
If (level = 0)
ClearList(dList())
EndIf
If Right(dir$, 1) <> "/"
dir$ + "/"
EndIf
If ExamineDirectory(0, dir$, "")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
eName$ = DirectoryEntryName(0)
If (eName$ <> ".") And (eName$ <> "..")
AddElement(Dirs())
Dirs() = eName$ + "/"
EndIf
EndIf
Wend
FinishDirectory(0)
If ExamineDirectory(0, dir$, pattern$)
While NextDirectoryEntry(0)
eName$ = DirectoryEntryName(0)
If (eName$ <> ".") And (eName$ <> "..")
If FindString(eName$,".DS_") = 0
AddElement(dList())
FileCount = FileCount + 1
dList() = dir$ + eName$
If DirectoryEntryType(0) = #PB_DirectoryEntry_Directory
dList() + "/"
EndIf
EndIf
EndIf
Wend
FinishDirectory(0)
EndIf
EndIf
If ListSize(Dirs())
ForEach Dirs()
SearchDirectory(dir$ + Dirs(), pattern$, dList(), level + 1)
Next
EndIf
If (level = 0)
ForEach dList()
dList() = Mid(dList(), Len(dir$) + 1, Len(dList()))
Next
EndIf
EndProcedure
Procedure LoadImageFromFile(ImageFileName.s)
Define ImageNo.i,adjustedwidth.i,adjustedheight.i
Define Ratio1.d,Ratio2.d,Aspect.d
Define *ImgBuffer,Length.i
Define Criteria.s
ImageNo = LoadImage(#PB_Any,ImageFilename)
If ImageNo = 0
;Change to error log for display"
Debug "Failed to create thumbnail for " + ImageFilename
ProcedureReturn
EndIf
;Keep Aspect Ratio
Ratio1 = ThumbSize/ImageWidth(ImageNo)
Ratio2 = ThumbSize/ImageHeight(ImageNo)
If Ratio1 < Ratio2
Aspect = Ratio1
Else
Aspect = Ratio2
EndIf
adjustedwidth = ImageWidth(ImageNo) * Aspect
adjustedheight = ImageHeight(ImageNo) * Aspect
ResizeImage(ImageNo,adjustedwidth,adjustedheight)
*ImgBuffer = EncodeImage(ImageNo)
length = MemorySize(*ImgBuffer)
If *ImgBuffer
length = MemorySize(*ImgBuffer)
If IsDatabase(ImageDB)
SetDatabaseBlob(ImageDB, 0, *ImgBuffer, length)
Criteria = "INSERT INTO Images (Image,Ident,FileName) values (?," + Str(Count) + ",'" + ImageFilename + "');"
DatabaseUpdate(ImageDB, Criteria)
Debug DatabaseError()
EndIf
FreeMemory(*ImgBuffer)
EndIf
FreeImage(ImageNo)
EndProcedure
Procedure StartCreation()
NewList FilesAndFolders.s()
SearchDirectory(FolderToUse, "*.jpg", FilesAndFolders())
TotalImages = ListSize(FilesAndFolders())
SetGadgetAttribute(prgStatus,#PB_ProgressBar_Maximum,TotalImages)
SetGadgetState(prgStatus,0)
Count = 0
ForEach FilesAndFolders()
Count = Count + 1
LoadImageFromFile(FolderToUse + FilesAndFolders())
SetGadgetText(txtStatus,"Created " + Str(Count) + " Thumbs of " + Str(TotalImages))
SetGadgetState(prgStatus,Count)
While WindowEvent():Wend
Next
SetGadgetText(txtStatus,"Thumbs Database Created")
SetGadgetState(prgStatus,0)
While WindowEvent():Wend
EndProcedure
Define Event.i
frmThumbs = OpenWindow(#PB_Any, 0, 0, 410, 140, "Create Thumbnail DB", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
btnChooseFolder = ButtonGadget(#PB_Any, 10, 10, 150, 30, "Choose Folder")
txtStatus = TextGadget(#PB_Any, 10, 60, 380, 20, "Idle")
prgStatus = ProgressBarGadget(#PB_Any, 10, 80, 390, 20, 0, 0)
btnDone = ButtonGadget(#PB_Any, 330, 100, 70, 30, "Done")
Repeat
Event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case btnChooseFolder
FolderToUse = PathRequester("Select Folder","")
If FolderToUse > ""
;Delete Existing DB?
If FileExists(FolderToUse + "ImageThumbs.db")
DeleteFile(FolderToUse + "ImageThumbs.db")
EndIf
If Not CreateDB()
MessageRequester("ThumbsDB","Cannot Create Database Aborting!",#PB_MessageRequester_Ok |#PB_MessageRequester_Error)
Else
ImageDB = OpenDatabase(#PB_Any, FolderToUse + "ImageThumbs.db", "", "")
;Create the thumbs
StartCreation()
EndIf
EndIf
Case btnDone
End
EndSelect
EndSelect
ForEver
Code: Select all
UseSQLiteDatabase()
Global frmShowThumbs
Global cmbIdent, txtChooseThumb, Image_0, txtFileName, btnDone
Global FolderToUse.s,ImageDB.i
Macro FileExists(filename)
Bool(FileSize(fileName) > -1)
EndMacro
Procedure LoadIdents()
Define Criteria.s
ClearGadgetItems(cmbIdent)
Criteria = "Select Ident From Images"
DatabaseQuery(ImageDB,Criteria)
While NextDatabaseRow(ImageDB)
AddGadgetItem(cmbIdent,-1,GetDatabaseString(ImageDB,DatabaseColumnIndex(ImageDB,"Ident")))
Wend
EndProcedure
Procedure ShowThumb(Ident.s)
Define Criteria.s
Criteria = "SELECT * From Images Where Ident = " + Ident
DatabaseQuery(ImageDB,Criteria)
FirstDatabaseRow(ImageDB)
pictureSize = DatabaseColumnSize(ImageDB, DatabaseColumnIndex(ImageDB,"Image"))
SetGadgetText(txtFileName,GetFilePart(GetDatabaseString(ImageDB, DatabaseColumnIndex(ImageDB,"Filename"))))
*picture = AllocateMemory(pictureSize)
GetDatabaseBlob(ImageDB, DatabaseColumnIndex(ImageDB,"Image"), *picture, pictureSize)
CatchImage(1, *picture, pictureSize)
SetGadgetState(Image_0, ImageID(1))
FinishDatabaseQuery(ImageDB)
FreeMemory(*picture)
EndProcedure
frmShowThumbs = OpenWindow(#PB_Any, 0, 0, 330, 300, "Show Thumbs", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
cmbIdent = ComboBoxGadget(#PB_Any, 10, 40, 150, 25)
txtChooseThumb = TextGadget(#PB_Any, 10, 10, 150, 20, "Choose Thumbnail")
Image_0 = ImageGadget(#PB_Any, 10, 70, 150, 150, 0, #PB_Image_Border)
txtFileName = TextGadget(#PB_Any, 10, 230, 310, 20, "File Name")
btnDone = ButtonGadget(#PB_Any, 220, 260, 90, 25, "Done")
FolderToUse = PathRequester("Select Folder","")
If FolderToUse > ""
If FileExists(FolderToUse + "ImageThumbs.db")
ImageDB = OpenDatabase(#PB_Any, FolderToUse + "ImageThumbs.db", "", "")
EndIf
If Not IsDatabase(ImageDB)
End
EndIf
LoadIdents()
Else
End
EndIf
Repeat
Event = WaitWindowEvent()
Select event
Case #PB_Event_CloseWindow
End
Case #PB_Event_Gadget
Select EventGadget()
Case cmbIdent
ShowThumb(GetGadgetText(cmbIdent))
Case btnDone
End
EndSelect
EndSelect
ForEver
Regards
CD