It is currently Mon Oct 26, 2020 3:04 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 24 posts ]  Go to page Previous  1, 2
Author Message
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Dec 01, 2010 12:43 pm 
Offline
Addict
Addict

Joined: Thu Nov 01, 2007 5:37 pm
Posts: 1981
Location: Germany
@c4s
I changed the source a little. The returned image should now have the real width and height of the thumbnail, so that the procedure parameters just define the maximum area. I also added your idea about maintaining the alpha channel:
Code:
Procedure GetShellThumbnail(Filename.s, ImageNr, Width, Height, Depth=32)
   Protected Desktop.IShellFolder, Folder.IShellFolder
   Protected *pidlFolder.ITEMIDLIST, *pidlFile.ITEMIDLIST
   Protected Extract.IExtractImage
   Protected ImageTempNr, Priority, Flags, Bitmap, size.SIZE, bm.BITMAP
   Protected Result = #False

   size\cx = Width
   size\cy = Height

   Flags | $4 ;#IEIFLAG_ASPECT
   Flags | $40 ;#IEIFLAG_ORIGSIZE
   ;Flags | $20 ;#IEIFLAG_SCREEN
   ;Flags | $200 ;#IEIFLAG_QUALITY


   CoInitialize_(0)
      If SHGetDesktopFolder_(@Desktop) >= 0
         If Desktop\ParseDisplayName(#Null, #Null, GetPathPart(Filename), #Null, @*pidlFolder, #Null) = #S_OK
            If Desktop\BindToObject(*pidlFolder, #Null, ?IID_IShellFolder, @Folder) = #S_OK
               If Folder\ParseDisplayName(#Null, #Null, GetFilePart(Filename) , #Null, @*pidlFile, #Null) = #S_OK
                  If Folder\GetUIObjectOf(#Null, 1, @*pidlFile, ?IID_IExtractImage, 0, @Extract) = #S_OK
                     If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @size, Depth, @Flags) >= 0
                        If Extract\Extract(@Bitmap) >= 0 And Bitmap
                           GetObject_(Bitmap, SizeOf(BITMAP), @bm)

                           ImageTempNr = CreateImage(ImageNr, bm\bmWidth, bm\bmHeight, Depth | #PB_Image_Transparent)
                           If ImageTempNr
                              If ImageNr = #PB_Any : ImageNr = ImageTempNr : EndIf

                              If StartDrawing(ImageOutput(ImageNr))
                                 DrawAlphaImage(Bitmap, 0, 0)
                                 StopDrawing()
                                 Result = ImageNr
                              EndIf

                              If Result = #False : FreeImage(ImageNr) : EndIf
                           EndIf

                           DeleteObject_(Bitmap)
                        EndIf
                        Extract\Release()
                     EndIf
                  EndIf
                  CoTaskMemFree_(*pidlFile)
               EndIf
               Folder\Release()
            EndIf
            CoTaskMemFree_(*pidlFolder)
         EndIf
         Desktop\Release()
      EndIf
   CoUninitialize_()

   ProcedureReturn Result


   DataSection
      IID_IShellFolder:  ; {000214E6-0000-0000-C000-000000000046}
      Data.l $000214E6
      Data.w $0000, $0000
      Data.b $C0, $00, $00, $00, $00, $00, $00, $46

      IID_IExtractImage:  ; {BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}
      Data.l $BB2E617C
      Data.w $0920, $11D1
      Data.b $9A, $0B, $00, $C0, $4F, $C2, $D6, $C1
   EndDataSection
EndProcedure

Can someone please confirm that it works as aspected.


@TomS
Does it work when you use some of the flags?

_________________
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Dec 01, 2010 1:35 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Mar 18, 2007 2:26 pm
Posts: 342
Location: Munich, Germany
@c4s: I haven't tested Alphaimages. But thumbnails are now stretched to the size of the 'frame' regardless of their own aspect ratio.
Maybe that's the intention, but to me it looks wrong.
Images are still flipped.


C4s:Image Freak's original:Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Dec 01, 2010 3:33 pm 
Offline
Addict
Addict

Joined: Thu Nov 01, 2007 5:37 pm
Posts: 1981
Location: Germany
Maybe it's just something on your system but here (Windows XP) the thumbnails are displayed correctly and not stretched at all, it has the real aspect ratio. However disabling all flags should return the same image freak's code does.

Did you try to combine some of the flags (infos here: msdn) defined in the procedure? Do you get other results with them?

_________________
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Dec 01, 2010 3:36 pm 
Offline
Enthusiast
Enthusiast
User avatar

Joined: Sun Mar 18, 2007 2:26 pm
Posts: 342
Location: Munich, Germany
I haven't tried it yet.
What about the flipping in your XP? Everything normal?
So how does your example look different from freak's if'S nothing is stretched?


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Dec 01, 2010 6:54 pm 
Offline
Addict
Addict

Joined: Thu Nov 01, 2007 5:37 pm
Posts: 1981
Location: Germany
TomS wrote:
So how does your example look different from freak's if'S nothing is stretched?

I colored the container gadget to emphasize the differences:
Original by freak:
Image

My changes, and how I want it to look like:
Image

First of all the alpha channel is maintained but more important for my purpose is that the result is the exact thumbnail. I don't want the rest of the image to be filled with something to fit the input dimension (in this example 100x80)...

_________________
If any of you native English speakers have any suggestions for the above text, please let me know (via PM). Thanks!


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Fri Dec 29, 2017 1:20 am 
Offline
User
User

Joined: Sun Aug 03, 2003 12:05 am
Posts: 39
Location: Australia
Updated this old code to work and fixed the flipped thumbnail problem.

Code:
    Procedure GetShellThumbnail(Filename.s, ImageNr, Width, Height, Depth=32)
       Protected Desktop.IShellFolder, Folder.IShellFolder
       Protected *pidlFolder.ITEMIDLIST, *pidlFile.ITEMIDLIST
       Protected Extract.IExtractImage
       Protected ImageTempNr, Priority, Flags, Bitmap, size.SIZE, bm.BITMAP
       Protected iws,BuffPos,ix,iy
       Protected Result = #False

       size\cx = Width
       size\cy = Height

       Flags | $4 ;#IEIFLAG_ASPECT
       Flags | $40 ;#IEIFLAG_ORIGSIZE
       ;Flags | $20 ;#IEIFLAG_SCREEN
       ;Flags | $200 ;#IEIFLAG_QUALITY


       CoInitialize_(0)
          If SHGetDesktopFolder_(@Desktop) >= 0
             If Desktop\ParseDisplayName(#Null, #Null, GetPathPart(Filename), #Null, @*pidlFolder, #Null) = #S_OK
                If Desktop\BindToObject(*pidlFolder, #Null, ?IID_IShellFolder, @Folder) = #S_OK
                   If Folder\ParseDisplayName(#Null, #Null, GetFilePart(Filename) , #Null, @*pidlFile, #Null) = #S_OK
                      If Folder\GetUIObjectOf(#Null, 1, @*pidlFile, ?IID_IExtractImage, 0, @Extract) = #S_OK
                         If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @size, Depth, @Flags) >= 0
                            If Extract\Extract(@Bitmap) >= 0 And Bitmap
                               GetObject_(Bitmap, SizeOf(BITMAP), @bm)
                               
                              ImageTempNr = CreateImage(ImageNr, bm\bmWidth, bm\bmHeight, bm\bmBitsPixel, #PB_Image_Transparent)
                              If ImageTempNr
                                If ImageNr = #PB_Any : ImageNr = ImageTempNr : EndIf

                                If StartDrawing(ImageOutput(ImageNr))
                                 
                                  ;DrawAlphaImage(Bitmap, 0, 0)  < This draws image upside down
                                 
                                  iws=DrawingBufferPitch()
                                  BuffPos=DrawingBuffer()+(iws * bm\bmHeight)-iws                                 
                                  For iy = 0 To bm\bmHeight-1
                                    CopyMemory( Bm\bmBits+(iy * bm\bmWidthBytes), BuffPos-(iy*iws),iws)
                                  Next                                 
                                  StopDrawing()
                                  Result = ImageNr
                                EndIf

                                If Result = #False : FreeImage(ImageNr) : EndIf
                              EndIf

                              DeleteObject_(Bitmap)
                            EndIf
                            Extract\Release()
                         EndIf
                      EndIf
                      CoTaskMemFree_(*pidlFile)
                   EndIf
                   Folder\Release()
                EndIf
                CoTaskMemFree_(*pidlFolder)
             EndIf
             Desktop\Release()
          EndIf
       CoUninitialize_()

       ProcedureReturn Result


       DataSection
          IID_IShellFolder:  ; {000214E6-0000-0000-C000-000000000046}
          Data.l $000214E6
          Data.w $0000, $0000
          Data.b $C0, $00, $00, $00, $00, $00, $00, $46

          IID_IExtractImage:  ; {BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}
          Data.l $BB2E617C
          Data.w $0920, $11D1
          Data.b $9A, $0B, $00, $C0, $4F, $C2, $D6, $C1
       EndDataSection
     EndProcedure
     
         #ExplorerGadget = 0
    #ScrollGadget   = 1
    #ProgressGadget = 2

    Structure File
      FileName$
      Text$
      Image.l
      Gadget.l ; Its a ContainerGadget, so the others inside are freed as well
    EndStructure

    NewList File.File()

    If OpenWindow(0, 0, 0, 800, 600, "Shell Thumbnails", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
      ;CreateGadgetList(WindowID(0))
      ExplorerTreeGadget(#ExplorerGadget, 5, 5, 240, 590, "C:\", #PB_Explorer_NoFiles)
      ScrollAreaGadget(#ScrollGadget, 250, 5, 545, 570, 520, 10, 10)
      CloseGadgetList()
      ProgressBarGadget(#ProgressGadget, 250, 580, 545, 15, 0, 100)

      Repeat
        Event = WaitWindowEvent()
       
        If Event = #PB_Event_Gadget And EventGadget() = #ExplorerGadget And EventType() = #PB_EventType_Change     
       
          ; Clear the old content of the display
          ;
          ForEach File()
            FreeGadget(File()\Gadget)
            FreeImage(File()\Image)
          Next File()
          ClearList(File())
         
          ; Creating the thumbnail may take a little time for certain file types
          ; (for example big PowerPoint presentations), especially when there are lots
          ; of files in a folder. So the text information is read first (which is quite fast)
          ; and the images are created later with a progressbar to indicate the progress
          ;     
          Count = 0
          If ExamineDirectory(0, GetGadgetText(#ExplorerGadget), "*.*")
            While NextDirectoryEntry(0)
              If DirectoryEntryType(0) = #PB_DirectoryEntry_File
                AddElement(File())
                File()\FileName$ = GetGadgetText(#ExplorerGadget) + DirectoryEntryName(0)
                File()\Text$ = "Name: " + File()\FileName$ + Chr(13)
                File()\Text$ + "Size: " + Str(DirectoryEntrySize(0)) + " Bytes" + Chr(13)
                File()\Text$ + FormatDate("Created: %mm/%dd/%yyyy", DirectoryEntryDate(0, #PB_Date_Created)) + Chr(13)
                File()\Text$ + FormatDate("Modified: %mm/%dd/%yyyy", DirectoryEntryDate(0, #PB_Date_Modified)) + Chr(13)
                File()\Text$ + FormatDate("Accessed: %mm/%dd/%yyyy", DirectoryEntryDate(0, #PB_Date_Accessed))           
                Count + 1
              EndIf
            Wend
          EndIf
         
          If Count > 0
                 
            OpenGadgetList(#ScrollGadget)
            SetGadgetState(#ProgressGadget, 0)
            While WindowEvent(): Wend ; Refresh the display so it looks better
           
            ForEach File()
              index = ListIndex(File())
             
              ; Create the thumbnail
              File()\Image = GetShellThumbnail(File()\FileName$, #PB_Any, 100, 80)           
             
              ; If no image could be created, we try to read the Icon for the file type and
              ; show that
              ;
              If File()\Image = 0
                File()\Image = CreateImage(#PB_Any, 100, 80)
                If File()\Image And StartDrawing(ImageOutput(File()\Image))               
                  Box(0, 0, 100, 80, $FFFFFF)
                  If SHGetFileInfo_(@File()\FileName$, 0, @info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON|#SHGFI_LARGEICON)
                    DrawImage(info\hIcon, 34, 24)
                    DestroyIcon_(info\hIcon)
                  EndIf               
                  StopDrawing()
                EndIf                           
              EndIf
             
              File()\Gadget = ContainerGadget(#PB_Any, 5, 5+index*90, 510, 80, #PB_Container_Flat)
                ImageGadget(#PB_Any, 0, 0, 100, 80, ImageID(File()\Image))         
                TextGadget(#PB_Any, 105, 5, 400, 70, File()\Text$)
              CloseGadgetList()
           
              ; Update the Gadget states and refresh the display
              ;
              SetGadgetState(#ProgressGadget, (index * 100)/Count)
              SetGadgetAttribute(#ScrollGadget, #PB_ScrollArea_InnerHeight, (index+1)*90 + 10)
              While WindowEvent(): Wend
            Next File()
           
            CloseGadgetList()       
          EndIf   
     
          SetGadgetState(#ProgressGadget, 100)   
          SetGadgetAttribute(#ScrollGadget, #PB_ScrollArea_InnerHeight, Count*90 + 10)     
         
        EndIf
       
      Until Event = #PB_Event_CloseWindow
    EndIf
    End


_________________
Ziltch - http://www.youtube.com/user/OZiltch


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Tue Jun 02, 2020 1:00 pm 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1040
Thanks to Freak and Ziltch for this code; I added it to one of my projects today. Much appreciated!

I've noted, though, that it doesn't get thumbnails for .DOC (Word) or .XLS (Excel) files, which is a shame; but it does for .PPT (PowerPoint). Maybe something needs to be added or fixed to the code to make it work with all Microsoft Office docs? Would Freak or Ziltch maybe like to look at it again, please? Only if you have the time and motivation, of course.


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Tue Jun 02, 2020 2:47 pm 
Offline
PureBasic Expert
PureBasic Expert
User avatar

Joined: Fri Apr 25, 2003 4:34 pm
Posts: 997
Location: Canada
The availability of thumbnails seems to come from what has been installed on your system.

I have Office 365 installed on one computer and for a thumbnail I get the application icon of .PPT files. On another computer without any Office products their is just an empty "paper with folded corner" icon (meaning their is no association)
On another computer I have CorelDraw installed and the thumbnail is the actual content of the CorelDraw .CDR file. On another computer without Corel it's the standard empty "paper with folded corner" icon (meaning their is no association)

The only way to guarantee a proper generated thumbnail is to have additional software installed that will deal with whatever thumbnail you are wanting to support.

_________________
Image Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Get the Shell Thumbnail for files
PostPosted: Wed Jun 03, 2020 12:46 am 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1040
Thanks for checking, Paul. I will be content with the code as-is, then. I have Office 365 installed with its standard default setup because I'm too old now to bother with customising and changing app settings. LOL!


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 24 posts ]  Go to page Previous  1, 2

All times are UTC + 1 hour


Who is online

Users browsing this forum: Majestic-12 [Bot] and 38 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