It is currently Mon Oct 26, 2020 3:59 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 2 posts ] 
Author Message
 Post subject: Create Thumbnail Database
PostPosted: Mon Sep 21, 2020 8:58 am 
Offline
Addict
Addict

Joined: Fri Aug 28, 2015 6:10 pm
Posts: 1123
Location: Portugal
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

_________________
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Create Thumbnail Database
PostPosted: Mon Sep 21, 2020 4:01 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Nov 09, 2010 10:15 pm
Posts: 1681
Thanks for sharing! I'll check it out next time I'm at my PC.


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 2 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 35 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye