Create Thumbnail Database

Share your advanced PureBasic knowledge/code with the community.
collectordave
Addict
Addict
Posts: 1257
Joined: Fri Aug 28, 2015 6:10 pm
Location: Portugal

Create Thumbnail Database

Post by collectordave »

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

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
Now Show Thumbs

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
Hope it is of use to someone.

Regards

CD
Any intelligent fool can make things bigger and more complex. It takes a touch of genius — and a lot of courage to move in the opposite direction.
User avatar
Tenaja
Addict
Addict
Posts: 1824
Joined: Tue Nov 09, 2010 10:15 pm

Re: Create Thumbnail Database

Post by Tenaja »

Thanks for sharing! I'll check it out next time I'm at my PC.
Post Reply