It is currently Thu Dec 12, 2019 5:21 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 9 posts ] 
Author Message
 Post subject: Thumbnails 4 Images [Windows]
PostPosted: Wed Jun 05, 2019 7:38 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3476
Hi
Code:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Wed Jun 05, 2019 8:09 am 
Offline
Moderator
Moderator
User avatar

Joined: Thu Dec 31, 2009 11:05 pm
Posts: 1108
Location: Berlin (Germany)
Good idea, works here, but I don't like the UI design. That looks something like Windows 1/2/3.1. :D

_________________
ImageImageImageImage Image


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Wed Jun 05, 2019 8:17 am 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 444
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.


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Wed Jun 05, 2019 8:29 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3476
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Wed Jun 05, 2019 12:17 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4545
Location: Lyon - France
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Thu Jun 06, 2019 10:58 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3476
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:
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


_________________
Egypt my love


Last edited by RASHAD on Thu Jun 06, 2019 11:20 am, edited 1 time in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Thu Jun 06, 2019 11:11 am 
Offline
Enthusiast
Enthusiast

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


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Thu Jun 06, 2019 11:41 am 
Offline
PureBasic Expert
PureBasic Expert

Joined: Sun Apr 12, 2009 6:27 am
Posts: 3476
Hi BarryG
You can use Shell Thumbnail by "freak"
Of course it needs some modifications to be adapted for your needs
Good luck
Code:
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


Top
 Profile  
Reply with quote  
 Post subject: Re: Thumbnails 4 Images [Windows]
PostPosted: Thu Jun 06, 2019 12:25 pm 
Offline
Enthusiast
Enthusiast

Joined: Thu Apr 18, 2019 8:17 am
Posts: 444
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.


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

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 5 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