PureBasic Forum
http://forums.purebasic.com/english/

Explorer Image List
http://forums.purebasic.com/english/viewtopic.php?f=12&t=74989
Page 1 of 1

Author:  Machupichu [ Mon Mar 30, 2020 11:05 pm ]
Post subject:  Explorer Image List

8) hello, people!!

Code:
; Title:   ExplorerImageList.pbi
; Author:  MACHUPICHU
; Date:    3.05.2020
; Version: 0.7
; OS:  Crossplataform
; PB ver.  5.7
; License: Free

DeclareModule TheExplorer
  Declare.i InitSync_(ElapsedMiliSecs.l=2000)
  Declare EndSync_()
  ;************
  Declare.s FormatFileSize_(v.q)
  Declare.s SelectedFilesSize_(U)
  Declare.l CountSelectedFiles_(U)
  ;************
  Declare ItemImageWidth_(U, e.l=#PB_Ignore)
  Declare ItemImageHeight_(U, e.l=#PB_Ignore)
  ;************
  Declare.i ExplorerListGadget_(U, x.l, y.l, m, n,  Directory$="", Flags.l=0, tip.s=#TAB$, crBk=-1, crFr=-1, hFont.i=#PB_Default)
  Declare.s GetGadgetText_(U)
  Declare SetGadgetText_(U, Txt$)
  Declare.q GetGadgetData_(U)
  Declare SetGadgetData_(U, Value.q)
EndDeclareModule
Module TheExplorer
  EnableExplicit
  #RealFolder=-2
  Structure stkExplorer
    Patt$;  FileName or Patterns
    Folder$; Folder Actual
    uGdg.i; Gadget
    dat.i; Data
    uWnd.i; Ventana Parent.
  EndStructure
  Structure stkInfo
    uLogo.i
    OrigWid.l
    OrigHgt.l
    szFile.q
  EndStructure
  Structure stkExplorers
    Elapsed.l
    WaitProcess.b
    Thread.i
    List _EXP.stkExplorer()
    Map PITEM.stkInfo(); Acumula todos los items que hayan sido cargados por los Explorers, sirve como base de datos para que otro explorer ya no reitere la carga.
    Map TMPATH.stkInfo(); Temporal para acumular PATHS.
  EndStructure
  Global Explorers.stkExplorers
  Procedure MyThread(*Explorers.stkExplorers )
    Repeat
      If Not *Explorers\WaitProcess
        ForEach *Explorers\_EXP()
          If IsGadget(*Explorers\_EXP()\uGdg)
            PostEvent(#PB_Event_Gadget, *Explorers\_EXP()\uWnd, *Explorers\_EXP()\uGdg, #PB_EventType_Focus)
          Else
            DeleteElement( *Explorers\_EXP())
          EndIf
        Next
      EndIf
      Delay(Explorers\Elapsed)
    ForEver
  EndProcedure
  Procedure.i InitSync_(ElapsedMiliSecs.l=2000)
    Explorers\Elapsed=ElapsedMilisecs
    If IsThread(Explorers\Thread): KillThread(Explorers\Thread): EndIf
    Explorers\Thread= CreateThread(@MyThread(), @Explorers)
    ProcedureReturn Explorers\Thread
  EndProcedure
  Procedure EndSync_()
    If IsThread(Explorers\Thread) : KillThread(Explorers\Thread): EndIf
  EndProcedure
  CompilerIf #PB_Compiler_OS= #PB_OS_Windows
    Macro _ICON32
      , "ICO"
    EndMacro
  CompilerElse
    Macro _ICON32
    EndMacro
  CompilerEndIf
  Procedure.i ConvertToMiniature(uSrc.i, uDst.i=#PB_Any, icoSZ.d=48)
    ;{ [1]
    Define iSns.a, H.i: If uDst <=#PB_Any: uDst=#PB_Any : iSns=#True: EndIf
    ;} [1]
    Define Z.i, xx2.d=ImageWidth(uSrc), yy2.d=ImageHeight(uSrc)
    Define.d sns.b, ProjX,  ProjY, Max
    If xx2 >icoSZ Or  yy2  > icoSZ
      ; 'Max' es la dimensión más larga.
      If xx2 > yy2
        Max= xx2
        ProjY= (xx2- yy2)/2.0
      Else ; yy2 > xx2
        Max= yy2
        ProjX= (yy2- xx2)/2.0
      EndIf
      sns= #True
      Goto JP
    Else
      Max=icoSZ
      ProjY= (icoSZ- yy2)/2.0
      ProjX= (icoSZ- xx2)/2.0
      JP:
      H= CreateImage(uDst, Max, Max,32, #PB_Image_Transparent)
      ;{ [2]
      If iSns And IsImage(H):  uDst=H:  H= ImageID(uDst): EndIf
      ;} [2]
      StartDrawing(ImageOutput(uDst))
      DrawingMode(#PB_2DDrawing_AlphaBlend |#PB_2DDrawing_Transparent)
      DrawImage(ImageID(uSrc), ProjX, ProjY)
      StopDrawing()
      If sns
        ResizeImage(uDst, icoSZ, icoSZ)
      EndIf
    EndIf
    ;{ [3]
    If iSns: H=uDst: EndIf
    ;} [3]
    ProcedureReturn H
  EndProcedure
  Procedure _ImagesToListIcon(*EXP.stkExplorer, d.s=";" , ClearAll.b=#True)
    Define File$, xt$, K, uImg,i, U.i, Z.i, snsIco.b
    Define x, R,  tnt$
    Define Patt$=*EXP\Patt$; EXAMPLE:  "*.ICO;*.PNG;*.BMP;*.JPG"
    ;===========================
    U= CountGadgetItems(*EXP\uGdg) - 1
    ClearMap(Explorers\TMPATH() )
    If ClearAll
      ForEach Explorers\PITEM()
        xt$=MapKey(Explorers\PITEM())
        Z=FileSize(xt$)
        If Z = (-1) Or  Z <> Explorers\PITEM()\szFile
          uImg=Explorers\PITEM()\uLogo
          DeleteMapElement(Explorers\PITEM())
          If IsImage(uImg)
            FreeImage(uImg)
          EndIf
        EndIf
      Next
      ClearGadgetItems(*EXP\uGdg)
    Else
      If FileSize(*EXP\Folder$) =#RealFolder
        Define *pit.stkInfo
        For K= 0 To U
          xt$= LCase( *EXP\Folder$  +  GetGadgetItemText( *EXP\uGdg, K) )
          *pit=GetGadgetItemData( *EXP\uGdg, K)
          Z=FileSize(xt$)
          If  Z > (-1)
            AddMapElement(Explorers\TMPATH(), xt$)
            If *pit
              CopyStructure(*pit, Explorers\TMPATH(), stkInfo)
            EndIf
          Else
            RemoveGadgetItem(*EXP\uGdg, K)
            K= K-1: U=U -1
            DeleteMapElement(Explorers\PITEM(), xt$)
            If *pit
              uImg= *pit\uLogo
              If IsImage(uImg)
                FreeImage(uImg)
              EndIf
            EndIf
          EndIf
        Next
      EndIf
    EndIf
    If Patt$<>""
      Repeat
        Patt$=Mid(Patt$, x)
        x= FindString(Patt$, d)
        If x
          tnt$=StringField(Patt$ , 1, d)
          x= Len(tnt$)+ Len(d) + 1
          Goto XX
        Else
          tnt$=Patt$
          XX:
          U=  ExamineDirectory(#PB_Any, *EXP\Folder$,  tnt$)
          If U
            While NextDirectoryEntry(U)
              If DirectoryEntryType(U) = #PB_DirectoryEntry_File
                File$= DirectoryEntryName(U)
                xt$= GetExtensionPart(File$)
                Select UCase(xt$)
                  Case "PNG", "JPG", "JPEG", "GIF", "TIFF", "BMP", "TGA" _ICON32
                    ; Revaloramos variable.
                    xt$= LCase(*EXP\Folder$ + File$)
                    If Not FindMapElement(Explorers\TMPATH(), xt$ )
                      If FindMapElement( Explorers\PITEM(), xt$ )
                        If FileSize(xt$) <> Explorers\PITEM()\szFile
                          Goto XYZ
                        EndIf
                      Else
                        AddMapElement(Explorers\PITEM(), xt$)
                        XYZ:
                        Z= LoadImage(#PB_Any,  xt$)
                        ;Para ahorrar memoria limitaremos las imágenes a 1024 pixeles ó 32x32 px.
                        uImg=ConvertToMiniature(Z, #PB_Any, 32)
                        ;Agregamos un nuevo elemento a las imágenes públicas.
                        Explorers\PITEM()\OrigWid=ImageWidth(Z)
                        Explorers\PITEM()\OrigHgt=ImageHeight(Z)
                        Explorers\PITEM()\uLogo=uImg
                        Explorers\PITEM()\szFile=FileSize(xt$)
                        FreeImage(Z)
                      EndIf
                      AddMapElement(Explorers\TMPATH(), xt$)
                      ;Llenamos la estructura, calcando (copiando) valores.
                      CopyStructure(@Explorers\PITEM(), @Explorers\TMPATH(), stkInfo)
                      AddGadgetItem(*EXP\uGdg, -1,  File$ , ImageID( Explorers\PITEM()\uLogo ) )
                      SetGadgetItemData( *EXP\uGdg, R, @Explorers\PITEM() )
                      R+1
                    EndIf
                EndSelect
              EndIf
            Wend
            FinishDirectory(U)
          EndIf
        EndIf
      Until x=0
    EndIf
    ProcedureReturn R
  EndProcedure
  Procedure FakeEventFocus()
    Define *EXP.stkExplorer=GetGadgetData(EventGadget())
    Explorers\WaitProcess= #True
    _ImagesToListIcon(*EXP, ";", #False)
    Explorers\WaitProcess= #False
  EndProcedure
  ;///////////
  Procedure.s GetGadgetText_(U) ; Get the currently displayed directory.
    Define *EXP.stkExplorer=GetGadgetData(U), t$
    If *EXP
      t$= *EXP\Folder$
    EndIf
    ProcedureReturn t$
  EndProcedure
  Procedure SetGadgetText_(U, Txt$) ; Changes the currently displayed directory, or the current pattern for files.
    Explorers\WaitProcess= #True
    Define *EXP.stkExplorer=GetGadgetData(U)
    ;Debug Txt$
    If (*EXP And Txt$<>"" ) And  Txt$ <>  *EXP\Folder$ + *EXP\Patt$
      *EXP\Folder$= GetPathPart( Txt$)
      If GetFilePart(Txt$) <> ""
        *EXP\Patt$=GetFilePart(Txt$)
      EndIf
      If *EXP\Patt$= ""
        *EXP\Patt$="*"
      EndIf
      _ImagesToListIcon(*EXP, ";", #True)
    EndIf
    Explorers\WaitProcess= #False
  EndProcedure
  ;///////////
  Procedure.q GetGadgetData_(U) ; Get the currently displayed directory.
    Define *EXP.stkExplorer=GetGadgetData(U), v.q
    If *EXP
      v= *EXP\dat
    EndIf
    ProcedureReturn v
  EndProcedure
  Procedure SetGadgetData_(U, v.q) ; Get the currently displayed directory.
    Define *EXP.stkExplorer=GetGadgetData(U)
    If *EXP
      *EXP\dat= v
    EndIf
  EndProcedure
  ;///////////
  Procedure ItemImageWidth_(U, e.l=#PB_Ignore)
    Define r, *EXP.stkExplorer=GetGadgetData(U)
    If *EXP
      If e=#PB_Ignore
        If GetGadgetState( *EXP\uGdg) > -1 And  FindMapElement(Explorers\PITEM(),  LCase( *EXP\Folder$ +  GetGadgetItemText( *EXP\uGdg, GetGadgetState( *EXP\uGdg) )  ) )
          r=Explorers\PITEM()\OrigWid
        EndIf
      Else
        If FindMapElement(Explorers\PITEM(),  LCase( *EXP\Folder$ +  GetGadgetItemText( *EXP\uGdg, e) ) )
          r=Explorers\PITEM()\OrigWid
        EndIf
      EndIf
    EndIf
    ProcedureReturn r
  EndProcedure
  Procedure ItemImageHeight_(U, e.l=#PB_Ignore)
    Define r, *EXP.stkExplorer=GetGadgetData(U)
    If *EXP
      If e=#PB_Ignore
        If GetGadgetState( *EXP\uGdg) > -1 And  FindMapElement(Explorers\PITEM(),  LCase( *EXP\Folder$ +  GetGadgetItemText( *EXP\uGdg, GetGadgetState( *EXP\uGdg) ))  )
          r=Explorers\PITEM()\OrigHgt
        EndIf
      Else
        If FindMapElement(Explorers\PITEM(),  LCase(*EXP\Folder$ +  GetGadgetItemText( *EXP\uGdg, e) )  )
          r=Explorers\PITEM()\OrigHgt
        EndIf
      EndIf
    EndIf
    ProcedureReturn r
  EndProcedure
  Procedure.s FormatFileSize_(v.q)
    Define t$
    If   v > 0 And v < 1024
      t$= ""+ v + " bytes"
    ElseIf  v > 1024 And v < 1048576 ;1024*1024
      t$= ""+  StrD(v/1024.0, 2) + " KB"
    ElseIf  v > 1048576 And v < 1073741824 ; 1024*1024*1024
      t$= ""+  StrD(v/1048576.0, 2)+ " MB"
    ElseIf  v > 1073741824 And v < 1099511627776 ; 1024*1024*1024
      t$= ""+  StrD(v/1073741824.0, 2)+ " GB"
    ElseIf  v > 1099511627776 And v < 1125899906842624 ; 1024*1024*1024 *1024
      t$= ""+  StrD(v/1099511627776.0, 2)+ " TB"
    EndIf
    ProcedureReturn t$
  EndProcedure
  Procedure.s SelectedFilesSize_(U)
    Define *EXP.stkExplorer=GetGadgetData(U)
    If *EXP
      Define  K, E, Fi$, Z.q;, sel
      E=CountGadgetItems(*EXP\uGdg) - 1
      For K= 0 To E
        ;Verificamos si el item esta seleccionado.
        If GetGadgetItemState( *EXP\uGdg, K) &  #PB_ListIcon_Selected; #PB_Explorer_Selected
          Fi$=GetGadgetItemText( *EXP\uGdg, K)
          If  FindMapElement(Explorers\PITEM(),  LCase(*EXP\Folder$ + Fi$ ) )
            Z=Z +FileSize( *EXP\Folder$ + Fi$)
          EndIf
        EndIf
      Next
    EndIf
    Fi$=FormatFileSize_(Z)
    ProcedureReturn Fi$
  EndProcedure
  Procedure.l CountSelectedFiles_(U); , *TotalSize.quad= #NUL)
    Define *EXP.stkExplorer=GetGadgetData(U)
    If *EXP
      Define  K, E, sel
      E=CountGadgetItems(*EXP\uGdg) - 1
      For K= 0 To E
        ;Verificamos si el item esta seleccionado.
        If GetGadgetItemState( *EXP\uGdg, K) &  #PB_ListIcon_Selected; #PB_Explorer_Selected
          sel= sel+ 1
        EndIf
      Next
    EndIf
    ProcedureReturn sel
  EndProcedure
  ;///////////
  Procedure.i ExplorerListGadget_(U, x.l, y.l, m, n,  Directory$="", Flags.l=0, tip.s=#TAB$, crBk=-1, crFr=-1, hFont.i=#PB_Default)
    Define hgdg.i, *EXP.stkExplorer
    If U < #PB_Any: U= #PB_Any: EndIf
    hgdg=ListIconGadget(u, x, y,m,n, "", 180, Flags)
    ;{ Esta manera asegura los no errores.
    If hgdg Or IsGadget(hGdg): If U=#PB_Any: U=hgdg: EndIf
      If IsFont(hFont): hFont=FontID(hfont): EndIf
      If hfont<>0 And hFont<>#PB_Default
        SetGadgetFont(u, hFont)
      EndIf
      ;{ (INTERNAL DATA)
      AddElement( Explorers\_EXP() )
      Explorers\_EXP()\uGdg=u
      Explorers\_EXP()\Folder$=GetPathPart(Directory$)
      Explorers\_EXP()\Patt$=GetFilePart(Directory$) ; EXAMPLE:  "*.ICO;*.PNG;*.BMP;*.JPG"
      Explorers\_EXP()\uWnd=UseGadgetList(#NUL)
      SetGadgetData(U, @Explorers\_EXP())
      ;} (INTERNAL DATA)
      SetGadgetColor(u, #PB_Gadget_FrontColor, RGB(Red(crFr), Green(crFr), Blue(crFr)))
      SetGadgetColor(u, #PB_Gadget_BackColor, RGB(Red(crBk), Green(crBk), Blue(crBk)))
      If tip<> #TAB$
        GadgetToolTip(u, tip)
      EndIf
      CompilerIf #PB_Compiler_OS= #PB_OS_Windows
        SetGadgetAttribute( U, #PB_Explorer_DisplayMode, #PB_Explorer_LargeIcon)
        SetWindowLongPtr_(GadgetID(U), #GWL_EXSTYLE, GetWindowLongPtr_(GadgetID(U), #GWL_EXSTYLE) &~ #WS_EX_CLIENTEDGE )
        SetWindowLongPtr_(GadgetID(U), #GWL_STYLE, GetWindowLongPtr_(GadgetID(U), #GWL_STYLE) | #WS_CLIPCHILDREN)
      CompilerEndIf
      _ImagesToListIcon(@Explorers\_EXP(),";", #True)
      BindEvent(#PB_Event_Gadget, @FakeEventFocus(), Explorers\_EXP()\uWnd,  U, #PB_EventType_Focus)
      ;NOTA: El Evento 'focus' lo usaremos solamente como auxiliar (No que vayamos a tener evento focus).
    EndIf
    ;}
    ProcedureReturn hgdg
  EndProcedure
EndModule
CompilerIf #PB_Compiler_IsMainFile
  UseGIFImageDecoder()
  UseJPEGImageDecoder()
  UsePNGImageDecoder()
  UseTGAImageDecoder()
  UseTIFFImageDecoder()
  EnableExplicit
  Structure stkXLK
    uWnd.i
    uTxtPattSrc.i
    uTxtPattDst.i
    uLxpSrc.i
    uLxpDst.i
    uLBLinfoSrc.i
    uLBLinfoDst.i
  EndStructure
  #SupportedPatts$= "*.png;*.jpg;*.jpeg;*.gif;*.tiff;*.bmp;*.ico;*.tga"
  Define XL.stkXLK
  XL\uWnd= OpenWindow(#PB_Any, 100, 100, 810, 650, "ListIcon Example", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget | #PB_Window_MaximizeGadget)
  If XL\uWnd
    XL\uTxtPattSrc= StringGadget(#PB_Any, 5, 5, 120, 30, #SupportedPatts$) : GadgetToolTip(XL\uTxtPattSrc, "Change your image patterns" )
    XL\uTxtPattDst= StringGadget(#PB_Any, 405, 5, 120, 30, #SupportedPatts$): GadgetToolTip(XL\uTxtPattDst, "Change your image patterns" )
    XL\uLxpSrc= TheExplorer::ExplorerListGadget_(#PB_Any, 5, 40, 400, 550,  "C:\Users\WESTERN_EAGLE\Desktop\TESTIMG\"+ #SupportedPatts$,
    #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect, "Choose yours images (support multiselection)", $444444, $FFFFFF )
    XL\uLxpDst= TheExplorer::ExplorerListGadget_(#PB_Any, 405, 40, 400, 550, "C:\Users\WESTERN_EAGLE\Pictures\NuevosIconos\" + #SupportedPatts$,
    #PB_ListIcon_FullRowSelect | #PB_ListIcon_AlwaysShowSelection | #PB_ListIcon_MultiSelect, "Choose yours images (support multiselection)", $444444, $FFFFFF )
    XL\uLBLinfoSrc= TextGadget(#PB_Any, 5, 600, 200, 30, " 0 selected files  ")
    XL\uLBLinfoDst= TextGadget(#PB_Any, 405, 600, 200, 30,  " 0 selected files  ")
    TheExplorer::InitSync_()
    Define Evw
    With XL
      Repeat
        Evw = WaitWindowEvent()
        Select Evw
          Case #PB_Event_LeftClick
          Case #PB_Event_Gadget
            Select EventGadget()
              Case \uTxtPattSrc
                If EventType()= #PB_EventType_Change
                  TheExplorer::SetGadgetText_(\uLxpSrc, TheExplorer::GetGadgetText_(\uLxpSrc) + GetGadgetText(\uTxtPattSrc) )
                EndIf
              Case \uTxtPattDst
                If EventType()= #PB_EventType_Change
                  TheExplorer::SetGadgetText_(\uLxpDst, TheExplorer::GetGadgetText_(\uLxpDst) + GetGadgetText(\uTxtPattDst) )
                EndIf
              Case  \uLxpSrc
                If EventType()= #PB_EventType_LeftClick
                  SetGadgetText(\uLblInfoSrc, " "+ TheExplorer::CountSelectedFiles_(\uLxpSrc ) +" selected files   " + TheExplorer::SelectedFilesSize_(\uLxpSrc ) )
                  ;SetGadgetText(  \uLBLinfo, "Image Size: " + TheExplorer::ItemImageWidth_(\uLxpSrc) + " x " + TheExplorer::ItemImageHeight_(\uLxpSrc)  )
                EndIf
              Case  \uLxpDst
                If EventType()= #PB_EventType_LeftClick
                  SetGadgetText(\uLblInfoDst, " "+ TheExplorer::CountSelectedFiles_(\uLxpDst) +" selected files   " + TheExplorer::SelectedFilesSize_(\uLxpDst) )
                  ; SetGadgetText(  \uLBLinfoDst, "Image Size: " + TheExplorer::ItemImageWidth_(\uLxpDst) + " x " + TheExplorer::ItemImageHeight_(\uLxpSrc)  )
                EndIf
            EndSelect
        EndSelect
      Until Evw = #PB_Event_CloseWindow
    EndWith
  EndIf
  TheExplorer::EndSync_()
  FreeImage(-1)
CompilerEndIf

Page 1 of 1 All times are UTC + 1 hour
Powered by phpBB © 2000, 2002, 2005, 2007 phpBB Group
http://www.phpbb.com/