- Icons
- Movies
- Pictures
Not Fast as Windows file browser but Windows use indexing
Code: Select all
UseTGAImageDecoder()
#PBM_SETBARCOLOR = 1033
#PBM_SETBKCOLOR = 8193
#TBS_TOOLTIPS = $100
Global Image ,ext$ ,hwndPB,oldpos
Global iSize,ILwnd
iSize = 16
Structure PPMColor
r.a
g.a
b.a
EndStructure
Structure PGMColor
c.a
EndStructure
Structure File
FileName$
Image.l
EndStructure
Macro _imgscale
hScale.f = iSize/bm\bmWidth
vScale.f = iSize/bm\bmHeight
If hScale > vScale
Scale.f = vScale*0.9
Else
Scale.f = hScale*0.9
EndIf
If Scale > 2
Scale = 2
EndIf
x = (iSize-Scale*bm\bmWidth)/2
y = (iSize-Scale*bm\bmHeight)/2
EndMacro
Procedure iItem(Gad,itText$,index)
it.LVITEM
it\Mask = #LVIF_TEXT| #LVIF_IMAGE
it\iItem = 0
it\iSubItem = 0
it\iImage = index
it\pszText = @itText$
SendMessage_(GadgetID(Gad), #LVM_INSERTITEM, 0, @it)
EndProcedure
Procedure LoadPPGM(Image,filename$)
Result = ReadFile(#PB_Any, filename$,#PB_Ascii)
If Result
If CreateImage(Image, 1, 1)
Format$ = ReadString(Result)
Dimensions$ = ReadString(Result)
If Val(StringField(Dimensions$, 1, " ")) = 0
Dimensions$ = ReadString(Result)
EndIf
w = Val(StringField(Dimensions$, 1, " "))
h = Val(StringField(Dimensions$, 2, " "))
If w = 0 Or h = 0
ProcedureReturn 1
EndIf
ResizeImage(Image, w, h)
StartDrawing(ImageOutput(Image))
max = Val(ReadString(Result))
Select Format$
Case "P2"
Stringlen = Lof(Result) - Loc(Result)
content$ = Space(Stringlen*SizeOf(Character)+1)
Dim color.s(0)
ReadData(Result, @content$, Stringlen)
content$ = PeekS(@content$,-1,#PB_Ascii)
CreateRegularExpression(1, "\d+")
ExtractRegularExpression(1, content$, color())
For y = 0 To h - 1
For x = 0 To w - 1
pos = (y*w + x)*1
Plot(x, y,RGB(Val(color(pos)),Val(color(pos)),Val(color(pos))))
Next
Next
Case "P3"
Stringlen = Lof(Result) - Loc(Result)
content$ = Space(Stringlen*SizeOf(Character)+1)
Dim color.s(0)
ReadData(Result, @content$, Stringlen)
content$ = PeekS(@content$,-1,#PB_Ascii)
CreateRegularExpression(1, "\d+")
ExtractRegularExpression(1, content$, color())
For y = 0 To h - 1
For x = 0 To w - 1
pos = (y*w + x)*3
r=Val(color(pos))*255 / max
g=Val(color(pos+1))*255 / max
b=Val(color(pos+2))*255 / max
Plot(x, y, RGB(r,g,b))
Next
Next
Case "P5"
Bufferlen = Lof(Result) - Loc(Result)
*Buffer = AllocateMemory(Bufferlen)
ReadData(Result, *Buffer, Bufferlen)
For y = 0 To h - 1
For x = 0 To w - 1
*gray.PGMColor = pos + *Buffer
Plot(x, y,RGB(*gray\c,*gray\c,*gray\c))
pos + 1
Next
Next
Case "P6"
Bufferlen = Lof(Result) - Loc(Result)
*Buffer = AllocateMemory(Bufferlen)
ReadData(Result, *Buffer, Bufferlen)
For y = 0 To h - 1
For x = 0 To w - 1
*color.PPMColor = pos + *Buffer
Plot(x, y, RGB(*color\r*255 / max, *color\g*255 / max, *color\b*255 / max))
pos + 3
Next
Next
EndSelect
StopDrawing()
CloseFile(Result)
ProcedureReturn 1
EndIf
EndIf
EndProcedure
Procedure GetShellThumbnail(FileName$, Image, Width, Height, Depth = #PB_Image_DisplayFormat)
Protected Result = 0, ImageResult
Protected Desktop.IShellFolder, Folder.IShellFolder
Protected Extract.IExtractImage
Protected *pidlFolder.ITEMIDLIST, *pidlFile.ITEMIDLIST
Protected Priority, Flags, Bitmap = 0, size.SIZE
ext$ = GetExtensionPart(FileName$)
If SHGetDesktopFolder_(@Desktop) >= 0
If Desktop\ParseDisplayName(#Null, #Null, GetPathPart(FileName$), #Null, @*pidlFolder, #Null) = #S_OK
If Desktop\BindToObject(*pidlFolder, #Null, ?IID_IShellFolder, @Folder) = #S_OK
If Folder\ParseDisplayName(#Null, #Null, GetFilePart(FileName$) , #Null, @*pidlFile, #Null) = #S_OK
If Folder\GetUIObjectOf(#Null, 1, @*pidlFile, ?IID_IExtractImage, 0, @Extract) = #S_OK
ImageResult = CreateImage(Image, width,height, Depth)
If ImageResult
If Image = #PB_Any
Image = ImageResult
EndIf
If Depth = #PB_Image_DisplayFormat
Depth = ImageDepth(Image)
EndIf
size\cx = Width
size\cy = Height
If Extract\GetLocation(Space(#MAX_PATH), #MAX_PATH, @Priority, @size, Depth, @Flags) >= 0
If Extract\Extract(@Bitmap) >= 0 And Bitmap
GetObject_(Bitmap, SizeOf(BITMAP), @bm.BITMAP)
If ext$ = "3gpp" Or ext$ = "mp4"; Or ext$ = "mkv"
If StartDrawing(ImageOutput(Image))
Box(0,0,iSize,iSize,$FFFFFF)
DrawImage(Bitmap,iSize/2-bm\bmWidth/2,iSize/2-bm\bmHeight/2-2)
StopDrawing()
Result = ImageResult
EndIf
Else
If StartVectorDrawing(ImageVectorOutput(Image))
ResetCoordinates()
VectorSourceColor($FFEBFEFF)
FillVectorOutput()
If OSVersion() >= #PB_OS_Windows_Vista
MovePathCursor(iSize/2-bm\bmWidth/2,iSize/2+bm\bmHeight/2-2)
FlipCoordinatesY(180)
EndIf
DrawVectorImage(Bitmap, 255)
StopVectorDrawing()
Result = ImageResult
EndIf
EndIf
DeleteObject_(Bitmap)
EndIf
EndIf
Extract\Release()
EndIf
If Result = 0
FreeImage(Image)
EndIf
EndIf
CoTaskMemFree_(*pidlFile)
EndIf
Folder\Release()
EndIf
CoTaskMemFree_(*pidlFolder)
EndIf
Desktop\Release()
EndIf
ProcedureReturn Result
EndProcedure
Procedure Resizewindow_EX()
ResizeGadget(5,#PB_Ignore,#PB_Ignore,WindowWidth(0)-40,WindowHeight(0)-55)
ResizeGadget(2,#PB_Ignore,#PB_Ignore,WindowWidth(0) - 52,WindowHeight(0)-68)
MoveWindow_(hwndPB,WindowWidth(0)-24,10,18,WindowHeight(0)-55,1)
ResizeGadget(10,10,WindowHeight(0) - 34,160,20)
ResizeGadget(15,180,WindowHeight(0) - 34,40,20)
ResizeGadget(20,230,WindowHeight(0) - 34,GadgetWidth(5)-220,20)
EndProcedure
NewList File.File()
LoadFont(0,"Consolas",14)
Flag = #PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget| #PB_Window_SizeGadget
If OpenWindow(0,0,0,820,600,"Thumbnails Viewer",Flag)
SetWindowColor(0,$E9E9E9)
WindowBounds(0,600,400,#PB_Default,#PB_Default)
ContainerGadget(5,10,10,780,545,#PB_Container_Flat)
SetGadgetColor(5,#PB_Gadget_BackColor,0)
ListIconGadget(0,0,0,0,0,"",0,#PB_ListIcon_MultiSelect|#LVS_AUTOARRANGE |#WS_DLGFRAME )
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)
SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE,0,SendMessage_(GadgetID(0),#LVM_GETEXTENDEDLISTVIEWSTYLE,0,0)| #LVS_EX_TRACKSELECT)
SendMessage_(GadgetID(0), #LVM_SETHOVERTIME, 0, 10)
ExplorerTreeGadget(1, 0,0,0,0, "*",#PB_Explorer_NoFiles|#PB_Explorer_NoDriveRequester)
SetGadgetFont(1,FontID(0))
SetGadgetColor(1,#PB_Gadget_BackColor,$DBDBDB)
SplitterGadget(2, 5, 5, 768, 532, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator)
SetGadgetState(2,250)
CloseGadgetList()
hwndPB = CreateWindowEx_(0, "msctls_progress32", 0, #WS_CHILD|#WS_VISIBLE|#PBS_VERTICAL , WindowWidth(0)-24,10,18,545, WindowID(0), 0, 0, 0)
SetWindowTheme_(hwndPB, "", "")
SendMessage_(hwndPB, #PBM_SETBKCOLOR ,0,$DBDBDB)
SendMessage_(hwndPB, #PBM_SETBARCOLOR ,0,$FDAE4D)
TrackBarGadget(10,10,568,160,24,1,12,#TBS_AUTOTICKS | #TBS_ENABLESELRANGE|#TBS_TOOLTIPS |#TBS_FIXEDLENGTH)
SendMessage_(GadgetID(10), #TBM_SETTHUMBLENGTH,16,0)
SendMessage_(GadgetID(10), #TBM_SETPAGESIZE ,0,1)
SetGadgetState(10,3)
TextGadget(15,180,568,40,20,"16",#WS_BORDER | #SS_CENTER|#SS_CENTERIMAGE)
SetGadgetColor(15,#PB_Gadget_BackColor,$FFFFFF)
TextGadget(20,230,568,582,20,"",#WS_BORDER | #SS_CENTER | #SS_CENTERIMAGE)
SetGadgetFont(20,FontID(0))
SetGadgetColor(20,#PB_Gadget_BackColor,$FFFFFF)
SetGadgetColor(20,#PB_Gadget_FrontColor,$0000FF)
BindEvent(#PB_Event_SizeWindow,@Resizewindow_EX())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
Quit = 1
Case #WM_MOUSEMOVE
If GetActiveGadget() = 10
If GetGadgetState(10) >= 4
iSize = GetGadgetState(10)*16
SetGadgetText(15,Str(iSize))
Else
SetGadgetText(15,Str(GetGadgetState(10)))
EndIf
EndIf
Case #WM_LBUTTONUP
If GetActiveGadget() = 10
Select GetGadgetState(10)
Case 1
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_TILE,0)
Case 2
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_LIST,0)
Case 3
iSize = 16
SetGadgetText(15,Str(iSize))
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)
Case 4 To 12
iSize = GetGadgetState(10)*16
SetGadgetText(15,Str(iSize))
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)
EndSelect
PostMessage_(GadgetID(1), #WM_LBUTTONDOWN, 0, 0)
PostMessage_(GadgetID(1), #WM_LBUTTONUP, 0, 0)
EndIf
Case #PB_Event_Gadget
Select EventGadget()
Case 0
Select EventType()
Case #PB_EventType_Change
result = SelectElement(File(),ListSize(File()) - GetGadgetState(0) - 1)
If result > 0
SetGadgetText(20 , File()\FileName$)
EndIf
EndSelect
Case 1
Select EventType()
Case #PB_EventType_LeftClick
If ILwnd
ImageList_Destroy_(ILwnd)
EndIf
ClearList(File())
ClearGadgetItems(0)
SetGadgetText(20 , "" )
SendMessage_(hwndPB, #PBM_SETPOS, 0,0)
img = CreateImage(#PB_Any,iSize,iSize,32,$FFFFFF)
ILwnd = ImageList_Create_(iSize,iSize,#ILC_COLOR32|#ILC_MASK, 0, 300)
SendMessage_(GadgetID(0),#LVM_SETIMAGELIST,#LVSIL_NORMAL,ILwnd)
Count = 0
If GetGadgetText(1) <> "" And ExamineDirectory(0, GetGadgetText(1), "*.*")
While NextDirectoryEntry(0)
If DirectoryEntryType(0) = #PB_DirectoryEntry_File
AddElement(File())
File()\FileName$ = GetGadgetText(1) + DirectoryEntryName(0)
Count + 1
EndIf
Wend
EndIf
If Count > 0
SendMessage_(hwndPB, #PBM_SETPOS, 100, 0)
;While WindowEvent(): Wend
ForEach File()
index = ListIndex(File())
File()\Image = GetShellThumbnail(File()\FileName$, #PB_Any, iSize, iSize)
If File()\Image = 0
File()\Image = CreateImage(#PB_Any, iSize, iSize)
If File()\Image And StartDrawing(ImageOutput(File()\Image))
Box(0, 0, iSize, iSize, $FFFFFF)
If SHGetFileInfo_(@File()\FileName$, 0, @info.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON|#SHGFI_LARGEICON)
DrawImage(info\hIcon, iSize/2-16, iSize/2-16)
DestroyIcon_(info\hIcon)
EndIf
StopDrawing()
EndIf
If ext$ = "ppm" Or ext$ = "pgm"
If LoadPPGM(Image, File()\FileName$)
img = ImageID(image)
GetObject_(img, SizeOf(BITMAP), @bm.BITMAP)
_imgscale
imgh = CopyImage_(img,#IMAGE_BITMAP,bm\bmWidth*Scale,bm\bmHeight*Scale,#LR_COLOR)
File()\Image = CreateImage(#PB_Any, iSize, iSize)
If File()\Image And StartDrawing(ImageOutput(File()\Image))
Box(0,0,iSize,iSize,$FFFFFF)
DrawImage(imgh,x,y)
EndIf
StopDrawing()
FreeImage(Image)
DeleteObject_(img)
EndIf
EndIf
If ext$ = "tga"
If LoadImage(Image, File()\FileName$)
img = ImageID(image)
GetObject_(img, SizeOf(BITMAP), @bm.BITMAP)
_imgscale
imgh = CopyImage_(img,#IMAGE_BITMAP,bm\bmWidth*Scale,bm\bmHeight*Scale,#LR_COLOR)
File()\Image = CreateImage(#PB_Any, iSize, iSize)
If File()\Image And StartDrawing(ImageOutput(File()\Image))
Box(0,0,iSize,iSize,$FFFFFF)
DrawImage(imgh,x,y)
EndIf
StopDrawing()
FreeImage(Image)
DeleteObject_(img)
EndIf
EndIf
EndIf
item = ImageList_Add_(ILwnd,ImageID(File()\Image),0)
iItem(0, GetFilePart(File()\FileName$) ,item)
SendMessage_(hwndPB, #PBM_SETPOS, (index * 100)/Count,0)
While WindowEvent(): Wend
Next File()
SendMessage_(hwndPB, #PBM_SETPOS, 100,0)
EndIf
EndSelect
EndSelect
EndSelect
Until Quit = 1
EndIf
End
DataSection
IID_IShellFolder: ; {000214E6-0000-0000-C000-000000000046}
Data.l $000214E6
Data.w $0000, $0000
Data.b $C0, $00, $00, $00, $00, $00, $00, $46
IID_IExtractImage: ; {BB2E617C-0920-11D1-9A0B-00C04FC2D6C1}
Data.l $BB2E617C
Data.w $0920, $11D1
Data.b $9A, $0B, $00, $C0, $4F, $C2, $D6, $C1
EndDataSection
