Code : Tout sélectionner
; ********************************************************************
; Program: Thumbnails
; Description: add a Thumbnails to select image
; Version: 6Beta
; Author: Thyphoon
; Date: August, 2021
; License: Free, unrestricted, credit
; appreciated but not required.
; Note: Please share improvement !
; ********************************************************************
CompilerIf #PB_Compiler_Thread=#False
CompilerError("You must enable Compiler threadsafe")
End
CompilerEndIf
CompilerIf Not Defined(Core,#PB_Module)
DeclareModule Core
Structure FileData
FilePath.s
Selected.b
State.b ; 0 No Loaded ; 1 loaded; 2 Displayed
Image.i
;You can Add All You want After
Map MetaData.s()
EndStructure
EndDeclareModule
Module Core
EndModule
CompilerEndIf
DeclareModule ImgTools
Structure DefDisplayImage
X.l
Y.l
Width.l
Height.l
EndStructure
Enumeration
#Image_Style_Fit
#Image_Style_Fill
#Image_Style_Stretch
EndEnumeration
Declare ImageToContainer(*result.DefDisplayImage,Image,ContainerWidth.l,ContainerHeight.l,Style.l=#Image_Style_Fit)
EndDeclareModule
Module ImgTools
Procedure ImageToContainer(*result.DefDisplayImage,Image,ContainerWidth.l,ContainerHeight.l,Style.l=#Image_Style_Fit)
If IsImage(Image)
Protected ImgRatio.l
Protected ContRatio.l
Protected ContWidth.l,ContHeight.l
ImgRatio.l = ImageWidth(Image) / ImageHeight(Image)
ContRatio.l = ContainerWidth /ContainerHeight
Select Style
Case #Image_Style_Fit
If ImgRatio<ContRatio
*result\Width=ImageWidth(Image)*ContainerHeight/ImageHeight(Image)
*result\Height=ContainerHeight
*result\X=(ContainerWidth-*result\Width)/2
*result\Y=0
Else
*result\Width=ContainerWidth
*result\Height=ImageHeight(Image)*ContainerWidth/ImageWidth(Image)
*result\X=0
*result\Y=(ContainerHeight-*result\Height)/2
EndIf
Case #Image_Style_Fill
If ImgRatio<ContRatio
*result\Width=ImageWidth(Image)*ContainerHeight/ImageHeight(Image)
*result\Height=ContainerHeight
*result\X=(ContainerWidth-*result\Width)/2
*result\Y=0
Else
*result\Width=ContainerWidth
*result\Height=ImageHeight(Image)*ContainerWidth/ImageWidth(Image)
*result\X=0
*result\Y=(ContainerHeight-*result\Height)/2
EndIf
Case #Image_Style_Stretch
*result\X=0
*result\Y=0
*result\Width=ContainerWidth
*result\Height=ContainerHeight
EndSelect
EndIf
EndProcedure
EndModule
;-Cache Module
DeclareModule Cache
EnableExplicit
Prototype.i CallBackLoadMedia(*Ptr.Core::FileData)
Structure Param
CallBackLoadMedia.CallBackLoadMedia
;LoadList
LoadListSemaphore.i
LoadListMutex.i
List LoadList.i()
;CacheList
CacheListMutex.i
Map CacheList.Core::FileData()
BackGroundThread.i
;Signal New Image Loaded
SignalMutex.i
Signal.b ;Signal When new image is loaded
;Message
QuitMutex.i
Quit.b
EndStructure
Global Param.Param
Param\LoadListSemaphore=CreateSemaphore(16)
Param\LoadListMutex=CreateMutex()
Param\CacheListMutex=CreateMutex()
param\SignalMutex=CreateMutex()
Param\QuitMutex=CreateMutex()
Declare SetCallBackLoadMedia(CallBackLoadMedia.i)
Declare AddFileToLoadList(FilePath.s)
Declare CacheClean()
Declare AutoLoadStart()
Declare.i GetFileDataFromCache(FilePath.s,Image.i=0)
Declare.b GetSignalAndReset()
Declare Quit()
EndDeclareModule
Module Cache
Procedure SetCallBackLoadMedia(CallBackLoadMedia.i)
Param\CallBackLoadMedia=CallBackLoadMedia
EndProcedure
Procedure AddFileToLoadList(FilePath.s)
Protected *Ptr
LockMutex(param\CacheListMutex)
*Ptr=AddMapElement(param\CacheList(),FilePath)
param\CacheList()\FilePath=FilePath
param\CacheList()\State=0
UnlockMutex(param\CacheListMutex)
LockMutex(Param\LoadListMutex)
AddElement(param\LoadList())
param\LoadList()=*Ptr
UnlockMutex(Param\LoadListMutex)
EndProcedure
Procedure LoadCacheDataThread(*Ptr.core::FileData)
If *Ptr\Image=0 And FileSize(*Ptr\FilePath)>0
Debug "Cache Load:"+*Ptr\FilePath
;Param\CallBackLoadMedia=0 ;To Force to use Internal Loader
If Param\CallBackLoadMedia<>0 ; <- Use extern procedure to Load Image
LockMutex(Param\CacheListMutex)
Param\CallBackLoadMedia(*Ptr)
UnlockMutex(Param\CacheListMutex)
Else
LockMutex(Param\CacheListMutex) ; <- Or intern with PB Plugin
*Ptr\Image=LoadImage(#PB_Any,*Ptr\FilePath)
If IsImage(*Ptr\Image)
Else
*Ptr\Image=0
EndIf
UnlockMutex(Param\CacheListMutex)
EndIf
;Resize Image to Thumnails MaxSize
If IsImage(*Ptr\Image)
Protected result.ImgTools::DefDisplayImage
ImgTools::ImageToContainer(@result,*Ptr\Image,256,256,ImgTools::#Image_Style_Fit)
ResizeImage(*Ptr\Image,result\Width,result\Height,#PB_Image_Smooth)
*Ptr\State=1; Ready to Display Image
;We Have a new Image i Signal it
LockMutex (Param\SignalMutex)
Param\Signal=#True
UnlockMutex (Param\SignalMutex)
;If can't load image
Else
;MessageRequester("Thumbnails Error","ERROR THREAD LOAD IMAGE"+Chr(13)+FilePath+Chr(13)+" in "+#PB_Compiler_Procedure+"()",#PB_MessageRequester_Ok | #PB_MessageRequester_Error)
Debug "ERROR THREAD LOAD IMAGE"+Chr(13)+*Ptr\FilePath
*Ptr\Image=CreateImage(#PB_Any,320,200)
StartDrawing(ImageOutput(*Ptr\Image))
Box(0,0,320,200,RGB(0,255,0))
StopDrawing()
*Ptr\State=1
EndIf
Else
Debug "Cache Load Error:"+*Ptr\FilePath
EndIf
SignalSemaphore(Param\LoadListSemaphore)
EndProcedure
Procedure BackgroundThread(n.l)
Protected Quit.b
Repeat
Repeat
LockMutex(Param\LoadListMutex)
;Select Data from Id
If FirstElement(Param\LoadList())<>0
Protected *Ptr.core::FileData
*Ptr=Param\LoadList()
WaitSemaphore(Param\LoadListSemaphore)
If CreateThread(@LoadCacheDataThread(),*Ptr)<>0
DeleteElement(Param\LoadList())
Else
Debug "######################Can't Start Thread"
End
EndIf
EndIf
UnlockMutex(Param\LoadListMutex)
;Else
; Debug "Wait Semaphore"
; Delay(200)
; EndIf
; Debug "LOADLIST SIZE:"+Str(ListSize(Param\LoadList()))
LockMutex(Param\QuitMutex)
Quit=Param\Quit
UnlockMutex(Param\QuitMutex)
Until ListSize(Param\LoadList())=0 Or Quit=#True
Delay(5)
Until Quit=#True
Debug "Bye Bye ! Cache::BackgroundThread()"
EndProcedure
Procedure Quit()
Debug "QUIT CACHE"
If IsThread(Param\BackGroundThread)
LockMutex(Param\QuitMutex)
Param\Quit=#True
UnlockMutex(Param\QuitMutex)
Debug "Cache::Quit Wait Param\BackGroundThread"
WaitThread(Param\BackGroundThread)
Debug "Cache::Quit Finish"
EndIf
EndProcedure
Procedure AutoLoadStart()
If IsThread(Param\BackGroundThread)=#False
Param\BackGroundThread=CreateThread(@BackgroundThread(),0)
EndIf
EndProcedure
Procedure Free(*Ptr.core::FileData)
LockMutex(Param\CacheListMutex)
If IsImage(*Ptr\Image):FreeImage(*Ptr\Image):EndIf
FreeMap(*Ptr\MetaData())
UnlockMutex(Param\CacheListMutex)
EndProcedure
;TODO remake it
Procedure CacheClean()
Protected *Ptr.core::FileData
LockMutex(Param\CacheListMutex)
ForEach Param\CacheList()
If MapSize(Param\CacheList())<500
Break;
Else
*Ptr=Param\CacheList()
If *Ptr\State=1 And *Ptr\Selected=#False
Debug "Free Cache :"+GetFilePart(*Ptr\FilePath)+" State:"+Str(*Ptr\State)
Free(*Ptr)
DeleteMapElement(Param\CacheList())
EndIf
EndIf
Next
UnlockMutex(Param\CacheListMutex)
EndProcedure
Procedure.i GetFileDataFromCache(FilePath.s,Image.i=0)
LockMutex(Param\CacheListMutex)
Protected *Ptr.core::FileData
*Ptr=FindMapElement(Param\CacheList(),FilePath)
UnlockMutex(Param\CacheListMutex)
If *Ptr=0
;AddToLoadList
LockMutex(Param\CacheListMutex)
*Ptr=AddMapElement(Param\CacheList(),FilePath)
*Ptr\FilePath=FilePath
If Image=0
*Ptr\State=0
*Ptr\Image=0
Else ;If We have Image (Ex when use Blob in DB)
*Ptr\State=1
*Ptr\Image=Image
EndIf
UnlockMutex(Param\CacheListMutex)
LockMutex(Param\LoadListMutex)
AddElement(param\LoadList())
Param\LoadList()=*Ptr
UnlockMutex(Param\LoadListMutex)
AutoLoadStart()
EndIf
ProcedureReturn *Ptr
EndProcedure
Procedure.b GetSignalAndReset()
Protected Signal.b
LockMutex (Param\SignalMutex)
Signal=Param\Signal
Param\Signal=#False
UnlockMutex (Param\SignalMutex)
ProcedureReturn Signal
EndProcedure
EndModule
;-Thumbs
DeclareModule Thumbs
Declare SetCallBackLoadFromIndex(GadgetId.i,CallBackLoadFromIndex.i)
Declare AddImageToThumb(GadgetId.i,Index.i,*Ptr)
Declare LimitIndex(GadgetId.i,IndexMax.i=-1)
Declare ThumbsGadget(GadgetId.i,X.l,Y.l,Width.l,Height.l,Size.l,CallBack.i=0)
Declare FreeThumbsGadget(GadgetId.i)
Declare ForceUpdate(GadgetId.i)
EndDeclareModule
Module Thumbs
EnableExplicit
Prototype CallBackLoadFromIndex(GadgetId.i,Index.i,Lenght.l)
Structure Gdt
GadgetId.i ;Canvas Gadget number
Size.l ;Thumb Size Width and Height
Index.i ;ThumbIndex
OldIndex.i ;Last Index to Clean
IndexMax.i ; -1 infinity else Maximum index to limit scroll
NbH.l ;Number of horizontal thumbnails
NbV.l ;Number of Vertical thumbnails
;Scroll
StartScroll.b ;#True if click or #False
CursorStartY.l
CursorDeltaY.l
ThumbsDeltaY.l
ZoneClick.l ;1 ScrollBar 2;Thumbs
;DPI Aware Value
_GadgetWidth.l
_GadgetHeight.l
_Size.l
_ScrollWidth.l
_ScrollHeight.l
_ThumbsWidth.l
_ThumbsHeight.l
_MarginH.l
_MarginV.l
ThumbPointerlistMutex.i
Map ThumbPointerList.i()
LoadFromIndexInitialized.b ;#True CallBack is Ok # Else not initialized (See SetCallBackLoadFromindex() )
CallBackLoadFromIndex.CallBackLoadFromIndex
Quit.b
ThreadDrawCanvasImage.i
EndStructure
Structure param
Map Gdt.Gdt()
DrawAlphaImageMutex.i
EndStructure
Global param.param
param\DrawAlphaImageMutex=CreateMutex()
Procedure InitGadgetValue(GadgetId.i)
Protected *Gdt.Gdt
*Gdt=GetGadgetData(GadgetId)
*Gdt\_GadgetWidth=DesktopScaledX(GadgetWidth(GadgetId))
*Gdt\_GadgetHeight=DesktopScaledY(GadgetHeight(GadgetId))
*Gdt\_Size=DesktopScaledX(*Gdt\Size)
*Gdt\_ScrollWidth=DesktopScaledX(25)
*Gdt\_ScrollHeight=*Gdt\_ScrollWidth*2
*Gdt\_ThumbsWidth.l=*Gdt\_GadgetWidth-*Gdt\_ScrollWidth
*Gdt\_ThumbsHeight.l=*Gdt\_GadgetHeight
*Gdt\NbH.l=Int(*Gdt\_ThumbsWidth/*Gdt\_Size)
*Gdt\NbV.l=Int(*Gdt\_GadgetHeight/*Gdt\_Size)
*Gdt\_MarginH.l=(*Gdt\_ThumbsWidth-*Gdt\NbH**Gdt\_Size)/(*Gdt\NbH+1)
*Gdt\_MarginV.l=(*Gdt\_GadgetHeight-*Gdt\NbV**Gdt\_Size)/(*Gdt\NbV+1)
EndProcedure
Procedure AddImageToThumb(GadgetId.i,Index.i,*Ptr.core::FileData)
If *Ptr>0
Debug "Add "+Str(Index)+" "+GetFilePart(*Ptr\FilePath)
Else
Debug "Add "+Str(Index)+" - - - "
EndIf
Protected *Gdt.gdt
*Gdt=GetGadgetData(GadgetId)
LockMutex(*Gdt\ThumbPointerlistMutex)
AddMapElement(*Gdt\ThumbPointerlist(),Str(Index))
*Gdt\ThumbPointerlist()=*Ptr
UnlockMutex(*Gdt\ThumbPointerlistMutex)
EndProcedure
Procedure LoadFromIndex(GadgetId.i)
Protected *Gdt.gdt
Protected *Ptr.core::FileData
*Gdt=GetGadgetData(GadgetId)
If *Gdt\LoadFromIndexInitialized=#True
Protected Index.i=*Gdt\Index-*Gdt\Nbh
Protected NThumbs.l=(*Gdt\NbV+2)**Gdt\Nbh ;Number of Thumbs must be Loaded
;-Clean index
LockMutex(*Gdt\ThumbPointerlistMutex)
Protected.l DeltaIndex=Index-*Gdt\OldIndex
*Gdt\OldIndex=Index
Protected n.l
For n=0 To Abs(DeltaIndex)
If DeltaIndex>0
If FindMapElement(*Gdt\ThumbPointerList(),Str(*Gdt\OldIndex+DeltaIndex))
DeleteMapElement(*Gdt\ThumbPointerList())
EndIf
ElseIf DeltaIndex<0
If FindMapElement(*Gdt\ThumbPointerList(),Str(*Gdt\OldIndex+NThumbs-DeltaIndex))
DeleteMapElement(*Gdt\ThumbPointerList())
EndIf
EndIf
Next
UnlockMutex(*Gdt\ThumbPointerlistMutex)
;-Load new File on Index
If *Gdt\CallBackLoadFromIndex>0
*Gdt\CallBackLoadFromIndex(*Gdt\GadgetId,Index+DeltaIndex,NThumbs-DeltaIndex)
Debug "param\CallBackLoadFromIndex("+Str(Index)+","+Str(NThumbs)+")"
Else
Delay(10)
Debug "No Set CallBackLoadFromIndex"
EndIf
Cache::AutoLoadStart()
EndIf
EndProcedure
Procedure LimitIndex(GadgetId.i,IndexMax.i=-1)
Protected *Gdt.gdt
*Gdt=GetGadgetData(GadgetId)
If IndexMax>=0
*Gdt=GetGadgetData(GadgetId)
IndexMax=Round((IndexMax/*Gdt\NbH),#PB_Round_Up)**Gdt\NbH -(*Gdt\NbH*(*Gdt\NbV))
*Gdt\IndexMax=IndexMax
If *Gdt\IndexMax<0
*Gdt\IndexMax=0
EndIf
Debug "IndexMax:"+Str(*Gdt\IndexMax)
ElseIf IndexMax=-1
*Gdt\IndexMax=-1
EndIf
EndProcedure
Procedure DrawCanvasImage(GadgetId.i)
Protected *Gdt.gdt
Protected CursorY.l
*Gdt=GetGadgetData(GadgetId)
Repeat
If *Gdt\StartScroll=#True
*Gdt\ThumbsDeltaY=*Gdt\ThumbsDeltaY+(*Gdt\CursorDeltaY/10)
EndIf
CursorY=*Gdt\_GadgetHeight/2-*Gdt\_ScrollHeight-*Gdt\CursorDeltaY
;Limit Cursor Up
If CursorY<0
CursorY=0
*Gdt\ThumbsDeltaY=*Gdt\_Size ;<-Fast Mode
EndIf
;Limit Cursor Down
If CursorY>*Gdt\_GadgetHeight-*Gdt\_ScrollHeight
CursorY=*Gdt\_GadgetHeight-*Gdt\_ScrollHeight
*Gdt\ThumbsDeltaY=-*Gdt\_Size ;<-Fast Mode
EndIf
Protected DeltaIndex.l
If *Gdt\ThumbsDeltaY>=*Gdt\_Size
DeltaIndex=Int(*Gdt\ThumbsDeltaY/*Gdt\_Size)* *Gdt\NbH
*Gdt\Index=*Gdt\Index-DeltaIndex
*Gdt\ThumbsDeltaY=*Gdt\ThumbsDeltaY%*Gdt\_Size
CreateThread(@LoadFromIndex(),GadgetId)
EndIf
If *Gdt\ThumbsDeltaY<=-*Gdt\_Size
DeltaIndex=Abs(Int(*Gdt\ThumbsDeltaY/*Gdt\_Size)* *Gdt\NbH)
*Gdt\Index=*Gdt\Index+DeltaIndex
*Gdt\ThumbsDeltaY=*Gdt\ThumbsDeltaY%*Gdt\_Size
CreateThread(@LoadFromIndex(),GadgetId)
EndIf
;Limit Scroll
If *Gdt\Index<=0
*Gdt\Index=0
If *Gdt\ThumbsDeltaY>0:*Gdt\ThumbsDeltaY=0:EndIf
EndIf
If *Gdt\IndexMax>-1
If *Gdt\Index>=*Gdt\IndexMax
*Gdt\Index=*Gdt\IndexMax
If *Gdt\ThumbsDeltaY<0:*Gdt\ThumbsDeltaY=0:EndIf
EndIf
EndIf
Protected *Ptr.core::FileData
Protected State.l
Protected Image.i
Protected Selected.b
Protected FileName.s
;LockMutex(param\DrawAlphaImageMutex)
If StartVectorDrawing(CanvasVectorOutput(*Gdt\GadgetId))
VectorSourceColor(RGBA(128, 128, 128, 255))
FillVectorOutput()
Protected ListIndex.l=-1
Protected.l nx,ny,x,y
Protected i.i
For ny=-1 To *Gdt\NbV+1
For nx=0 To *Gdt\NbH-1
ListIndex=ListIndex+1
;Position
x=nx * *Gdt\_Size+ *Gdt\_MarginH * nx + ( *Gdt\_MarginH )
y=ny * *Gdt\_Size+ *Gdt\_MarginV * ny + ( *Gdt\_MarginV ) + *Gdt\ThumbsDeltaY
i=nx+ny* *Gdt\NbH + *Gdt\Index
AddPathBox(x, y,*Gdt\_Size,*Gdt\_Size)
VectorSourceColor(RGBA(100, 100, 100, 255))
FillPath()
Selected=0
State=0
Image=-1
FileName=""
LockMutex(*Gdt\ThumbPointerlistMutex)
If FindMapElement(*Gdt\ThumbPointerList(),Str(i))
*Ptr=*Gdt\ThumbPointerList()
Else
*Ptr=0
EndIf
UnlockMutex(*Gdt\ThumbPointerlistMutex)
If *Ptr>0
If *Ptr\State>0 And IsImage(*Ptr\Image) ;If Image loaded
*Ptr\State=2 ; 0 No Loaded ; 1 loaded; 2 Displayed
State=2
Image.i=*Ptr\Image
Selected=*Ptr\Selected
FileName.s=GetFilePart(*Ptr\FilePath)
Protected result.ImgTools::DefDisplayImage
ImgTools::ImageToContainer(@result,Image,*Gdt\_Size,*Gdt\_Size,ImgTools::#Image_Style_Fit)
;If element selected display green
Protected _Border.l,_BorderX2.l
;Draw Green Border when selected
If Selected=1
AddPathBox(result\X+x, result\Y+y,result\Width,result\Height)
VectorSourceColor(RGBA(0, 255, 0, 255))
FillPath()
_Border=DesktopScaledX(2)
_BorderX2=_Border*2
Else
_Border=0
_BorderX2=0
EndIf
;Draw Image
AddPathBox(result\X+x+_Border, result\Y+y+_Border,result\Width-_BorderX2,result\Height-_BorderX2)
VectorSourceColor(RGBA(0, 0, 0, 255))
FillPath()
MovePathCursor(result\X+x+_Border,result\Y+y+_Border)
DrawVectorImage(ImageID(Image),255,result\Width-_BorderX2,result\Height-_BorderX2)
Else ;If Image no Loaded
;AddPathBox(result\X+x, result\Y+y,result\Width,result\Height)
;VectorSourceColor(RGBA(255, 255, 0, 255))
;FillPath()
EndIf
;If *Ptr=0 No Image
Else
;AddPathBox(result\X+x, result\Y+y,result\Width,result\Height)
;VectorSourceColor(RGBA(0, 255, 255, 128))
;FillPath()
EndIf
VectorSourceColor(RGBA(255, 255, 255, 255))
MovePathCursor(x+5,y+5)
DrawVectorText(Str(i)+" "+Filename)
Next
Next
;ScrollBar
AddPathBox(*Gdt\_ThumbsWidth,0,*Gdt\_ScrollWidth,*Gdt\_GadgetHeight):VectorSourceColor(RGBA(100, 100, 100, 255)):FillPath()
AddPathBox(*Gdt\_ThumbsWidth,CursorY,*Gdt\_ScrollWidth,*Gdt\_ScrollHeight):VectorSourceColor(RGBA(200, 200, 200, 255)):FillPath()
StopVectorDrawing()
;UnlockMutex(param\DrawAlphaImageMutex)
EndIf
Delay(50)
Until *Gdt\Quit=#True
Debug "DrawCanvasImage "+Str(*Gdt\GadgetId)+" Say Bye Bye !"
EndProcedure
Procedure ThumbsEvent()
Protected *Gdt.gdt
*Gdt=GetGadgetData(EventGadget())
Protected.l Mx,My
Mx=GetGadgetAttribute(*Gdt\GadgetId, #PB_Canvas_MouseX)
My=GetGadgetAttribute(*Gdt\GadgetId, #PB_Canvas_MouseY)
Select EventType()
Case #PB_EventType_KeyDown
Select GetGadgetAttribute(*Gdt\GadgetId,#PB_Canvas_Key)
Case #PB_Shortcut_Down
If *Gdt\Index<*Gdt\IndexMax
*Gdt\ThumbsDeltaY=*Gdt\ThumbsDeltaY-DesktopScaledY(5)
EndIf
Case #PB_Shortcut_Up
If *Gdt\Index>0
*Gdt\ThumbsDeltaY=*Gdt\ThumbsDeltaY+DesktopScaledY(5)
EndIf
Case #PB_Shortcut_PageDown
If *Gdt\Index<*Gdt\IndexMax
*Gdt\ThumbsDeltaY=0
*Gdt\Index=*Gdt\Index+*Gdt\NbH
CreateThread(@LoadFromIndex(),*Gdt\GadgetId)
EndIf
Case #PB_Shortcut_PageUp
If *Gdt\Index>0
*Gdt\ThumbsDeltaY=0
*Gdt\Index=*Gdt\Index-*Gdt\NbH
CreateThread(@LoadFromIndex(),*Gdt\GadgetId)
EndIf
EndSelect
Case #PB_EventType_Resize
InitGadgetValue(*Gdt\GadgetId)
CreateThread(@LoadFromIndex(),*Gdt\GadgetId)
Case #PB_EventType_LostFocus
*Gdt\StartScroll=#False
*Gdt\CursorDeltaY=0
Case #PB_EventType_MouseMove
;Icon dans la zone
If Mx>*Gdt\_ThumbsWidth
SetGadgetAttribute(*Gdt\GadgetId,#PB_Canvas_Cursor,#PB_Cursor_UpDown)
Else
SetGadgetAttribute(*Gdt\GadgetId,#PB_Canvas_Cursor,#PB_Cursor_Default)
EndIf
If *Gdt\StartScroll=#True
;If GetGadgetAttribute(*Gdt\GadgetId, #PB_Canvas_MouseY)<>0 ;PB Bug ? sometime return 0
*Gdt\CursorDeltaY=*Gdt\CursorStartY-GetGadgetAttribute(*Gdt\GadgetId, #PB_Canvas_MouseY)
;EndIf
EndIf
Case #PB_EventType_LeftButtonDown
;scroll Bar Event
If Mx>*Gdt\_ThumbsWidth
*Gdt\ZoneClick=1 ; You click in Scroll Zone
If *Gdt\StartScroll=#False
*Gdt\CursorStartY=My
*Gdt\StartScroll=#True
Debug "Start Scroll"+Str(My)
EndIf
Else
*Gdt\ZoneClick=2 ; You Click in Thumbs Zone
EndIf
Case #PB_EventType_LeftButtonUp
;Stop Scroll
If *Gdt\StartScroll=#True
*Gdt\CursorStartY=0
*Gdt\StartScroll=#False
*Gdt\CursorDeltaY=0
Debug "Stop Scroll"
EndIf
;Thumbs
Case #PB_EventType_LeftClick
;Select Image
If *Gdt\ZoneClick=2 And *Gdt\StartScroll=#False
Protected *Ptr.core::FileData
Protected nx.l=(mx-*Gdt\_MarginH)/(*Gdt\_Size+*Gdt\_MarginH)
Protected ny.l=(my-*Gdt\_MarginV-*Gdt\ThumbsDeltaY)/(*Gdt\_Size+*Gdt\_MarginV)
Protected index.l=nx+ny**Gdt\NbH
index=*Gdt\Index+index
LockMutex(*Gdt\ThumbPointerlistMutex)
FindMapElement(*Gdt\ThumbPointerList(),Str(index))
*Ptr=*Gdt\ThumbPointerList()
*Ptr\Selected=1-*Ptr\Selected
UnlockMutex(*Gdt\ThumbPointerlistMutex)
EndIf
EndSelect
EndProcedure
Procedure SetCallBackLoadFromIndex(GadgetId.i,CallBackLoadFromIndex.i)
If IsGadget(GadgetId) And GadgetType(GadgetId)=#PB_GadgetType_Canvas
Protected *Gdt.gdt
*Gdt=GetGadgetData(GadgetId)
*Gdt\CallBackLoadFromIndex=CallBackLoadFromIndex
*Gdt\LoadFromIndexInitialized=#True
Else
Debug "Gadget "+Str(GadgetId)+" Not Initialized Or Wrong Type Thumbs::SetCallBackLoadFromIndex()"
EndIf
EndProcedure
Procedure ThumbsGadget(GadgetId.i,X.l,Y.l,Width.l,Height.l,Size.l,CallBack.i=0)
Protected newGadgetId.i
newGadgetId=CanvasGadget(GadgetId.i,X.l,Y.l,Width.l,Height.l,#PB_Canvas_Keyboard|#PB_Canvas_DrawFocus|#PB_Canvas_Border)
If GadgetId=#PB_Any
GadgetId=newGadgetId
EndIf
Protected *Gdt.Gdt
*Gdt=AddMapElement(param\Gdt(),Str(GadgetId))
Debug *Gdt
If *Gdt
*Gdt\ThumbPointerlistMutex=CreateMutex()
*Gdt\GadgetId=GadgetId
*Gdt\Size=Size
Debug *Gdt\Size
SetGadgetData(GadgetId, *Gdt)
InitGadgetValue(GadgetId)
If CallBack
SetCallBackLoadFromIndex(GadgetId,CallBack)
CreateThread(@LoadFromIndex(),GadgetId)
EndIf
;DrawCanvasImage(GadgetId)
*Gdt\ThreadDrawCanvasImage=CreateThread(@DrawCanvasImage(),GadgetId)
BindGadgetEvent(GadgetId,@ThumbsEvent(),#PB_All)
Else
Debug "Error to Init ThumbsGadget"
EndIf
EndProcedure
Procedure FreeThumbsGadget(GadgetId.i)
Protected *Gdt.gdt
If IsGadget(GadgetID)
*Gdt=GetGadgetData(GadgetId)
*Gdt\Quit=#True
WaitThread(*Gdt\ThreadDrawCanvasImage)
FreeMutex(*Gdt\ThumbPointerListMutex)
FreeMap(*Gdt\ThumbPointerList())
DeleteMapElement(param\Gdt(),Str(GadgetId))
EndIf
EndProcedure
; Procedure RemoveThumbPointerList(GadgetId.i,Index.i,Number.i)
; Protected *Gdt.gdt
; Protected *Ptr.core::FileData
; Protected n.l
; *Gdt=GetGadgetData(GadgetId)
; LockMutex(*Gdt\ThumbPointerMutex)
; For n=0 To Number
; If SelectElement(*Gdt\ThumbPointerList(),Index)
; *Ptr=*Gdt\ThumbPointer()
; If *Ptr>0
; If *Ptr\State=2:*Ptr\State=1:EndIf
; EndIf
; DeleteElement(*Gdt\ThumbPointerList())
; EndIf
; Next
; LockMutex(*Gdt\ThumbPointerMutex)
; EndProcedure
Procedure ForceUpdate(GadgetId.i)
Protected *Gdt.gdt
Protected *Ptr.core::FileData
*Gdt=GetGadgetData(GadgetId)
*Gdt\Index=0
LockMutex(*Gdt\ThumbPointerlistMutex)
ForEach *Gdt\ThumbPointerList()
*Ptr=*Gdt\ThumbPointerList()
If *Ptr>0
If *Ptr\State=2:*Ptr\State=1:EndIf ;Image not Display
EndIf
DeleteMapElement(*Gdt\ThumbPointerList())
Next
UnlockMutex(*Gdt\ThumbPointerlistMutex)
LoadFromIndex(GadgetId)
EndProcedure
EndModule
;- TEST PART
CompilerIf #PB_Compiler_IsMainFile
UseJPEGImageDecoder()
UsePNGImageDecoder()
UseMD5Fingerprint()
Global NewList CurrentList.s()
Procedure CallBackLoadFromIndexB(GadgetId.i,Index.i,Lenght.l)
Protected n.l
Protected TmpIndex.i
Protected relativeIndex.l
Debug "CallBackLoadFromIndexB("+Str(Index)+","+Str(Lenght)+")"
For n=1 To Lenght
TmpIndex=Index+n-1
If TmpIndex>=0 And TmpIndex<ListSize(CurrentList())
SelectElement(CurrentList(),TmpIndex)
relativeIndex=relativeIndex+1
Protected *Ptr.Core::FileData
*Ptr=Cache::GetFileDataFromCache(CurrentList())
If *Ptr
Thumbs::AddImageToThumb(GadgetId,TmpIndex,*Ptr)
Else
Thumbs::AddImageToThumb(GadgetId,TmpIndex,0)
EndIf
Else
Thumbs::AddImageToThumb(GadgetId,TmpIndex,-1)
EndIf
Next
Thumbs::LimitIndex(GadgetId,ListSize(CurrentList()))
EndProcedure
Define Repertoire$
Define Event.i
Repertoire$="C:\Users\413\Pictures\Photos\"
Repertoire$=PathRequester("Chose Directory", Repertoire$)
If ExamineDirectory(0, Repertoire$, "*.jpg")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
AddElement(CurrentList())
CurrentList()=Repertoire$+DirectoryEntryName(0)
EndIf
Wend
FinishDirectory(0)
EndIf
Enumeration
#Win_main
#Gdt_Nav
#Gdt_Folder
#Gdt_ThumbA
#Gdt_ThumbB
EndEnumeration
If OpenWindow(#Win_main, 0, 0, 1024, 600, "Thumbnails", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_SizeGadget)
ButtonGadget(#Gdt_Folder,0,0,100,25,"Choose Folder")
Thumbs::ThumbsGadget(#Gdt_ThumbA,0,50,WindowWidth(#Win_main),WindowHeight(#Win_main)-50,128,@CallBackLoadFromIndexB())
Repeat
Delay(1)
Event = WaitWindowEvent()
If Event=#PB_Event_Gadget
If EventGadget()=#Gdt_Folder
Repertoire$="C:\Users\413\Pictures\Photos\"
Repertoire$=PathRequester("Chose Directory", Repertoire$)
If Repertoire$<>""
ClearList(CurrentList())
If ExamineDirectory(0, Repertoire$, "*.jpg")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
AddElement(CurrentList())
CurrentList()=Repertoire$+DirectoryEntryName(0)
EndIf
Wend
FinishDirectory(0)
Debug "LISTSIZE="+Str(ListSize(CurrentList()))
Thumbs::LimitIndex(#Gdt_ThumbA,ListSize(CurrentList()))
Thumbs::ForceUpdate(#Gdt_ThumbA)
EndIf
EndIf
EndIf
EndIf
If Event=#PB_Event_SizeWindow
Debug "coucou"
ResizeGadget(#Gdt_ThumbA,0,50,WindowWidth(#Win_main),WindowHeight(#Win_main)-50)
EndIf
Until Event = #PB_Event_CloseWindow
Thumbs::FreeThumbsGadget(#Gdt_ThumbA)
EndIf
CompilerEndIf