It is currently Sat Nov 28, 2020 12:08 am

All times are UTC + 1 hour




Post new topic Reply to topic  [ 1 post ] 
Author Message
 Post subject: Explorer Image List
PostPosted: Mon Mar 30, 2020 11:05 pm 
Offline
New User
New User
User avatar

Joined: Sun Mar 08, 2020 12:23 am
Posts: 3
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


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

All times are UTC + 1 hour


Who is online

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