Thumbnails 4 Images [Windows]

Share your advanced PureBasic knowledge/code with the community.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Thumbnails 4 Images [Windows]

Post by RASHAD »

Hi

Code: Select all

CompilerIf Not #PB_Compiler_Unicode 
  MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
  End
CompilerEndIf

#TVM_SETBKCOLOR = $111D
#FOF_NORECURSION      = $1000

UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

Global *token, *Image,Image
Global HBITMAP,Thread,Path$,Finish,ILwnd
Global iSize,w.f,h.f,bcolor
Global Dim item$(500)

iSize = 128
bcolor = $D8D8D8
Image = 0

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

Structure PGMColor
  c.a
EndStructure

Structure RectF
  x.f
  y.f
  width.f
  height.f
EndStructure
 
Structure GdiplusStartupInput
  GdiPlusVersion.i
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.i
  SuppressExternalCodecs.i
EndStructure

Structure ImageCodecInfo
  clsid.CLSID
  formatID.GUID
  *codecName
  *dllName
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Macro _imgscale
  hScale.f = iSize/w
  vScale.f = iSize/h
  If hScale > vScale
      Scale.f = vScale*0.9
  Else
      Scale.f = hScale*0.9
  EndIf
  x = (iSize-Scale*w)/2
  y = (iSize-Scale*h)/2
EndMacro

Import "Uxtheme.lib"
  SetWindowTheme(Window.l, Body.p-unicode, Title.p-unicode)                                                  
