PureBasic Forum
http://forums.purebasic.com/english/

Create Thumbnail Database
http://forums.purebasic.com/english/viewtopic.php?f=12&t=75975
Page 1 of 1

Author:  collectordave [ Mon Sep 21, 2020 8:58 am ]
Post subject:  Create Thumbnail Database

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:
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:
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

Author:  Tenaja [ Mon Sep 21, 2020 4:01 pm ]
Post subject:  Re: Create Thumbnail Database

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

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/