Mais il y a encore du boulot pour faire quelques choses de vraiment propre et facile a utiliser...
Code : Tout sélectionner
; ********************************************************************
; Program: Thumbnails
; Description: add a Thumbnails to select image
; Author: Thyphoon
; Date: January, 2019
; License: Free, unrestricted, credit
; appreciated but not required.
; Note: Please share improvement !
; ********************************************************************
EnableExplicit
CompilerIf #PB_Compiler_Thread=#False
CompilerError("You must enable Compiler threadsafe")
End
CompilerEndIf
DeclareModule MagicGdt
;Param
Declare SetCallBackLoadMedia(CallBackLoadMedia.i)
;List
Declare ClearTheList()
Declare AddFileToList(FileName.s)
;ThumbNails
Declare.b SetCallBackDoubleClick(GadgetId.i,CallBackDoubleClick.i)
Declare.b SetCallBackSimpleClick(GadgetId.i,CallBackSimpleClick.i)
Declare ThumbnailsGadget(Id.i,X.l,Y.l,Width.l,Height.l,Size.l)
Declare EventThumb(Event.i)
Declare ForceRefreshThumbnails(ThumbName.s)
;Navigate
Declare NavigateGadget(Id.i,X.l,Y.l,Width.l,Height.l,ThumbnailsId.i)
Declare.i GetTheListSize(ThumbName.s)
EndDeclareModule
Module MagicGdt
;-Cache Structure
Structure LoadList
FileName.s
EndStructure
Structure PreviewImage
Image.i
LastTime.i ;last ElapsedMilliseconds()
CreateDate.s
EndStructure
Structure Cache
BackgroundThread.i ;To load image
StartTime.i ;Record Time when load image
EndTime.i ;End time when load images are finished
List LoadList.LoadList() ;Media List to load in Cache
LoadListMutex.i ;Mutex to protect LoadList()
LoadListSemaphore.i ;Semaphoe to control number of Thread
Map PreviewImage.PreviewImage() ;CacheImage List
;Map CacheImage.i() ;CacheImage List
PreviewImageMutex.i ;Mutex to protect CacheImage()
EndStructure
Prototype.i CallBackDoubleClick(FileName.s)
Prototype.i CallBackSimpleClick(FileName.s,selected.b)
;-Thumbnails Structure
Structure Thumbnails
CallBackDoubleClick.CallBackDoubleClick ;CallBack DoubleClik @Procedure(FileName.s)
CallBackSimpleClick.CallBackSimpleClick ;CallBack to select or unselect file @Procedure(FileName.s,selected.b)
Gadget.i ;Canvas Gadget number
Size.l ;Thumb Size Width and Height
Index.i ;ThumbIndex
IndexNav.i ;Navigate index
NbH.l ;Number of horizontal thumbnails
NbV.l ;Number of Vertical thumbnails
CursorStartY.l ; Cursor Y coord when clic
CursorPosY.l
CursorDeltaY.l ; Cursor Delta Y from StartY
ThumbsDeltaY.l ; Scroll Thumbs
EndStructure
;-List Structure
Structure FileList
Selected.b ; Selected = 1 / No Selected = 0
FileName.s ; File Name with path
FileDate.i ; TODO Data to sort
EndStructure
;-Main Structure
Prototype.i CallBackLoadMedia(FileName.s)
Structure Param
CallBackLoadMedia.CallBackLoadMedia ;CallBack @Procedure(FileName.s)
Cache.Cache
List FileList.FileList(); Files List to Display in Thumbnails
FileListMutex.i ; Mutex to protect FileList if used in Thread
;Thumbnails
Map Thumbnails.Thumbnails()
Refresh.b ; Redraw Thumbnails
EndStructure
;Main Parameters
Global Param.Param
Param\Cache\LoadListSemaphore=CreateSemaphore(100)
Param\Cache\LoadListMutex=CreateMutex()
Param\Cache\PreviewImageMutex=CreateMutex()
Param\FileListMutex=CreateMutex()
Procedure SetCallBackLoadMedia(CallBackLoadMedia.i)
Param\CallBackLoadMedia=CallBackLoadMedia
EndProcedure
;- Cache
Procedure CacheLoadImageThread(*param)
Protected Image.i,FileName.s
FileName=PeekS(*Param)
FreeMemory(*Param)
If Param\CallBackLoadMedia<>0 ; <- Use extern procedure to Load Image
Image=Param\CallBackLoadMedia(FileName)
Else ; <- Or intern with PB Plugin
Image=LoadImage(#PB_Any,FileName)
EndIf
;Resize Image to Thumnails MaxSize
If image<>0
Protected ImgRatio.l
Protected ContRatio.l
Protected ContWidth.l,ContHeight.l
ContWidth=512:ContHeight=512
ImgRatio.l = ImageWidth(Image) / ImageHeight(Image)
ContRatio.l = ContWidth /ContHeight
If ImgRatio<ContRatio
NewWidth=ImageWidth(Image)*ContHeight/ImageHeight(Image)
Newheight=ContHeight
Else
NewWidth=contWidth
Newheight=ImageHeight(Image)*contWidth/ImageWidth(Image)
EndIf
ResizeImage(image,NewWidth,NewHeight,#PB_Image_Smooth)
Param\Refresh=#True
LockMutex(Param\Cache\PreviewImageMutex)
Param\Cache\PreviewImage(fileName)\Image=image
Param\Cache\PreviewImage(fileName)\LastTime=ElapsedMilliseconds()
UnlockMutex(Param\Cache\PreviewImageMutex)
;If can't load image
Else
;MessageRequester("Thumbnails Error","ERROR THREAD LOAD IMAGE"+Chr(13)+FileName+Chr(13)+" in "+#PB_Compiler_Procedure+"()",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
Debug "ERROR THREAD LOAD IMAGE"+Chr(13)+FileName
EndIf
SignalSemaphore(Param\Cache\LoadListSemaphore)
EndProcedure
Procedure CacheBackgroundThread(n.i)
Protected FileName.s,*Param
;Repeat
Debug "Run CacheBackgroundThread()"
Repeat
If TrySemaphore(Param\Cache\LoadListSemaphore)
LockMutex(Param\Cache\LoadListMutex)
;Select Data from Id
If FirstElement(Param\Cache\LoadList())<>0
;check if not in cache
FileName=Param\Cache\LoadList()\FileName
*Param=AllocateMemory(StringByteLength(FileName)+ SizeOf(CHARACTER),#PB_Memory_NoClear) ;<- Thanks Boby from Purebasic French Forum ;-)
If *Param<>0
PokeS(*param,FileName)
If CreateThread(@CacheLoadImageThread(),*Param)<>0
DeleteElement(Param\Cache\LoadList())
Else
Debug "Can't Start Thread"
End
EndIf
Else
Debug "can't Allocate memory from Background Thread to CacheLoadImageThread"
End
EndIf
EndIf
UnlockMutex(Param\Cache\LoadListMutex)
EndIf
Delay(100)
Until ListSize(Param\Cache\LoadList())=0
Delay(1000)
Debug "Finish CacheBackgroundThread()"
;ForEver
EndProcedure
Procedure CacheLoadImage()
If IsThread(Param\Cache\BackGroundThread)=#False
Param\Cache\BackGroundThread=CreateThread(@CacheBackgroundThread(),0)
EndIf
EndProcedure
;-Thumbnails
Procedure.b SetCallBackDoubleClick(GadgetId.i,CallBackDoubleClick.i)
If FindMapElement(Param\Thumbnails(), Str(GadgetId))
Param\Thumbnails()\CallBackDoubleClick=CallBackDoubleClick
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.b SetCallBackSimpleClick(GadgetId.i,CallBackSimpleClick.i)
If FindMapElement(Param\Thumbnails(), Str(GadgetId.i))
Param\Thumbnails()\CallBackSimpleClick=CallBackSimpleClick
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure DrawThumbnails()
;Maybe no need to display
Protected nx.l,ny.l, x.l,y.l,i.i
Protected newImageToLoad.b ;Message to check if new image to load
newImageToLoad=#False
;Select Data from Id
GdtWidth=GadgetWidth(Param\Thumbnails()\Gadget)-25
NbH=Int(GdtWidth/Param\Thumbnails()\Size):Param\Thumbnails()\NbH=NbH
NbV=Int(GadgetHeight(Param\Thumbnails()\Gadget)/Param\Thumbnails()\Size):Param\Thumbnails()\NbV=NbV
MarginH=(GdtWidth-NbH*Param\Thumbnails()\Size)/(NbH+1)
MarginV=(GadgetHeight(Param\Thumbnails()\Gadget)-NbV*Param\Thumbnails()\Size)/(NbV+1)
;-Scroll
If Param\Thumbnails()\CursorStartY>0
If GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseY)<>0
Param\Thumbnails()\CursorPosY=GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseY)
EndIf
Param\Thumbnails()\CursorDeltaY=Param\Thumbnails()\CursorStartY-Param\Thumbnails()\CursorPosY
Param\Thumbnails()\ThumbsDeltaY=Param\Thumbnails()\ThumbsDeltaY+(Param\Thumbnails()\CursorDeltaY/10)
EndIf
;Change Index when Scroll > Thumbnails
If Param\Thumbnails()\ThumbsDeltaY>Param\Thumbnails()\Size
DeltaIndex=Int(Param\Thumbnails()\ThumbsDeltaY/Param\Thumbnails()\Size)*Param\Thumbnails()\NbH
Param\Thumbnails()\Index=Param\Thumbnails()\Index-DeltaIndex
Param\Thumbnails()\ThumbsDeltaY=Param\Thumbnails()\ThumbsDeltaY%Param\Thumbnails()\Size
EndIf
If Param\Thumbnails()\ThumbsDeltaY<-Param\Thumbnails()\Size
DeltaIndex=Abs(Int(Param\Thumbnails()\ThumbsDeltaY/Param\Thumbnails()\Size)*Param\Thumbnails()\NbH)
Param\Thumbnails()\Index=Param\Thumbnails()\Index+DeltaIndex
Param\Thumbnails()\ThumbsDeltaY=Param\Thumbnails()\ThumbsDeltaY%Param\Thumbnails()\Size
EndIf
;Limit Up Scroll
If Param\Thumbnails()\Index<=0 And Param\Thumbnails()\ThumbsDeltaY>0
Param\Thumbnails()\Index=0
Param\Thumbnails()\ThumbsDeltaY=0
Debug "Limit Up Scroll"
EndIf
;Limit Down Scroll
Protected MaxId.i
MaxId=Round(ListSize(Param\FileList())/Param\Thumbnails()\NbH,#PB_Round_Up)*Param\Thumbnails()\NbH-Param\Thumbnails()\NbH*Param\Thumbnails()\NbV
If Param\Thumbnails()\Index>=MaxId And Param\Thumbnails()\ThumbsDeltaY<0
Param\Thumbnails()\Index=MaxId
Param\Thumbnails()\ThumbsDeltaY=0
Debug "Limit Down Scroll"
EndIf
If StartDrawing(CanvasOutput(Param\Thumbnails()\Gadget))
DrawingMode(#PB_2DDrawing_Transparent|#PB_2DDrawing_AllChannels)
Box(0,0,GadgetWidth(Param\Thumbnails()\Gadget),GadgetHeight(Param\Thumbnails()\Gadget)+100,RGB(128,128,128))
For ny=-1 To NbV
For nx=0 To NbH-1
x=nx*Param\Thumbnails()\Size+MarginH*nx+(MarginH)
y=ny*Param\Thumbnails()\Size+MarginV*ny+(MarginV)+Param\Thumbnails()\ThumbsDeltaY
i=Param\Thumbnails()\Index+nx+ny*NbH
;Display only if index is in FileList()
If i>-1 And i<ListSize(Param\FileList())
SelectElement(Param\FileList(),i)
; Can I find Image in the Cache ?
LockMutex(Param\Cache\PreviewImageMutex)
n=FindMapElement(Param\Cache\PreviewImage(), Param\FileList()\FileName)
If n>0
image=Param\Cache\PreviewImage()\Image
Else
;Param\Cache\PreviewImage(Param\FileList()\FileName)\Image=0
image=-1
EndIf
UnlockMutex(Param\Cache\PreviewImageMutex)
;If no Cache Image add to Load list
If image=-1
LockMutex(Param\Cache\LoadListMutex)
AddElement(Param\Cache\LoadList())
Param\Cache\LoadList()\FileName=Param\FileList()\FileName
UnlockMutex(Param\Cache\LoadListMutex)
newImageToLoad=#True
;Id Cache Image display it
ElseIf IsImage(image)
Protected ImgRatio.l
Protected ContRatio.l
Protected ContWidth.l,ContHeight.l
Protected CenterWidth.l,CenterHeight.l
ContWidth=Param\Thumbnails()\Size:ContHeight=Param\Thumbnails()\Size
ImgRatio.l = ImageWidth(Image) / ImageHeight(Image)
ContRatio.l = ContWidth /ContHeight
If ImgRatio<ContRatio
NewWidth=ImageWidth(Image)*ContHeight/ImageHeight(Image)
Newheight=ContHeight
CenterWidth=(ContWidth-NewWidth)/2
CenterHeight=0
Else
NewWidth=contWidth
Newheight=ImageHeight(Image)*contWidth/ImageWidth(Image)
CenterWidth=0
CenterHeight=(ContHeight-Newheight)/2
EndIf
;If element selected display green
If Param\FileList()\Selected=1
Box(CenterWidth+x,CenterHeight+y,NewWidth,NewHeight,RGB(0,255,0))
EndIf
DrawImage(ImageID(image),CenterWidth+x+2,CenterHeight+y+2,NewWidth-4,NewHeight-4)
EndIf
EndIf
If i>ListSize(Param\FileList())
Break 2;
EndIf
Next
Next
Box(GdtWidth,0,25,GadgetHeight(Param\Thumbnails()\Gadget),RGB(100,100,100))
Box(GdtWidth,GadgetHeight(Param\Thumbnails()\Gadget)/2-50-Param\Thumbnails()\CursorDeltaY,25,50,RGB(200,200,200))
LockMutex(Param\Cache\LoadListMutex)
DrawText(GdtWidth,5,Str(ListSize(Param\Cache\LoadList())))
UnlockMutex(Param\Cache\LoadListMutex)
LockMutex(Param\Cache\PreviewImageMutex):DrawText(GdtWidth,45,Str(MapSize(Param\Cache\PreviewImage()))):UnlockMutex(Param\Cache\PreviewImageMutex)
StopDrawing()
Else
Debug "ERROR GADGET"
EndIf
If newImageToLoad=#True
CacheLoadImage()
EndIf
EndProcedure
Procedure DrawNavigate(Gadget.i)
StartVectorDrawing(CanvasVectorOutput(Gadget))
VectorSourceColor(RGBA(128,128,128,255))
FillVectorOutput()
Protected h.l=GadgetWidth(Gadget)
StopVectorDrawing()
EndProcedure
Procedure EventThumb(Event.i)
Protected DeltaIndex.l,Wheel.b=#False
;Select Data from Id
If Event=#PB_Event_Timer
ForEach Param\Thumbnails()
If Param\Refresh=#True Or Param\Thumbnails()\CursorStartY>0
DrawThumbnails()
EndIf
Next
If Param\Refresh=#False
EndIf
EndIf
ForEach Param\Thumbnails()
If Event = #PB_Event_Gadget And EventGadget() = Param\Thumbnails()\Gadget
If EventType()=#PB_EventType_Focus
Debug "Focus"
EndIf
If EventType()=#PB_EventType_LostFocus
Debug "lost Focus"
EndIf
;Scroll Event
If GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseX)>GadgetWidth(Param\Thumbnails()\Gadget)-25
;Start Scroll
If EventType()=#PB_EventType_LeftButtonDown
If Param\Thumbnails()\CursorStartY=0
Param\Thumbnails()\CursorStartY=GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseY)
Param\Thumbnails()\CursorPosY=Param\Thumbnails()\CursorStartY
Debug "Start Scroll"
EndIf
EndIf
EndIf
;Scroll is Enable
If Param\Thumbnails()\CursorStartY>0
If EventType()=#PB_EventType_MouseMove
Param\Thumbnails()\CursorPosY=GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseY)
EndIf
;Stop Scroll
If EventType() = #PB_EventType_LeftButtonUp
Param\Thumbnails()\CursorStartY=0
Param\Thumbnails()\CursorDeltaY=0
Param\Refresh=#True ;<-Redraw Scroll at origin position
Debug "Stop Scroll"
EndIf
;Thumbnails Event
ElseIf GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseX)<GadgetWidth(Param\Thumbnails()\Gadget)-25
;Change Thumbs Size with MouseWheel
If EventType() = #PB_EventType_MouseWheel
Param\Thumbnails()\Size=Param\Thumbnails()\Size+GetGadgetAttribute(Param\Thumbnails()\Gadget,#PB_Canvas_WheelDelta)*8
Param\Refresh=#True
EndIf
;Select Media
If EventType()=#PB_EventType_LeftClick Or EventType()=#PB_EventType_LeftDoubleClick
GdtWidth=GadgetWidth(Param\Thumbnails()\Gadget)-25
NbH=Int(GdtWidth/Param\Thumbnails()\Size):Param\Thumbnails()\NbH=NbH
NbV=Int(GadgetHeight(Param\Thumbnails()\Gadget)/Param\Thumbnails()\Size):Param\Thumbnails()\NbV=NbV
MarginH=(GdtWidth-NbH*Param\Thumbnails()\Size)/(NbH+1)
MarginV=(GadgetHeight(Param\Thumbnails()\Gadget)-NbV*Param\Thumbnails()\Size)/(NbV+1)
x=GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseX)
y=GetGadgetAttribute(Param\Thumbnails()\Gadget, #PB_Canvas_MouseY)
nx=(x-MarginH)/(Param\Thumbnails()\Size+MarginH)
ny=(y-MarginV-Param\Thumbnails()\ThumbsDeltaY)/(Param\Thumbnails()\Size+MarginV)
Debug Str(nx)+","+Str(ny)
index=Param\Thumbnails()\Index+ny*NbH+nx
;Get
If index>-1 And SelectElement(Param\FileList(),index)<>0
Select EventType()
Case #PB_EventType_LeftClick
Param\FileList()\Selected=1-Param\FileList()\Selected
Debug "Left CLick"
Debug Param\Thumbnails()\CallBackSimpleClick
If Param\Thumbnails()\CallBackSimpleClick<>0 ; check if a @Procedure is added
Debug "@procedure"
Param\Thumbnails()\CallBackSimpleClick(Param\FileList()\FileName,Param\FileList()\Selected)
EndIf
Case #PB_EventType_LeftDoubleClick
Debug "Left Double Click"
If Param\Thumbnails()\CallBackDoubleClick<>0 ; check if a @Procedure is added
Debug "@procedure"
Param\Thumbnails()\CallBackDoubleClick(Param\FileList()\FileName)
EndIf
Param\Thumbnails()\IndexNav=index
EndSelect
EndIf
Param\Refresh=#True
EndIf
EndIf
EndIf
Next
EndProcedure
Procedure NavigateGadget(Id.i,X.l,Y.l,Width.l,Height.l,ThumbnailsId.i)
CanvasGadget(Id.i,X.l,Y.l,Width.l,Height.l)
EndProcedure
Procedure ThumbnailsGadget(GadgetId.i,X.l,Y.l,Width.l,Height.l,Size.l)
Gdt.i=CanvasGadget(GadgetId.i,X.l,Y.l,Width.l,Height.l)
If GadgetId=#PB_Any
GadgetId=Gdt
EndIf
If AddMapElement(Param\Thumbnails(),Str(GadgetId),#PB_Map_ElementCheck)
Param\Thumbnails()\Gadget=GadgetId
Param\Thumbnails()\Size=128
Param\Refresh=#True ;<- First Draw
AddWindowTimer(GetActiveWindow(), 123, 75)
EndIf
EndProcedure
Procedure FreeThumnbailsGadget(GadgetId.i)
If FindMapElement(Param\Thumbnails(),Str(GadgetId))<>0
RemoveWindowTimer(GetActiveWindow(), 123)
FreeGadget(GadgetId)
Else
MessageRequester("Thumbnails Error","GadgetId "+Str(GadgetId)+" not initialized to "+#PB_Compiler_Procedure+"()",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
EndIf
EndProcedure
Procedure AddFileToList(FileName.s)
;Select Data from Id
AddElement(Param\FileList())
Param\FileList()\FileName=FileName
EndProcedure
Procedure ClearTheList()
ClearList(Param\FileList())
EndProcedure
Procedure ForceRefreshThumbnails(ThumbName.s)
If FindMapElement(Param\Thumbnails(),ThumbName)<>0
Param\Refresh=#True
EndIf
EndProcedure
Procedure.i GetTheListSize(ThumbName.s)
Protected n.i
If FindMapElement(Param\Thumbnails(),ThumbName)<>0
LockMutex(Param\FileListMutex)
n=ListSize(Param\FileList())
UnlockMutex(Param\FileListMutex)
EndIf
ProcedureReturn n
EndProcedure
EndModule
;- MAIN TEST
CompilerIf #PB_Compiler_IsMainFile
UseJPEGImageDecoder()
UsePNGImageDecoder()
Enumeration
#Win_main
#Gdt_ThumbA
#Gdt_ThumbB
EndEnumeration
Procedure CallBackDoubleClick(FileName.s)
Debug FileName
EndProcedure
If OpenWindow(#Win_main, 0, 0, 800, 600, "Thumbnails", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
Define Repertoire$
Define Event.i
MagicGdt::ThumbnailsGadget(#Gdt_ThumbA,0,0,800,600,128)
;MagicGdt::ThumbnailsGadget(#Gdt_ThumbB,400,0,400,600,128)
MagicGdt::SetCallBackDoubleClick(#Gdt_ThumbA,@CallBackDoubleClick())
MagicGdt::ClearTheList()
Repertoire$="C:\Users\413\Pictures\"
Repertoire$=PathRequester("Chose Directory", Repertoire$)
If ExamineDirectory(0, Repertoire$, "*.jpg")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
MagicGdt::AddFileToList(Repertoire$+DirectoryEntryName(0))
EndIf
Wend
FinishDirectory(0)
EndIf
Repeat
Delay(1)
Event = WindowEvent()
MagicGdt::EventThumb(Event)
Until Event = #PB_Event_CloseWindow
EndIf
CompilerEndIf