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 |
![]() 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/ |