Get the Shell Thumbnail for files

Share your advanced PureBasic knowledge/code with the community.
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: Get the Shell Thumbnail for files

Post by c4s »

@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: Select all

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!
User avatar
TomS
Enthusiast
Enthusiast
Posts: 342
Joined: Sun Mar 18, 2007 2:26 pm
Location: Munich, Germany

Re: Get the Shell Thumbnail for files

Post by TomS »

@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
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: Get the Shell Thumbnail for files

Post by c4s »

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!
User avatar
TomS
Enthusiast
Enthusiast
Posts: 342
Joined: Sun Mar 18, 2007 2:26 pm
Location: Munich, Germany

Re: Get the Shell Thumbnail for files

Post by TomS »

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?
c4s
Addict
Addict
Posts: 1981
Joined: Thu Nov 01, 2007 5:37 pm
Location: Germany

Re: Get the Shell Thumbnail for files

Post by c4s »

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!
Ziltch
User
User
Posts: 52
Joined: Sun Aug 03, 2003 12:05 am
Location: Australia

Re: Get the Shell Thumbnail for files

Post by Ziltch »

Updated this old code to work and fixed the flipped thumbnail problem.

Code: Select all

    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

BarryG
Addict
Addict
Posts: 3268
Joined: Thu Apr 18, 2019 8:17 am

Re: Get the Shell Thumbnail for files

Post by BarryG »

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.
User avatar
Paul
PureBasic Expert
PureBasic Expert
Posts: 1243
Joined: Fri Apr 25, 2003 4:34 pm
Location: Canada
Contact:

Re: Get the Shell Thumbnail for files

Post by Paul »

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
BarryG
Addict
Addict
Posts: 3268
Joined: Thu Apr 18, 2019 8:17 am

Re: Get the Shell Thumbnail for files

Post by BarryG »

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!
novablue
Enthusiast
Enthusiast
Posts: 165
Joined: Sun Nov 27, 2016 6:38 am

Re: Get the Shell Thumbnail for files

Post by novablue »

On Some computers/file types the image is upside down, does somebody know a better solution to this?
BarryG
Addict
Addict
Posts: 3268
Joined: Thu Apr 18, 2019 8:17 am

Re: Get the Shell Thumbnail for files

Post by BarryG »

novablue wrote: Wed Sep 29, 2021 12:26 amOn Some computers/file types the image is upside down, does somebody know a better solution to this?
Ziltch's post just above fixes that.
novablue
Enthusiast
Enthusiast
Posts: 165
Joined: Sun Nov 27, 2016 6:38 am

Re: Get the Shell Thumbnail for files

Post by novablue »

BarryG wrote: Wed Sep 29, 2021 2:14 am
novablue wrote: Wed Sep 29, 2021 12:26 amOn Some computers/file types the image is upside down, does somebody know a better solution to this?
Ziltch's post just above fixes that.
That is the code i used. On one computer the video files will show in the correct rotation and on my other system its showing them upside down, there must be a flag of some kind that can read out the correct direction?
Mesa
Enthusiast
Enthusiast
Posts: 342
Joined: Fri Feb 24, 2012 10:19 am

Re: Get the Shell Thumbnail for files

Post by Mesa »

Rashad made this somewhere in this forum:

Code: Select all

UseTGAImageDecoder() 

#PBM_SETBARCOLOR = 1033 
#PBM_SETBKCOLOR  = 8193 

#TBS_TOOLTIPS = $100 

Global Image ,ext$ ,hwndPB,oldpos 
Global iSize,ILwnd 

iSize = 192 

Import "" 
	PB_Gadget_SendGadgetCommand(hWnd, EventType) 
EndImport 

Structure PPMColor 
	r.a 
	g.a 
	b.a 
EndStructure 

Structure PGMColor 
	c.a 
EndStructure 

Structure File 
	FileName$ 
	Image.l 
EndStructure 

Macro _imgscale 
	hScale.f = iSize/bm\bmWidth 
	vScale.f = iSize/bm\bmHeight 
	If hScale > vScale 
		Scale.f = vScale*0.9 
	Else 
		Scale.f = hScale*0.9 
	EndIf 
	If Scale > 2 
		Scale = 2 
	EndIf 
	x = (iSize-Scale*bm\bmWidth)/2 
	y = (iSize-Scale*bm\bmHeight)/2 
