Code: Select all
CompilerIf Not #PB_Compiler_Unicode
MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
End
CompilerEndIf
#TVM_SETBKCOLOR = $111D
#FOF_NORECURSION = $1000
UseJPEG2000ImageDecoder()
UseTGAImageDecoder()
Global *token, *Image,Image
Global HBITMAP,Thread,Path$,Finish,ILwnd
Global iSize,w.f,h.f,bcolor
Global Dim item$(500)
iSize = 128
bcolor = $D8D8D8
Image = 0
Structure PPMColor
r.a
g.a
b.a
EndStructure
Structure PGMColor
c.a
EndStructure
Structure RectF
x.f
y.f
width.f
height.f
EndStructure
Structure GdiplusStartupInput
GdiPlusVersion.i
*DebugEventCallback.DebugEventProc
SuppressBackgroundThread.i
SuppressExternalCodecs.i
EndStructure
Structure ImageCodecInfo
clsid.CLSID
formatID.GUID
*codecName
*dllName
*formatDescription
*filenameExtension
*mimeType
flags.l
version.l
sigCount.l
sigSize.l
*sigPattern.byte
*sigMask.byte
EndStructure
Macro _imgscale
hScale.f = iSize/w
vScale.f = iSize/h
If hScale > vScale
Scale.f = vScale*0.9
Else
Scale.f = hScale*0.9
EndIf
x = (iSize-Scale*w)/2
y = (iSize-Scale*h)/2
EndMacro
Import "Uxtheme.lib"
SetWindowTheme(Window.l, Body.p-unicode, Title.p-unicode)
EndImport
Procedure.i Gdiplus_New(version = 1, *hEventCB = #Null, Codecs = #False, bgThread = #False)
OpenLibrary(0, "gdiplus.dll")
Protected *token, input.GdiplusStartupInput
With input
\GdiPlusVersion = version
\DebugEventCallback = *hEventCB
\SuppressExternalCodecs = Codecs
\SuppressBackgroundThread = bgThread
EndWith
CallFunction(0, "GdiplusStartup", @*token, @input, #Null)
ProcedureReturn *token
EndProcedure
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 PopulateLI(par)
Finish = 0 :item = 0 : Scale.f = 0
PostEvent(#PB_Event_SizeWindow)
SetGadgetText(12,"WAIT")
DisableWindow(0,1)
ClearGadgetItems(0)
If ILwnd
ImageList_Destroy_(ILwnd)
EndIf
If IsImage(img)
FreeImage(img)
EndIf
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)
Path$ = GetGadgetText(1)
If ExamineDirectory(0, Path$, "*.*")
*token = Gdiplus_New()
Repeat
NextEntry = NextDirectoryEntry(0)
FileName$ = DirectoryEntryName(0)
File$ = Path$+FileName$
Ext$ = LCase(GetExtensionPart(FileName$))
If FileSize(File$) > 0; And FileSize(Path$ + FileName$) < 100000
Select Ext$
Case "bmp","jpg","jpeg","jpe","jfif","png","tif","tiff","gif","emf","wmf","ico","rle"
If *token
CallFunction(0,"GdipCreateBitmapFromFile",@File$, @*image)
CallFunction(0,"GdipCreateHBITMAPFromBitmap", *Image,@HBITMAP,0)
CallFunction(0,"GdipGetImageDimension",*image, @w, @h)
_imgscale ;Macro Scale
imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
If imgH
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,bcolor)
DrawImage(imgh,x,y)
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
iItem(0,FileName$ ,item)
item$(item) = FileName$
DeleteObject_(HBITMAP)
DeleteObject_(imgH)
EndIf
EndIf
Case "cur"
hCursor = LoadCursorFromFile_(@File$)
If hCursor
item = ImageList_AddIcon_(ILwnd,hCursor)
iItem(0,FileName$ ,item)
item$(item) = FileName$
DeleteObject_(hCursor)
EndIf
Case "jp2","tga"
LoadImage(0,File$)
w = ImageWidth(0)
h = ImageHeight(0)
If IsImage(0)
_imgscale
imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,Scale*w,Scale*h,#LR_COPYDELETEORG)
If imgH
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,bcolor)
DrawImage(imgh,x,y)
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
iItem(0,FileName$ ,item)
item$(item) = FileName$
DeleteObject_(imgH)
EndIf
EndIf
Case "ppm","pgm"
If IsImage(0)
FreeImage(0)
EndIf
LoadPPGM(Image, File$)
If IsImage(Image)
_imgscale
imgH = CopyImage_(ImageID(Image),#IMAGE_BITMAP,Scale*w,Scale*h, #LR_COPYDELETEORG)
If imgH
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,bcolor)
DrawImage(imgh,x,y)
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
iItem(0,FileName$ ,item)
item$(item) = FileName$
DeleteObject_(imgH)
EndIf
EndIf
;
EndSelect
EndIf
Until NextEntry = 0
EndIf
Finish = 1
SetGadgetText(12,"GO")
DisableWindow(0,0)
EndProcedure
Procedure Resizewindow_EX()
ResizeGadget(5,#PB_Ignore,#PB_Ignore,WindowWidth(0)-20,WindowHeight(0)-50)
ResizeGadget(2,#PB_Ignore,#PB_Ignore,WindowWidth(0) - 35,WindowHeight(0)-65)
ResizeGadget(12,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
ResizeGadget(15,#PB_Ignore,WindowHeight(0)-30,#PB_Ignore,#PB_Ignore)
EndProcedure
LoadFont(0,"Consolas",14)
LoadFont(1,"Arial",7)
OpenWindow(0,0,0,800,600,"ListIconGadget & Thumbnails",#PB_Window_SystemMenu| #PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
SetWindowColor(0,$AAAAAB)
If CreatePopupImageMenu(0)
MenuItem(1, "Open")
MenuItem(2, "Copy")
MenuItem(3, "Save as..")
MenuBar()
MenuItem(4, "Delete")
MenuItem(5, "Recycle")
MenuBar()
MenuItem(6, "Print")
EndIf
ContainerGadget(5,10,10,780,545,#PB_Container_Flat)
ListIconGadget(0,0,0,0,0,"",0,#PB_ListIcon_MultiSelect| #LVS_AUTOARRANGE)
ExplorerTreeGadget(1, 0,0,0,0, "*",#PB_Explorer_NoFiles|#PB_Explorer_NoDriveRequester)
SplitterGadget(2, 5, 5, 768, 530, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator)
SetGadgetState(2,160)
CloseGadgetList()
SetWindowTheme(GadgetID(1),"", "BUTTON")
SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)
SetGadgetFont(1,FontID(0))
SetGadgetColor(1, #PB_Gadget_BackColor, $D2D2D2)
;SendMessage_(GadgetID(1),#TVM_SETBKCOLOR,0,RGB(200,255,0))
TextGadget(12,10,565,80,25,"START",#SS_CENTER| #SS_CENTERIMAGE)
SetGadgetColor(12,#PB_Gadget_FrontColor,$0000FF)
SetGadgetFont(12,FontID(0))
TextGadget(15,100,565,600,25,"",#SS_CENTER| #SS_CENTERIMAGE)
SetGadgetColor(15,#PB_Gadget_FrontColor,$FF0000)
SetGadgetFont(15,FontID(0))
BindEvent(#PB_Event_SizeWindow,@Resizewindow_EX())
Repeat
Select WaitWindowEvent()
Case #PB_Event_CloseWindow
CallFunction(0,"GdipDeleteGraphics",*Localgfx)
CallFunction(0,"GdiplusShutdown",*token)
CloseLibrary(0)
Quit = 1
Case #WM_RBUTTONDOWN ; right mouse button was clicked =>
File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
SetGadgetText(15,File$)
DisplayPopupMenu(0, WindowID(0)) ; now display the popup-menu
Case #PB_Event_Menu ; an item of the popup-menu was clicked
Select EventMenu() ; get the clicked menu item...
Case 1 : Debug "Menu: Open"
Case 2 : Debug "Menu: Save"
Case 3 : Debug "Menu: Save as"
Case 4 : End
Case 5
; CallFunction(0,"GdipDisposeImage",*image) ;Very Important
; CallFunction(0,"GdipDeleteGraphics",*Localgfx)
; CallFunction(0,"GdiplusShutdown",*token)
Beep_(800,100)
Result = MessageRequester("Attention","Recycle Image ?",#PB_MessageRequester_YesNo|#MB_ICONQUESTION)
If Result = #PB_MessageRequester_Yes
SHFileOp.SHFILEOPSTRUCT
ZeroMemory_(@SHFileOp, SizeOf(SHFileOp))
SHFileOp\hwnd = #Null
SHFileOp\pFrom = @File$
SHFileOp\pTo = #Null
SHFileOp\wFunc = #FO_DELETE
SHFileOp\fFlags = #FOF_ALLOWUNDO|#FOF_NOERRORUI |#FOF_SILENT; | #FOF_NORECURSION
result = SHFileOperation_(SHFileOp)
EndIf
Case 6 : Debug "Menu: Text.txt"
EndSelect
Case #PB_Event_Gadget
Select EventGadget()
Case 0
File$ = Path$+item$(CountGadgetItems(0)-GetGadgetState(0)-1)
SetGadgetText(15,File$)
Case 1
Select EventType()
Case #PB_EventType_Change
If IsThread(Thread)
KillThread(Thread)
EndIf
Thread = CreateThread(@PopulateLI(),32)
EndSelect
EndSelect
EndSelect
Until Quit = 1
End