Code: Select all
CompilerIf Not #PB_Compiler_Unicode
MessageRequester("Info","Please Compile in Unicode Mode", #PB_MessageRequester_Ok|#MB_ICONWARNING)
End
CompilerEndIf
UseJPEG2000ImageDecoder()
UseTGAImageDecoder()
Global *token, *Image,Image
Global HBITMAP,Thread,Path$,Finish,Large_IL
Global Var.lv_item,row,Col,iSize,w,h
row = 0
col = 1
iSize = 128
Var\mask = #LVIF_IMAGE
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
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 SetImg(gad,Row,Col,iImg)
Var\iItem = Row
Var\iSubItem = Col
Var\iImage = iImg ;Index of image in the list
SendMessage_(GadgetID(gad), #LVM_SETITEM, 0, @Var)
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 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)
EndProcedure
Procedure PopulateLI(par)
Finish = 0
SetGadgetText(12,"WAIT")
DisableWindow(0,1)
If ILwnd
ImageList_Destroy_(ILwnd)
EndIf
ClearGadgetItems(0)
img = CreateImage(#PB_Any,iSize,iSize+10,24,$FFFFFF)
ILwnd = ImageList_Create_(iSize,iSize+10,#ILC_COLOR32|#ILC_MASK, 0, 300)
SendMessage_(GadgetID(0), #LVM_SETIMAGELIST, #LVSIL_SMALL, 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, @width.f, @height.f)
hScale.f = iSize/width
vScale.f = iSize/height
If hScale > vScale
Scale.f = vScale*0.9
Else
Scale.f = hScale*0.9
EndIf
imgH = CopyImage_(HBITMAP,#IMAGE_BITMAP,Scale*width,Scale*height,0)
y = (iSize-Scale*height)/2
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,$FFFFFF)
DrawImage(imgh,5,y)
SelectObject_(hdc,FontID(1))
SetBkMode_(hDc, #TRANSPARENT)
SetTextColor_(hDc, $0)
r.RECT : r\left = 0 : r\top = iSize-5 : r\right = iSize : r\bottom = 10
DrawText_(hdc,@FileName$,Len(FileName$),@r,#DT_NOCLIP | #DT_CENTER | #DT_VCENTER |#DT_WORDBREAK )
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
SetImg(0,row,col,item)
col+1
If col > 8
col = 1
row+1
EndIf
DeleteObject_(HBITMAP)
DeleteObject_(imgH)
EndIf
Case "cur"
hCursor = LoadCursorFromFile_(@File$)
If hCursor
item = ImageList_AddIcon_(ILwnd,hCursor)
SetImg(0,row,col,item)
col+1
If col > 8
col = 1
row+1
EndIf
DeleteObject_(hCursor)
EndIf
Case "jp2","tga"
LoadImage(0,File$)
If IsImage(0)
hScale.f = iSize/ImageWidth(0)
vScale.f = iSize/ImageHeight(0)
If hScale > vScale
Scale.f = vScale*0.9
Else
Scale.f = hScale*0.9
EndIf
imgH = CopyImage_(ImageID(0),#IMAGE_BITMAP,Scale*ImageWidth(0),Scale*ImageHeight(0),0)
y = (iSize-Scale*ImageHeight(0))/2
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,$FFFFFF)
DrawImage(imgh,5,y)
SelectObject_(hdc,FontID(1))
SetBkMode_(hDc, #TRANSPARENT)
SetTextColor_(hDc, $0)
r.RECT : r\left = 0 : r\top = iSize-5 : r\right = iSize : r\bottom = 10
DrawText_(hdc,@FileName$,Len(FileName$),@r,#DT_NOCLIP | #DT_CENTER | #DT_VCENTER |#DT_WORDBREAK )
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
SetImg(0,row,col,item)
col+1
If col > 8
col = 1
row+1
EndIf
DeleteObject_(imgH)
EndIf
Case "ppm","pgm"
If IsImage(0)
FreeImage(0)
EndIf
LoadPPGM(Image, File$)
If IsImage(Image)
hScale.f = iSize/w
vScale.f = iSize/h
If hScale > vScale
Scale.f = vScale*0.9
Else
Scale.f = hScale*0.9
EndIf
imgH = CopyImage_(ImageID(Image),#IMAGE_BITMAP,Scale*w,Scale*h,0)
y = (iSize-Scale*h)/2
hdc = StartDrawing(ImageOutput(img))
Box(0,0,iSize+10,iSize+10,$FFFFFF)
DrawImage(imgh,5,y)
SelectObject_(hdc,FontID(1))
SetBkMode_(hDc, #TRANSPARENT)
SetTextColor_(hDc, $0)
r.RECT : r\left = 0 : r\top = iSize-5 : r\right = iSize : r\bottom = 10
DrawText_(hdc,@FileName$,Len(FileName$),@r,#DT_NOCLIP | #DT_CENTER | #DT_VCENTER |#DT_WORDBREAK )
StopDrawing()
item = ImageList_Add_(ILwnd,ImageID(img),0)
SetImg(0,row,col,item)
col+1
If col > 8
col = 1
row+1
EndIf
DeleteObject_(imgH)
EndIf
EndSelect
EndIf
Until NextEntry = 0
EndIf
Delay(50)
Finish = 1
SetGadgetText(12,"GO")
DisableWindow(0,0)
EndProcedure
LoadFont(0,"Consolas",14)
LoadFont(1,"Arial",7)
OpenWindow(0,0,0,800,600,"ExplorerListGadget & Thumbnails",#PB_Window_SystemMenu|#PB_Window_ScreenCentered| #PB_Window_MaximizeGadget| #PB_Window_SizeGadget)
SetWindowColor(0,$AAAAAB)
ContainerGadget(5,10,10,780,545,#PB_Container_Flat)
ExplorerListGadget(0,0,0,0,0,"",#PB_Explorer_NoParentFolder | #PB_Explorer_NoDriveRequester | #PB_Explorer_NoMyDocuments | #PB_Explorer_AutoSort)
SetGadgetItemAttribute(0, 0,#PB_Explorer_ColumnWidth ,0,0)
ExplorerTreeGadget(1, 0,0,0,0, "*.*",#PB_Explorer_NoFiles)
SplitterGadget(2, 5, 5, 768, 530, 1,0, #PB_Splitter_Vertical|#PB_Splitter_Separator)
SetGadgetState(2,160)
CloseGadgetList()
SetGadgetFont(1,FontID(0))
;SendMessage_(GadgetID(0),#LVM_SETVIEW,#LV_VIEW_ICON,0)
SetGadgetColor(1, #PB_Gadget_BackColor, $D2D2D2)
;ButtonGadget(10,10,565,50,25,"RUN")
TextGadget(12,10,565,80,25,"START",#SS_CENTER|#SS_CENTERIMAGE)
SetGadgetColor(12,#PB_Gadget_FrontColor,$0000FF)
SetGadgetFont(12,FontID(0))
SetWindowLongPtr_(GadgetID(0), #GWL_STYLE, GetWindowLongPtr_(GadgetID(0), #GWL_STYLE)|#LVS_NOCOLUMNHEADER)
SendMessage_(GadgetID(0), #LVM_SETEXTENDEDLISTVIEWSTYLE , #LVS_EX_SUBITEMIMAGES, #LVS_EX_SUBITEMIMAGES)
Header = SendMessage_(GadgetID(0), #LVM_GETHEADER, 0, 0)
AddGadgetColumn(0, 1, "",iSize+5)
AddGadgetColumn(0, 2, "",iSize+5)
AddGadgetColumn(0, 3, "",iSize+5)
AddGadgetColumn(0, 4, "",iSize+5)
AddGadgetColumn(0, 5, "",iSize+5)
AddGadgetColumn(0, 6, "",iSize+5)
AddGadgetColumn(0, 7, "",iSize+5)
AddGadgetColumn(0, 8, "",iSize+5)
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 #PB_Event_Gadget
Select EventGadget()
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
DataSection
IconHeader_32:
Data.l 0,0,1,0,0,0,0,16,0,0,0,0
Header:
Data.l 0,0,2,0,0,0,0,16,0,0,0,0
FrameDimensionPage:
Data.l $7462DC86
Data.u $6180, $4C7E
Data.b $8E, $3F, $EE, $73, $33, $A7, $A4, $83
clsid_jpeg: ; clsid for jpeg image format
Data.l $557CF401
Data.w $1A04
Data.w $11D3
Data.b $9A,$73,$00,$00,$F8,$1E,$F3,$2E
clsid_EncoderQuality:
Data.l $1D5BE4B5
Data.w $FA4A
Data.w $452D
Data.b $9C,$DD,$5D,$B3,$51,$05,$E7,$EB
EndDataSection
