Custom Image list browser gadget
Posted: Sun Sep 14, 2014 2:01 pm
Code: Select all
;Remake..Still missing scrollbars
UseJPEGImageDecoder()
UseJPEGImageEncoder()
UsePNGImageDecoder()
UsePNGImageEncoder()
UseTGAImageDecoder()
UseTIFFImageDecoder()
Enumeration
#TH_CAN_DETAILS
#TH_CAN_MEDIUM
#TH_CAN_LARGE
#TH_CAN_OVERSIZE
EndEnumeration
Global MyCan.i, DisplayObject.i
DeclareModule _iList
Enumeration
#TH_CAN_DETAILS
#TH_CAN_MEDIUM
#TH_CAN_LARGE
#TH_CAN_OVERSIZE
EndEnumeration
Declare.i AssignCanvas(WindowIdNum.i, CanX.i, CanY.i, CanWidth.i, CanHeight.i)
Declare InitDefaults()
Declare.i DisplayItemByIndexToObject(Index.i, Object.i)
Declare.i DisplayItemByPositionToObject(posy.i, Object.i)
Declare SetBackgroundColor(Color.i)
Declare.i GetBackgroundColor()
Declare SetTextColor(Color.i)
Declare.i GetTextColor()
Declare SetTextFont(fn.i)
Declare.i GetTextFont()
Declare SetDisplayMode(disp.i = #TH_CAN_DETAILS)
Declare.i GetDisplayMode()
Declare SetFrameColor(Color.i)
Declare.i GetFrameColor()
Declare SetBackgroundImage(Image.i)
Declare.i GetBackgroundImage()
Declare.i ScrollCanvas(Direct.i = 0) ; Zero only updates
Declare SetSelectedItemByPosition(posy.i)
Declare SetSelectedItemByIndex(index.i, enab.i = #False)
Declare.i IsItemSelected(Index.i)
Declare.s GetFullPath(index)
Declare.s GetFilename(index)
Declare.s GetFullPathByPosition(posy.i)
Declare.s GetFilenameByPosition(posy.i)
Declare.i SetSelectionToAll(enab.i = #True)
Declare.i GetCount()
Declare SetPath(path.s = "C:\")
Declare.s GetPath()
EndDeclareModule
Module _iList
Structure _FileData
Filename.s
Filesize.i
DateCreated.s
DateAccessed.s
DateModified.s
DefaultImage.i
selected.i
PosY.i
EndStructure
Structure _CanvData
DisplayMode.i
BackgroundColor.i
BackgroundImage.i
TextColor.i
FrameColor.i
Font.i
EndStructure
Declare.s Slash(Fname.s)
Declare.i UpdateCanvas()
Global cPath.s = "C:\"
Global can.i
Global cd._CanvData
Global NewList fl._FileData()
Procedure.i AssignCanvas(WindowIdNum.i, CanX.i, CanY.i, CanWidth.i, CanHeight.i)
can = -1
If IsWindow(WindowIdNum)
UseGadgetList(WindowIdNum)
can = CanvasGadget(#PB_Any, CanX, CanY, CanWidth, CanHeight, #PB_Canvas_Border|#PB_Canvas_Keyboard)
EndIf
ProcedureReturn can
EndProcedure
Procedure SetBackgroundColor(Color.i)
cd\BackgroundColor = Color
EndProcedure
Procedure.i GetBackgroundColor()
ProcedureReturn cd\BackgroundColor
EndProcedure
Procedure SetTextColor(Color.i)
cd\TextColor = Color
EndProcedure
Procedure.i GetTextColor()
ProcedureReturn cd\TextColor
EndProcedure
Procedure SetDisplayMode(disp.i = #TH_CAN_DETAILS)
cd\DisplayMode = disp
EndProcedure
Procedure.i GetDisplayMode()
ProcedureReturn cd\DisplayMode
EndProcedure
Procedure SetFrameColor(Color.i)
cd\FrameColor = Color
EndProcedure
Procedure.i GetFrameColor()
ProcedureReturn cd\FrameColor
EndProcedure
Procedure SetBackgroundImage(Image.i)
cd\BackgroundImage = Image
EndProcedure
Procedure.i GetBackgroundImage()
ProcedureReturn cd\BackgroundImage
EndProcedure
Procedure.s Slash(Fname.s)
Protected tm.s
If Right(Fname,1) <> "\"
ProcedureReturn Fname + "\"
Else
ProcedureReturn Fname
EndIf
EndProcedure
Procedure SetPath(path.s = "C:\")
Protected tmp.s, tm_img.i
SetGadgetAttribute(can, #PB_Canvas_Cursor , #PB_Cursor_Busy)
cPath = Slash(path)
ForEach fl()
If IsImage(fl()\DefaultImage)
FreeImage(fl()\DefaultImage)
EndIf
Next
ClearList(fl())
dir=ExamineDirectory(#PB_Any, cPath, "*")
If dir
While NextDirectoryEntry(dir)
Filename.s = DirectoryEntryName(dir)
If DirectoryEntryType(dir) = #PB_DirectoryEntry_File And Filename <> "." And Filename <> ".."
tmp = LCase(GetExtensionPart(Filename))
Select tmp
Case "bmp","jpg", "png", "tif", "tga"
AddElement(fl())
fl()\Filename = Filename
fl()\Filesize = FileSize(Slash(Path) + Filename)
fl()\DateAccessed = FormatDate("%mm/%dd/%yyyy", GetFileDate(cPath + Filename, #PB_Date_Accessed))
fl()\DateCreated = FormatDate("%mm/%dd/%yyyy", GetFileDate(cPath + Filename, #PB_Date_Created))
fl()\DateModified = FormatDate("%mm/%dd/%yyyy", GetFileDate(cPath + Filename, #PB_Date_Modified))
tm_img = LoadImage(#PB_Any, cPath + Filename)
If IsImage(tm_img)
fl()\DefaultImage = CreateImage(#PB_Any,64,64)
StartDrawing(ImageOutput(fl()\DefaultImage))
DrawImage(ImageID(tm_img), 0, 0, 64, 64) ;base for 16, 32, 48 and 64
StopDrawing()
FreeImage(tm_img)
EndIf
fl()\selected = #False
Default ;For anything else
EndSelect
EndIf
Wend
FinishDirectory(dir)
If ListSize(fl()) > 0
SortStructuredList(fl(),#PB_Sort_Ascending, OffsetOf(_FileData\Filename), #PB_String)
EndIf
EndIf
UpdateCanvas()
SetGadgetAttribute(can, #PB_Canvas_Cursor , #PB_Cursor_Default)
EndProcedure
Procedure.s GetPath()
ProcedureReturn cPath
EndProcedure
Procedure SetTextFont(fn.i)
cd\Font = fn
EndProcedure
Procedure.i GetTextFont()
ProcedureReturn cd\Font
EndProcedure
Procedure InitDefaults()
Protected tmpfont.i
SetBackgroundColor($222222)
SetTextColor($BBBBBB)
SetDisplayMode(#TH_CAN_DETAILS)
SetFrameColor($777777)
SetTextFont(LoadFont(#PB_Any, "Arial",8,#PB_Font_Bold))
;Scroll the sucker
StartDrawing(CanvasOutput(can))
DrawingFont(FontID(cd\Font))
;Background
Box(0,0,GadgetWidth(can), GadgetHeight(can), cd\BackgroundColor)
StopDrawing()
EndProcedure
Procedure.i DisplayItemByIndexToObject(Index.i, Object.i)
Protected tmpimg.i
SelectElement(fl(),Index)
tmpimg = LoadImage(#PB_Any, Slash(cPath)+ fl()\Filename)
If IsWindow(Object) > 0
StartDrawing(WindowOutput(Object))
DrawImage(ImageID(tmpimg), 0, 0, WindowWidth(Object), WindowHeight(Object))
StopDrawing()
ElseIf IsGadget(Object) > 0
Select GadgetType(Object)
Case #PB_GadgetType_ButtonImage
SetGadgetAttribute(Object, #PB_Button_Image, ImageID(tmpimg))
Case #PB_GadgetType_Canvas
StartDrawing(CanvasOutput(Object))
DrawImage(ImageID(tmpimg), 0, 0, GadgetWidth(Object), GadgetHeight(Object))
StopDrawing()
Case #PB_GadgetType_Image
SetGadgetState(Object, ImageID(tmpimg))
EndSelect
EndIf
EndProcedure
Procedure.i DisplayItemByPositionToObject(posy.i, Object.i)
Protected tmpimg.i, Index.i = -1
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If posy > fl()\PosY And posy < fl()\PosY + 16
Index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_MEDIUM
If posy > fl()\PosY And posy < fl()\PosY + 24
Index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_LARGE
If posy > fl()\PosY And posy < fl()\PosY + 48
Index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_OVERSIZE
If posy > fl()\PosY And posy < fl()\PosY + 64
Index = ListIndex(fl())
Break
EndIf
EndSelect
Next
If Index = -1
ProcedureReturn -1
EndIf
SelectElement(fl(),Index)
tmpimg = LoadImage(#PB_Any, Slash(cPath)+ fl()\Filename)
If IsWindow(Object) > 0
StartDrawing(WindowOutput(Object))
DrawImage(ImageID(tmpimg), 0, 0, WindowWidth(Object), WindowHeight(Object))
StopDrawing()
ElseIf IsGadget(Object) > 0
Select GadgetType(Object)
Case #PB_GadgetType_ButtonImage
SetGadgetAttribute(Object, #PB_Button_Image, ImageID(tmpimg))
Case #PB_GadgetType_Canvas
StartDrawing(CanvasOutput(Object))
DrawImage(ImageID(tmpimg), 0, 0, GadgetWidth(Object), GadgetHeight(Object))
StopDrawing()
Case #PB_GadgetType_Image
SetGadgetState(Object, ImageID(tmpimg))
EndSelect
EndIf
EndProcedure
Procedure SetSelectedItemByPosition(posy.i)
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If posy > fl()\PosY And posy < fl()\PosY + 16
If fl()\selected = #False
fl()\selected = #True
Else
fl()\selected = #False
EndIf
Break
EndIf
Case #TH_CAN_MEDIUM
If posy > fl()\PosY And posy < fl()\PosY + 24
If fl()\selected = #False
fl()\selected = #True
Else
fl()\selected = #False
EndIf
Break
EndIf
Case #TH_CAN_LARGE
If posy > fl()\PosY And posy < fl()\PosY + 48
If fl()\selected = #False
fl()\selected = #True
Else
fl()\selected = #False
EndIf
Break
EndIf
Case #TH_CAN_OVERSIZE
If posy > fl()\PosY And posy < fl()\PosY + 64
If fl()\selected = #False
fl()\selected = #True
Else
fl()\selected = #False
EndIf
Break
EndIf
EndSelect
Next
ScrollCanvas(0)
EndProcedure
Procedure.i GetSelectedItemByPosition(Posy.i)
Protected index.i = -1
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If posy > fl()\PosY And posy < fl()\PosY + 16
index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_MEDIUM
If posy > fl()\PosY And posy < fl()\PosY + 24
index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_LARGE
If posy > fl()\PosY And posy < fl()\PosY + 48
index = ListIndex(fl())
Break
EndIf
Case #TH_CAN_OVERSIZE
If posy > fl()\PosY And posy < fl()\PosY + 64
index = ListIndex(fl())
Break
EndIf
EndSelect
Next
ProcedureReturn index
EndProcedure
Procedure SetSelectedItemByIndex(index.i, enab.i = #False)
SelectElement(fl(),index)
fl()\selected = enab
EndProcedure
Procedure.i IsItemSelected(Index.i)
SelectElement(fl(),Index)
ProcedureReturn fl()\selected
EndProcedure
Procedure.i SetSelectionToAll(enab.i = #True)
ForEach fl()
fl()\selected = enab
Next
ScrollCanvas(0)
EndProcedure
Procedure.i GetCount()
ProcedureReturn ListSize(fl())
EndProcedure
Procedure.i ScrollCanvas(Direct.i = 0) ; Zero only updates
If ListSize(fl()) = 0
ProcedureReturn 0
EndIf
FirstElement(fl())
If Direct = 1 And fl()\PosY >= 0
ProcedureReturn 0
EndIf
LastElement(fl())
If Direct = -1
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If fl()\PosY + 16 <= GadgetHeight(can)
ProcedureReturn 0
EndIf
Case #TH_CAN_MEDIUM
If fl()\PosY + 24 <= GadgetHeight(can)
ProcedureReturn 0
EndIf
Case #TH_CAN_LARGE
If fl()\PosY + 48 <= GadgetHeight(can)
ProcedureReturn 0
EndIf
Case #TH_CAN_OVERSIZE
If fl()\PosY + 64 <= GadgetHeight(can)
ProcedureReturn 0
EndIf
EndSelect
EndIf
StartDrawing(CanvasOutput(can))
DrawingFont(FontID(cd\Font))
;Background
If IsImage(cd\BackgroundImage) > 0 ;No need for background color if valid
DrawImage(ImageID(cd\BackgroundImage), 0, 0, GadgetWidth(can), GadgetHeight(can))
Else
Box(0,0,GadgetWidth(can), GadgetHeight(can), cd\BackgroundColor)
EndIf
;assign images and set text
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If Direct = 1
fl()\PosY + 16
ElseIf Direct = -1
fl()\PosY - 16
EndIf
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, fl()\PosY, GadgetWidth(can), 16, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, fl()\PosY, 16, 16)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(20, fl()\PosY + (8 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
Case #TH_CAN_MEDIUM
If Direct = 1
fl()\PosY + 24
ElseIf Direct = -1
fl()\PosY - 24
EndIf
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, fl()\PosY, GadgetWidth(can), 24, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, fl()\PosY, 24, 24)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(26, fl()\PosY + (12 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
Case #TH_CAN_LARGE
If Direct = 1
fl()\PosY + 48
ElseIf Direct = -1
fl()\PosY - 48
EndIf
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, fl()\PosY, GadgetWidth(can), 48, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, fl()\PosY, 48, 48)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(52, fl()\PosY + (24 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
Case #TH_CAN_OVERSIZE
If Direct = 1
fl()\PosY + 64
ElseIf Direct = -1
fl()\PosY - 64
EndIf
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, fl()\PosY, GadgetWidth(can), 64, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, fl()\PosY, 64, 64)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(68, fl()\PosY + (32 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
EndSelect
Next
StopDrawing()
ProcedureReturn 0
EndProcedure
Procedure.i UpdateCanvas()
Protected count.i = 0
If IsGadget(can) = 0
ProcedureReturn -1
EndIf
StartDrawing(CanvasOutput(can))
DrawingFont(FontID(cd\Font))
;Background
If IsImage(cd\BackgroundImage) > 0 ;No need for background color if valid
DrawImage(ImageID(cd\BackgroundImage), 0, 0, GadgetWidth(can), GadgetHeight(can))
Else
Box(0,0,GadgetWidth(can), GadgetHeight(can), cd\BackgroundColor)
EndIf
;assign images and set text
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, count*16,GadgetWidth(can), 16, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, count * 16, 16, 16)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(20, (count * 16) + (8 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
fl()\PosY = count * 16
Case #TH_CAN_MEDIUM
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, count*24,GadgetWidth(can), 24, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, count * 24, 24, 24)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(26, (count * 24) + (12 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
fl()\PosY = count * 24
Case #TH_CAN_LARGE
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, count*48,GadgetWidth(can), 48, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, count * 48, 48, 48)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(52, (count * 48) + (24 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
fl()\PosY = count * 48
Case #TH_CAN_OVERSIZE
DrawingMode(#PB_2DDrawing_Default)
If fl()\selected = #True
Box(0, count*64,GadgetWidth(can), 64, cd\FrameColor)
EndIf
DrawImage(ImageID(fl()\DefaultImage), 0, count * 64, 64, 64)
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(68, (count * 64) + (32 - TextHeight("W")/2), fl()\Filename, cd\TextColor)
fl()\PosY = count * 64
EndSelect
count + 1
Next
StopDrawing()
ProcedureReturn 0
EndProcedure
Procedure.s GetFullPath(index)
SelectElement(fl(),index)
ProcedureReturn Slash(cPath) + fl()\Filename
EndProcedure
Procedure.s GetFilename(index)
SelectElement(fl(), index)
ProcedureReturn fl()\Filename
EndProcedure
Procedure.s GetFullPathByPosition(posy.i)
Protected ReturnString.s = ""
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If posy > fl()\PosY And posy < fl()\PosY + 16
ReturnString = Slash(cPath) + fl()\Filename
Break
EndIf
Case #TH_CAN_MEDIUM
If posy > fl()\PosY And posy < fl()\PosY + 24
ReturnString = Slash(cPath) + fl()\Filename
Break
EndIf
Case #TH_CAN_LARGE
If posy > fl()\PosY And posy < fl()\PosY + 48
ReturnString = Slash(cPath) + fl()\Filename
Break
EndIf
Case #TH_CAN_OVERSIZE
If posy > fl()\PosY And posy < fl()\PosY + 64
ReturnString = Slash(cPath) + fl()\Filename
Break
EndIf
EndSelect
Next
ProcedureReturn ReturnString
EndProcedure
Procedure.s GetFilenameByPosition(posy)
Protected ReturnString.s = ""
ForEach fl()
Select cd\DisplayMode
Case #TH_CAN_DETAILS
If posy > fl()\PosY And posy < fl()\PosY + 16
ReturnString = fl()\Filename
Break
EndIf
Case #TH_CAN_MEDIUM
If posy > fl()\PosY And posy < fl()\PosY + 24
ReturnString = fl()\Filename
Break
EndIf
Case #TH_CAN_LARGE
If posy > fl()\PosY And posy < fl()\PosY + 48
ReturnString = fl()\Filename
Break
EndIf
Case #TH_CAN_OVERSIZE
If posy > fl()\PosY And posy < fl()\PosY + 64
ReturnString = fl()\Filename
Break
EndIf
EndSelect
Next
ProcedureReturn ReturnString
EndProcedure
EndModule
Procedure.i MyiListEvents()
Protected Newval.i
ev.i = EventType()
Select ev
Case #PB_EventType_MouseMove
Case #PB_EventType_LeftClick
_iList::SetSelectedItemByPosition(GetGadgetAttribute(MyCan, #PB_Canvas_MouseY))
Case #PB_EventType_LeftDoubleClick
_iList::DisplayItemByPositionToObject(GetGadgetAttribute(MyCan, #PB_Canvas_MouseY), DisplayObject)
Case #PB_EventType_MouseWheel
_iList::ScrollCanvas(GetGadgetAttribute(MyCan, #PB_Canvas_WheelDelta))
EndSelect
EndProcedure
Procedure.i ExplTree()
Protected ev.i = EventType()
If ev = #PB_EventType_Change
_iList::SetPath(GetGadgetText(0))
EndIf
EndProcedure
OpenWindow(0, 0, 0, 1024, 768, "Thumbnails 2", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
ExplorerTreeGadget(0, 10, 10, 200, 200, "C:\", #PB_Explorer_NoFiles)
BindGadgetEvent(0, @ExplTree())
MyCan = _iList::AssignCanvas(0, 220, 10, 200, 200)
BindGadgetEvent(MyCan, @MyiListEvents())
DisplayObject = CanvasGadget(#PB_Any, 430, 10, 500, 500)
_iList::InitDefaults()
_iList::SetDisplayMode(#TH_CAN_DETAILS)
_iList::SetTextFont(LoadFont(#PB_Any, "Arial", 8, #PB_Font_Bold))
Repeat
ev = WaitWindowEvent()
Until ev = #PB_Event_CloseWindow
