Code: Select all
; 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