EndMacro 

Procedure iItem(Gad,itText$,index) 
	it.LVITEM 
	it\Mask     = #LVIF_TEXT| #LVIF_IMAGE 
	it\iItem    = 0 
	it\iSubItem = 0 
	it\iImage = index 
	it\pszText  = @itText$ 
	SendMessage_(GadgetID(Gad), #LVM_INSERTITEM, 0, @it) 
EndProcedure 

Procedure LoadPPGM(Image,filename$) 
	Result = ReadFile(#PB_Any, filename$,#PB_Ascii) 
	If Result 
		If CreateImage(Image, 1, 1) 
			Format$ = ReadString(Result) 
			Dimensions$ = ReadString(Result) 
			If Val(StringField(Dimensions$, 1, " ")) = 0 
				Dimensions$ = ReadString(Result) 
			EndIf 
			w  = Val(StringField(Dimensions$, 1, " ")) 
			h  = Val(StringField(Dimensions$, 2, " ")) 
			If w = 0 Or h = 0 
				ProcedureReturn 1 
			EndIf 
			ResizeImage(Image, w, h) 
			StartDrawing(ImageOutput(Image)) 
			max = Val(ReadString(Result)) 
			Select Format$ 
				Case "P2" 
					Stringlen = Lof(Result) - Loc(Result) 
					content$  = Space(Stringlen*SizeOf(Character)+1) 
					Dim color.s(0) 
					ReadData(Result, @content$, Stringlen) 
					content$ = PeekS(@content$,-1,#PB_Ascii) 
					CreateRegularExpression(1, "\d+") 
					ExtractRegularExpression(1, content$, color()) 
					For y = 0 To h - 1 
						For x = 0 To w - 1 
							pos = (y*w + x)*1 
							Plot(x, y,RGB(Val(color(pos)),Val(color(pos)),Val(color(pos)))) 
						Next 
					Next 
					
				Case "P3" 
					Stringlen = Lof(Result) - Loc(Result) 
					content$  = Space(Stringlen*SizeOf(Character)+1) 
					Dim color.s(0) 
					ReadData(Result, @content$, Stringlen) 
					content$ = PeekS(@content$,-1,#PB_Ascii) 
					CreateRegularExpression(1, "\d+") 
					ExtractRegularExpression(1, content$, color()) 
					For y = 0 To h - 1 
						For x = 0 To w - 1 
							pos = (y*w + x)*3 
							r=Val(color(pos))*255 / max 
							g=Val(color(pos+1))*255 / max 
							b=Val(color(pos+2))*255 / max 
							Plot(x, y, RGB(r,g,b)) 
						Next 
					Next 
					
				Case "P5" 
					Bufferlen = Lof(Result) - Loc(Result) 
					*Buffer   = AllocateMemory(Bufferlen) 
					ReadData(Result, *Buffer, Bufferlen) 
					For y = 0 To h - 1 
						For x = 0 To w - 1 
							*gray.PGMColor = pos + *Buffer 
							Plot(x, y,RGB(*gray\c,*gray\c,*gray\c)) 
							pos + 1 
						Next 
					Next 
					
				Case "P6" 
					Bufferlen = Lof(Result) - Loc(Result) 
					*Buffer   = AllocateMemory(Bufferlen) 
					ReadData(Result, *Buffer, Bufferlen) 
					For y = 0 To h - 1 
						For x = 0 To w - 1 
							*color.PPMColor = pos + *Buffer 
							Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max)) 
							pos + 3 
						Next 
					Next 
			EndSelect 
			StopDrawing()      
			CloseFile(Result) 
			ProcedureReturn 1 
		EndIf 
	EndIf 
EndProcedure 

Procedure GetShellThumbnail(FileName$, Image, Width, Height, Depth = 24) 
	Protected Result = 0, ImageResult 
	Protected Desktop.IShellFolder, Folder.IShellFolder 
	Protected Extract.IExtractImage 
	Protected *pidlFolder.ITEMIDLIST, *pidlFile.ITEMIDLIST  
	Protected Priority, Flags, Bitmap = 0, size.SIZE 
	Protected DC, SourceDC, BitmapInfo.BITMAP 
	
	ext$ = GetExtensionPart(FileName$) 
	
	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 
						
						ImageResult = CreateImage(Image, Width, Height, depth,$FFFFFF) 
						If ImageResult 
							If Image = #PB_Any 
								Image = ImageResult 
							EndIf    
							
							size\cx = Width 
							size\cy = Height 
							
							If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @size, Depth, @Flags) >= 0                
								If Extract\Extract(@Bitmap) >= 0 And Bitmap 
									
									DC = StartDrawing(ImageOutput(Image)) 
									If DC 
										SourceDC = CreateCompatibleDC_(DC) 
										If SourceDC 
											GetObject_(Bitmap, SizeOf(BITMAP), @BitmapInfo) 
											SelectObject_(SourceDC, Bitmap) 
											BitBlt_(DC, iSize/2-BitmapInfo\bmWidth/2,iSize/2-BitmapInfo\bmHeight/2, BitmapInfo\bmWidth, BitmapInfo\bmHeight, SourceDC, 0, 0, #SRCCOPY) 
											DeleteDC_(SourceDC) 
										EndIf 
										;DrawingMode(#PB_2DDrawing_Transparent) 
										; ;DrawText(10,10,GetExtensionPart(File()\FileName$),#Green) 
										StopDrawing()                    
										Result = ImageResult 
									EndIf 
									
									DeleteObject_(Bitmap) 
								EndIf 
							EndIf                
							Extract\Release() 
						EndIf 
						
						If Result = 0 
							FreeImage(Image) 
						EndIf            
					EndIf 
					
					CoTaskMemFree_(*pidlFile) 
				EndIf                        
				Folder\Release() 
			EndIf      
			CoTaskMemFree_(*pidlFolder)      
		EndIf    
		Desktop\Release() 
	EndIf 
	
	ProcedureReturn Result  
EndProcedure 

Procedure Resizewindow_EX() 
	ResizeGadget(5,#PB_Ignore,#PB_Ignore,WindowWidth(0)-40,WindowHeight(0)-55) 
	ResizeGadget(2,#PB_Ignore,#PB_Ignore,WindowWidth(0) - 52,WindowHeight(0)-68) 
	MoveWindow_(hwndPB,WindowWidth(0)-24,10,18,WindowHeight(0)-55,1) 
	ResizeGadget(10,10,WindowHeight(0) - 34,160,20) 
	ResizeGadget(15,180,WindowHeight(0) - 34,40,20) 
	ResizeGadget(20,230,WindowHeight(0) - 34,GadgetWidth(5)-220,20) 
EndProcedure 

NewList File.File() 

LoadFont(0,"Consolas",14) 

Flag = #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget 
If OpenWindow(0,0,0,820,600,"Thumbnails Viewer",Flag) 
	SmartWindowRefresh(0,1) 
	WindowBounds(0,600,400,#PB_Default,#PB_Default) 
	
	ContainerGadget(5,10,10,780,545,#PB_Container_Flat) 
	SetGadgetColor(5,#PB_Gadget_BackColor,0) 
	ListIconGadget(0,0,0,0,0,"",0,#PB_ListIcon_MultiSelect|#LVS_AUTOARRANGE |#WS_DLGFRAME ) 
	SetWindowLongPtr_(GadgetID(0),#GWL_STYLE,GetWindowLongPtr_(GadgetID(0),#GWL_STYLE)|#WS_CLIPCHILDREN) 
	SetGadgetAttribute(0,#PB_ListIcon_DisplayMode,#PB_ListIcon_LargeIcon) 
	SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE,0,SendMessage_(GadgetID(0),#LVM_GETEXTENDEDLISTVIEWSTYLE,0,0)| #LVS_EX_TRACKSELECT) 
	SendMessage_(GadgetID(0), #LVM_SETHOVERTIME, 0, 10) 
	ExplorerTreeGadget(1, 0,0,0,0, "*",#PB_Explorer_NoFiles|#PB_Explorer_NoDriveRequester) 
	SetGadgetFont(1,FontID(0)) 
	SetGadgetColor(1,#PB_Gadget_BackColor,$DBDBDB) 
	SplitterGadget(2, 5, 5, 768, 532, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator) 
	SetGadgetState(2,250) 
	CloseGadgetList() 
	hwndPB = CreateWindowEx_(0, "msctls_progress32", 0, #WS_CHILD|#WS_VISIBLE|#PBS_VERTICAL , WindowWidth(0)-24,10,18,545, WindowID(0), 0, 0, 0) 
	SetWindowTheme_(hwndPB, "", "") 
	SendMessage_(hwndPB, #PBM_SETBKCOLOR ,0,$DBDBDB) 
	SendMessage_(hwndPB, #PBM_SETBARCOLOR ,0,$FDAE4D) 
	
	TrackBarGadget(10,10,568,160,24,1,12,#TBS_AUTOTICKS | #TBS_ENABLESELRANGE|#TBS_TOOLTIPS |#TBS_FIXEDLENGTH) 
	SendMessage_(GadgetID(10), #TBM_SETTHUMBLENGTH,16,0) 
	SendMessage_(GadgetID(10), #TBM_SETPAGESIZE ,0,1) 
	
	SetGadgetState(10,12) 
	
	TextGadget(15,180,568,40,20,"192",#WS_BORDER | #SS_CENTER|#SS_CENTERIMAGE) 
	SetGadgetColor(15,#PB_Gadget_BackColor,$FFFFFF) 
	
	TextGadget(20,230,568,582,20,"",#WS_BORDER | #SS_CENTER | #SS_CENTERIMAGE) 
	SetGadgetFont(20,FontID(0)) 
	SetGadgetColor(20,#PB_Gadget_BackColor,$FFFFFF) 
	SetGadgetColor(20,#PB_Gadget_FrontColor,$0000FF) 
	
	BindEvent(#PB_Event_SizeWindow,@Resizewindow_EX()) 
	Repeat 
		Select WaitWindowEvent() 
			Case #PB_Event_CloseWindow 
				Quit = 1 
				
			Case #WM_MOUSEMOVE 
				If GetActiveGadget() = 10 
					If GetGadgetState(10) >= 4 
						iSize = GetGadgetState(10)*16 
						SetGadgetText(15,Str(iSize)) 
					Else 
						SetGadgetText(15,Str(GetGadgetState(10))) 
					EndIf 
				EndIf 
				
			Case #WM_LBUTTONUP 
				If GetActiveGadget() = 10 
					Select GetGadgetState(10) 
						Case 1 
							SetGadgetAttribute(0,#PB_ListIcon_DisplayMode,#PB_ListIcon_List) 
						Case 2 
							SetGadgetAttribute(0,#PB_ListIcon_DisplayMode,#PB_ListIcon_SmallIcon) 
						Case 3 
							iSize = 16 
							SetGadgetText(15,Str(iSize)) 
							SetGadgetAttribute(0,#PB_ListIcon_DisplayMode,#PB_ListIcon_LargeIcon) 
						Case 4 To 12          
							iSize = GetGadgetState(10)*16 
							SetGadgetText(15,Str(iSize)) 
							SetGadgetAttribute(0,#PB_ListIcon_DisplayMode,#PB_ListIcon_LargeIcon) 
					EndSelect 
					PB_Gadget_SendGadgetCommand(GadgetID(1), #PB_EventType_LeftClick) 
				EndIf 
				
			Case #PB_Event_Gadget 
				Select EventGadget() 
					Case 0 
						Select EventType() 
							Case #PB_EventType_Change 
								result = SelectElement(File(),ListSize(File()) - GetGadgetState(0) - 1) 
								If result > 0 
									SetGadgetText(20 , File()\FileName$) 
								EndIf
							Case #PB_EventType_LeftClick
								; 								  Debug "ok";File()\FileName$
								RunProgram(File()\FileName$)
						EndSelect 
						
						
					Case 1 
						Select EventType() 
							Case #PB_EventType_LeftClick                
								If ILwnd 
									ImageList_Destroy_(ILwnd) 
								EndIf 
								ClearList(File()) 
								ClearGadgetItems(0) 
								SetGadgetText(20 , "" ) 
								SendMessage_(hwndPB, #PBM_SETPOS, 0,0) 
								img = CreateImage(#PB_Any,iSize,iSize,32,$FFFFFF) 
								ILwnd = ImageList_Create_(iSize,iSize,#ILC_COLOR32|#ILC_MASK, 0, 300) 
								SendMessage_(GadgetID(0),#LVM_SETIMAGELIST,#LVSIL_NORMAL,ILwnd) 
								Count = 0 
								If GetGadgetText(1) <> "" And ExamineDirectory(0, GetGadgetText(1), "*.*") 
									While NextDirectoryEntry(0) 
										If DirectoryEntryType(0) = #PB_DirectoryEntry_File 
											AddElement(File()) 
											File()\FileName$ = GetGadgetText(1) + DirectoryEntryName(0) 
											Count + 1 
										EndIf 
									Wend 
								EndIf 
								If Count > 0 
									SendMessage_(hwndPB, #PBM_SETPOS, 100, 0) 
									While WindowEvent(): Wend 
									
									ForEach File() 
										index = ListIndex(File()) 
										File()\Image = GetShellThumbnail(File()\FileName$, #PB_Any, iSize, iSize) 
										If File()\Image = 0 
											File()\Image = CreateImage(#PB_Any, iSize, iSize) 
											If File()\Image And StartDrawing(ImageOutput(File()\Image)) 
												Box(0, 0, iSize, iSize, $FFFFFF) 
												If SHGetFileInfo_(@File()\FileName$, 0, @info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON|#SHGFI_LARGEICON) 
													DrawImage(info\hIcon, iSize/2-16, iSize/2-16) 
													DestroyIcon_(info\hIcon) 
												EndIf                
												StopDrawing() 
											EndIf 
											If ext$ = "ppm" Or ext$ = "pgm" 
												If LoadPPGM(Image, File()\FileName$) 
													img = ImageID(image)                        
													GetObject_(img, SizeOf(BITMAP), @bm.BITMAP) 
													_imgscale 
													imgh = CopyImage_(img,#IMAGE_BITMAP,bm\bmWidth*Scale,bm\bmHeight*Scale,#LR_COLOR) 
													File()\Image = CreateImage(#PB_Any, iSize, iSize) 
													If File()\Image And StartDrawing(ImageOutput(File()\Image)) 
														Box(0,0,iSize,iSize,$FFFFFF) 
														DrawImage(imgh,x,y)                    
													EndIf                        
													StopDrawing() 
													FreeImage(Image) 
													DeleteObject_(img) 
												EndIf 
											EndIf 
											If ext$ = "tga" 
												If LoadImage(Image, File()\FileName$) 
													img = ImageID(image) 
													GetObject_(img, SizeOf(BITMAP), @bm.BITMAP) 
													_imgscale 
													imgh = CopyImage_(img,#IMAGE_BITMAP,bm\bmWidth*Scale,bm\bmHeight*Scale,#LR_COLOR) 
													File()\Image = CreateImage(#PB_Any, iSize, iSize) 
													If File()\Image And StartDrawing(ImageOutput(File()\Image)) 
														Box(0,0,iSize,iSize,$FFFFFF) 
														DrawImage(imgh,x,y)                    
													EndIf 
													StopDrawing() 
													FreeImage(Image) 
													DeleteObject_(img) 
												EndIf 
											EndIf 
										EndIf            
										
										item = ImageList_Add_(ILwnd,ImageID(File()\Image),0) 
										iItem(0, GetFilePart(File()\FileName$) ,item) 
										
										SendMessage_(hwndPB, #PBM_SETPOS, (index * 100)/Count,0) 
										While WindowEvent(): Wend 
									Next File() 
									SendMessage_(hwndPB, #PBM_SETPOS, 100,0) 
								EndIf 
						EndSelect            
				EndSelect              
		EndSelect    
	Until Quit = 1 
EndIf 
End 

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 
M.
Post Reply