EndImport

Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
  OpenLibrary(0, "gdiplus.dll")
  Protected *token, input.GdiplusStartupInput
  With input
    \GdiPlusVersion = version
    \DebugEventCallback = *hEventCB
    \SuppressExternalCodecs = Codecs
    \SuppressBackgroundThread = bgThread
  EndWith
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

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 PopulateLI(par)
  Finish = 0 :item = 0 : Scale.f = 0
  PostEvent(#PB_Event_SizeWindow)  
  SetGadgetText(12,"WAIT")
  DisableWindow(0,1)
  ClearGadgetItems(0)
  If ILwnd
    ImageList_Destroy_(ILwnd)
  EndIf
  If IsImage(img)
    FreeImage(img)
  EndIf  
  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) 
  Path$ = GetGadgetText(1)
  If ExamineDirectory(0, Path$, "*.*")
    *token = Gdiplus_New() 
    Repeat
      NextEntry     = NextDirectoryEntry(0)                   
      FileName$     = DirectoryEntryName(0)
      File$ = Path$+FileName$
      Ext$ = LCase(GetExtensionPart(FileName$))
      If FileSize(File$)  > 0; And FileSize(Path$ + FileName$) < 100000
        Select Ext$
          Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
            If *token                   
              CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
              CallFunction(0,"GdipGetImageDimension",*image, @w, @h)
              _imgscale  ;Macro Scale
              imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(HBITMAP)
                DeleteObject_(imgH)
              EndIf
            EndIf
           
          Case "cur"
            hCursor = LoadCursorFromFile_(@File$)
            If hCursor
              item = ImageList_AddIcon_(ILwnd,hCursor)
              iItem(0,FileName$ ,item)
              item$(item) = FileName$
              DeleteObject_(hCursor)  
            EndIf
           
          Case "jp2","tga"
            LoadImage(0,File$)
            w = ImageWidth(0)
            h = ImageHeight(0)
            If IsImage(0)
              _imgscale
              imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,Scale*w,Scale*h,#LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(imgH)
              EndIf
            EndIf
            
          Case "ppm","pgm"
            If IsImage(0)
              FreeImage(0)
            EndIf
            LoadPPGM(Image, File$)
            If IsImage(Image)
              _imgscale
              imgH = CopyImage_(ImageID(Image),#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(imgH)
              EndIf
            EndIf 
;          
         EndSelect
       EndIf
    Until NextEntry = 0
  EndIf
  Finish = 1
  SetGadgetText(12,"GO")
  DisableWindow(0,0)
EndProcedure

Procedure Resizewindow_EX()
  ResizeGadget(5,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-50) 
  ResizeGadget(2,#PB_Ignore,#PB_Ignore,WindowWidth(0) - 35,WindowHeight(0)-65)
  ResizeGadget(12,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
  ResizeGadget(15,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
EndProcedure

LoadFont(0,"Consolas",14)
LoadFont(1,"Arial",7)

OpenWindow(0,0,0,800,600,"ListIconGadget & Thumbnails",#PB_Window_SystemMenu| #PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
SetWindowColor(0,$AAAAAB)

If CreatePopupImageMenu(0) 
  MenuItem(1, "Open") 
  MenuItem(2, "Copy")
  MenuItem(3, "Save as..")
  MenuBar()  
  MenuItem(4, "Delete")
  MenuItem(5, "Recycle")
  MenuBar()
  MenuItem(6, "Print")
EndIf

ContainerGadget(5,10,10,780,545,#PB_Container_Flat)
  ListIconGadget(0,0,0,0,0,"",0,#PB_ListIcon_MultiSelect| #LVS_AUTOARRANGE)
  ExplorerTreeGadget(1, 0,0,0,0, "*",#PB_Explorer_NoFiles|#PB_Explorer_NoDriveRequester)
  SplitterGadget(2, 5, 5, 768, 530, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator)
  SetGadgetState(2,160)
CloseGadgetList()


SetWindowTheme(GadgetID(1),"", "BUTTON")

SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)

SetGadgetFont(1,FontID(0))
SetGadgetColor(1, #PB_Gadget_BackColor, $D2D2D2)
;SendMessage_(GadgetID(1),#TVM_SETBKCOLOR,0,RGB(200,255,0))

TextGadget(12,10,565,80,25,"START",#SS_CENTER| #SS_CENTERIMAGE)
SetGadgetColor(12,#PB_Gadget_FrontColor,$0000FF)
SetGadgetFont(12,FontID(0))

TextGadget(15,100,565,600,25,"",#SS_CENTER| #SS_CENTERIMAGE)
SetGadgetColor(15,#PB_Gadget_FrontColor,$FF0000)
SetGadgetFont(15,FontID(0))

BindEvent(#PB_Event_SizeWindow,@Resizewindow_EX())

Repeat           
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
        CallFunction(0,"GdipDeleteGraphics",*Localgfx) 
        CallFunction(0,"GdiplusShutdown",*token)
        CloseLibrary(0)
        Quit = 1        
        
    Case #WM_RBUTTONDOWN ; right mouse button was clicked =>
      File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
      SetGadgetText(15,File$)
      DisplayPopupMenu(0, WindowID(0))  ; now display the popup-menu
          
    Case #PB_Event_Menu        ; an item of the popup-menu was clicked
      Select EventMenu()       ; get the clicked menu item...
        Case 1 : Debug "Menu: Open"
        Case 2 : Debug "Menu: Save"
        Case 3 : Debug "Menu: Save as"
        Case 4 : End
        Case 5 
;             CallFunction(0,"GdipDisposeImage",*image)    ;Very Important
;             CallFunction(0,"GdipDeleteGraphics",*Localgfx)  
;             CallFunction(0,"GdiplusShutdown",*token) 
            Beep_(800,100)
            Result = MessageRequester("Attention","Recycle Image ?",#PB_MessageRequester_YesNo|#MB_ICONQUESTION)
            If Result = #PB_MessageRequester_Yes
              SHFileOp.SHFILEOPSTRUCT                
              ZeroMemory_(@SHFileOp, SizeOf(SHFileOp))
              SHFileOp\hwnd = #Null
              SHFileOp\pFrom  = @File$
              SHFileOp\pTo = #Null
              SHFileOp\wFunc  = #FO_DELETE
              SHFileOp\fFlags = #FOF_ALLOWUNDO|#FOF_NOERRORUI |#FOF_SILENT; | #FOF_NORECURSION
              result = SHFileOperation_(SHFileOp)
            EndIf    
        Case 6 : Debug "Menu: Text.txt"
      EndSelect
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
          SetGadgetText(15,File$)

        Case 1
          Select EventType()
            Case #PB_EventType_Change
              If IsThread(Thread)      
                KillThread(Thread)
              EndIf
              Thread = CreateThread(@PopulateLI(),32)                                 
          EndSelect
      EndSelect
  EndSelect
Until Quit = 1
End

Egypt my love
User avatar
RSBasic
Moderator
Moderator
Posts: 1218
Joined: Thu Dec 31, 2009 11:05 pm
Location: Gernsbach (Germany)
Contact:

Re: Thumbnails 4 Images [Windows]

Post by RSBasic »

Good idea, works here, but I don't like the UI design. That looks something like Windows 1/2/3.1. :D
Image
Image
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Thumbnails 4 Images [Windows]

Post by BarryG »

Thank you Rashad, I needed this. Now I just have to strip your code right down to the bare minimum to get the thumbnail image from a filename only.
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Thumbnails 4 Images [Windows]

Post by RASHAD »

Hi RSBasic
I do not remember even XP UI :)
Just I wanted to refresh myself

Hi BarryG
Thanks and you are welcome
Egypt my love
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5342
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: Thumbnails 4 Images [Windows]

Post by Kwai chang caine »

Thanks for sharing 8)
I try your code and have a tree of all my files
When i click on a folder of the tree, where they are images, nothing appears in the right white square, just a name of file appear in the bottom text :|
W7 X86 // v5.70 X86
ImageThe happiness is a road...
Not a destination
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Thumbnails 4 Images [Windows]

Post by RASHAD »

Hi KCC
Thanks
I will try it later with W7
New version :
- Hot Tracking enabled
- Transparent images and better looking
- Back to normal UI :P

Code: Select all

CompilerIf Not #PB_Compiler_Unicode 
  MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
  End
CompilerEndIf

#TVM_SETBKCOLOR = $111D
#FOF_NORECURSION      = $1000

UseJPEG2000ImageDecoder()
UseTGAImageDecoder()

Global *token, *Image,Image
Global HBITMAP,Thread,Path$,Finish,ILwnd
Global iSize,w.f,h.f,bcolor
Global Dim item$(500)

iSize = 128
bcolor = $FFFFFF
Image = 0

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

Structure PGMColor
  c.a
EndStructure

Structure RectF
  x.f
  y.f
  width.f
  height.f
EndStructure
 
Structure GdiplusStartupInput
  GdiPlusVersion.i
  *DebugEventCallback.DebugEventProc
  SuppressBackgroundThread.i
  SuppressExternalCodecs.i
EndStructure

Structure ImageCodecInfo
  clsid.CLSID
  formatID.GUID
  *codecName
  *dllName
  *formatDescription
  *filenameExtension
  *mimeType
  flags.l
  version.l
  sigCount.l
  sigSize.l
  *sigPattern.byte
  *sigMask.byte
EndStructure

Macro _imgscale
  hScale.f = iSize/w
  vScale.f = iSize/h
  If hScale > vScale
      Scale.f = vScale*0.9
  Else
      Scale.f = hScale*0.9
  EndIf
  If Scale > 2
    Scale = 2
  EndIf
  x = (iSize-Scale*w)/2
  y = (iSize-Scale*h)/2
EndMacro

Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
  OpenLibrary(0, "gdiplus.dll")
  Protected *token, input.GdiplusStartupInput
  With input
    \GdiPlusVersion = version
    \DebugEventCallback = *hEventCB
    \SuppressExternalCodecs = Codecs
    \SuppressBackgroundThread = bgThread
  EndWith
  CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
  ProcedureReturn *token
EndProcedure

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 PopulateLI(par)
  Finish = 0 :item = 0 : Scale.f = 0
  PostEvent(#PB_Event_SizeWindow)  
  SetGadgetText(12,"WAIT")
  DisableWindow(0,1)
  ClearGadgetItems(0)
  If ILwnd
    ImageList_Destroy_(ILwnd)
  EndIf
  If IsImage(img)
    FreeImage(img)
  EndIf  
  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) 
  Path$ = GetGadgetText(1)
  If ExamineDirectory(0, Path$, "*.*")
    *token = Gdiplus_New() 
    Repeat
      NextEntry     = NextDirectoryEntry(0)                   
      FileName$     = DirectoryEntryName(0)
      File$ = Path$+FileName$
      Ext$ = LCase(GetExtensionPart(FileName$))
      If FileSize(File$)  > 0; And FileSize(Path$ + FileName$) < 100000
        Select Ext$
          Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
            If *token                   
              CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
              CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
              CallFunction(0,"GdipGetImageDimension",*image, @w, @h)
              _imgscale  ;Macro Scale
              imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawingMode(#PB_2DDrawing_AlphaClip )
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(HBITMAP)
                DeleteObject_(imgH)
              EndIf
            EndIf
           
          Case "cur"
            hCursor = LoadCursorFromFile_(@File$)
            If hCursor
              item = ImageList_AddIcon_(ILwnd,hCursor)
              iItem(0,FileName$ ,item)
              item$(item) = FileName$
              DeleteObject_(hCursor)  
            EndIf
           
          Case "jp2","tga"
            LoadImage(0,File$)
            w = ImageWidth(0)
            h = ImageHeight(0)
            If IsImage(0)
              _imgscale
              imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawingMode(#PB_2DDrawing_AlphaClip )
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(imgH)
              EndIf
            EndIf
            
          Case "ppm","pgm"
            If IsImage(0)
              FreeImage(0)
            EndIf
            LoadPPGM(Image, File$)
            If IsImage(Image)
              _imgscale
              imgH = CopyImage_(ImageID(Image),#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
              If imgH
                hdc = StartDrawing(ImageOutput(img))
                  Box(0,0,iSize+10,iSize+10,bcolor)
                  DrawingMode(#PB_2DDrawing_AlphaClip )
                  DrawImage(imgh,x,y)
                StopDrawing()
                item = ImageList_Add_(ILwnd,ImageID(img),0)
                iItem(0,FileName$ ,item)
                item$(item) = FileName$
                DeleteObject_(imgH)
              EndIf
            EndIf 
;          
         EndSelect
       EndIf
    Until NextEntry = 0
  EndIf
  Finish = 1
  SetGadgetText(12,"GO")
  DisableWindow(0,0)
EndProcedure

Procedure Resizewindow_EX()
  ResizeGadget(5,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-50) 
  ResizeGadget(2,#PB_Ignore,#PB_Ignore,WindowWidth(0) - 35,WindowHeight(0)-65)
  ResizeGadget(12,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
  ResizeGadget(15,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
EndProcedure

LoadFont(0,"Consolas",14)
LoadFont(1,"Arial",7)

OpenWindow(0,0,0,800,600,"ListIconGadget & Thumbnails",#PB_Window_SystemMenu| #PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
SetWindowColor(0,$AAAAAB)

If CreatePopupImageMenu(0)      ; creation of the pop-up menu begins...
  MenuItem(1, "Open")      ; You can use all commands for creating a menu
  MenuItem(2, "Copy")      ; just like in a normal menu...
  MenuItem(3, "Save as..")
  MenuBar()  
  MenuItem(4, "Delete")
  MenuItem(5, "Recycle")
  MenuBar()
  MenuItem(6, "Print")
EndIf

ContainerGadget(5,10,10,780,545,#PB_Container_Flat)
  ListIconGadget(0,0,0,0,0,"",0,#PB_ListIcon_MultiSelect| #LVS_AUTOARRANGE )
  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)
  SplitterGadget(2, 5, 5, 768, 530, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator)
  SetGadgetState(2,160)
CloseGadgetList()
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)

SetGadgetFont(1,FontID(0))
SetGadgetColor(1, #PB_Gadget_BackColor, $EBFEFF)

TextGadget(12,10,565,80,25,"START",#SS_CENTER|#SS_CENTERIMAGE)
SetGadgetColor(12,#PB_Gadget_FrontColor,$0000FF)
SetGadgetFont(12,FontID(0))

TextGadget(15,100,565,600,25,"",#SS_CENTER|#SS_CENTERIMAGE)
SetGadgetColor(15,#PB_Gadget_FrontColor,$FF0000)
SetGadgetFont(15,FontID(0))

BindEvent(#PB_Event_SizeWindow,@Resizewindow_EX())

Repeat           
  Select WaitWindowEvent()     
    Case #PB_Event_CloseWindow
        CallFunction(0,"GdipDeleteGraphics",*Localgfx) 
        CallFunction(0,"GdiplusShutdown",*token)
        CloseLibrary(0)
        Quit = 1        
        
    Case #WM_RBUTTONDOWN ; right mouse button was clicked =>
      File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
      SetGadgetText(15,File$)
      DisplayPopupMenu(0, WindowID(0))  ; now display the popup-menu
          
    Case #PB_Event_Menu        ; an item of the popup-menu was clicked
      Select EventMenu()       ; get the clicked menu item...
        Case 1 : Debug "Menu: Open"
        Case 2 : Debug "Menu: Save"
        Case 3 : Debug "Menu: Save as"
        Case 4 : End
        Case 5 
;             CallFunction(0,"GdipDisposeImage",*image)    ;Very Important
;             CallFunction(0,"GdipDeleteGraphics",*Localgfx)  
;             CallFunction(0,"GdiplusShutdown",*token) 
            Beep_(800,100)
            Result = MessageRequester("Attention","Recycle Image ?",#PB_MessageRequester_YesNo|#MB_ICONQUESTION)
            If Result = #PB_MessageRequester_Yes
              SHFileOp.SHFILEOPSTRUCT                
              ZeroMemory_(@SHFileOp, SizeOf(SHFileOp))
              SHFileOp\hwnd = #Null
              SHFileOp\pFrom  = @File$
              SHFileOp\pTo = #Null
              SHFileOp\wFunc  = #FO_DELETE
              SHFileOp\fFlags = #FOF_ALLOWUNDO|#FOF_NOERRORUI |#FOF_SILENT; | #FOF_NORECURSION
              result = SHFileOperation_(SHFileOp)
            EndIf    
        Case 6 : Debug "Menu: Text.txt"
      EndSelect
   
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
          SetGadgetText(15,File$)

        Case 1
          Select EventType()
            Case #PB_EventType_Change
              If IsThread(Thread)      
                KillThread(Thread)
              EndIf
              Thread = CreateThread(@PopulateLI(),32)                                 
          EndSelect
      EndSelect
  EndSelect
Until Quit = 1
End

Last edited by RASHAD on Thu Jun 06, 2019 11:20 am, edited 1 time in total.
Egypt my love
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Thumbnails 4 Images [Windows]

Post by BarryG »

Hi Rashad, I thought your code would show thumbnails for all file types (like in the image below), but it doesn't. Is there a way to make it do that?

Image
RASHAD
PureBasic Expert
PureBasic Expert
Posts: 4636
Joined: Sun Apr 12, 2009 6:27 am

Re: Thumbnails 4 Images [Windows]

Post by RASHAD »

Hi BarryG
You can use Shell Thumbnail by "freak"
Of course it needs some modifications to be adapted for your needs
Good luck

Code: Select all

Procedure GetShellThumbnail(FileName$, Image, Width, Height, Depth = #PB_Image_DisplayFormat)
  Protected Result = 0, ImageResult
  Protected Desktop.IShellFolder, Folder.IShellFolder
  Protected Extract.IExtractImage
  Protected *pidlFolder.ITEMIDLIST, *pidlFile.ITEMIDLIST 
  Protected Priority, Flags, Bitmap = 0, size.SIZE

  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)
            If ImageResult
              If Image = #PB_Any
                Image = ImageResult
              EndIf   
              If Depth = #PB_Image_DisplayFormat
                Depth = ImageDepth(Image)
              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
                                 
                  If StartDrawing(ImageOutput(Image))
                    DrawImage(Bitmap, 0, 0)
                    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
 
  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)
  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
Egypt my love
BarryG
Addict
Addict
Posts: 3292
Joined: Thu Apr 18, 2019 8:17 am

Re: Thumbnails 4 Images [Windows]

Post by BarryG »

Thank you Rashad. It still doesn't show the PDF preview, but does for videos now. I saw some other posts in these forums that apparently I need Adobe Reader (or Acrobat) installed to see PDF thumbnails. I use SumatraPDF. Strange that Explorer shows a thumb of the PDF doc, though.
Post Reply