Anzeigen zu lassen.
Das ist dabei rausgekommen vieleicht kann das ja jemand gebrauchen
Code: Alles auswählen
EnableExplicit
Enumeration Windows
#Mein_Fenster
EndEnumeration
Enumeration Gadgets
#Meine_Imageliste
#Mein_Pahtstring
#MeinListButton
EndEnumeration
Global IconW=64, IconH=64
Global Imageliste = ImageList_Create_(IconW, IconH, #ILC_COLOR32|#ILC_MASK, 0, 20)
Procedure VerzeichnisEinlesen(Paht.s)
Protected Icon.SHFILEINFO,FileName.s,DummyImage.i,draw.i
If ExamineDirectory(0, Paht, "*.*")
ClearGadgetItems(#Meine_Imageliste) : ImageList_Destroy_(Imageliste)
Imageliste = ImageList_Create_(iconW, iconH, #ILC_COLOR32|#ILC_MASK, 0, 20)
While NextDirectoryEntry(0)
FileName = DirectoryEntryName(0)
Debug Paht+FileName
If FileName<>"." And FileName<>".."
SHGetFileInfo_(Paht+FileName, 0, @Icon.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX|#SHGFI_ICON|#SHGFI_LARGEICON)
DummyImage = CreateImage(#PB_Any, 32, 32,32,#PB_Image_Transparent )
draw=StartDrawing(ImageOutput(DummyImage))
DrawIcon_(Draw,0,0,Icon\hIcon)
StopDrawing()
ResizeImage(DummyImage, iconW, iconH)
ImageList_Add_(Imageliste,ImageID(DummyImage), 0)
AddGadgetItem(#Meine_Imageliste, -1,FileName,ImageID(DummyImage))
DestroyIcon_(Icon\hIcon)
FreeImage(DummyImage)
EndIf
Wend
Else
MessageRequester("Error","Can't examine this directory: "+Paht,0)
EndIf
EndProcedure
If OpenWindow(#Mein_Fenster, 0, 0, 700, 520, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
ListIconGadget(#Meine_Imageliste, 10, 10, 680, 480, "", 480)
StringGadget(#Mein_Pahtstring,10,494,580,20,"c:\")
ButtonGadget(#MeinListButton,610,494,81,20,"Auflisten")
SetGadgetAttribute(#Meine_Imageliste, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
EndIf
Repeat
Define event=WaitWindowEvent()
If event = #PB_Event_CloseWindow
Define Exit=#True
EndIf
If event=#PB_Event_Gadget
If EventGadget()=#MeinListButton
VerzeichnisEinlesen(GetGadgetText(#Mein_Pahtstring))
SendMessage_(GadgetID(#Meine_Imageliste), #LVM_SETIMAGELIST, #LVSIL_NORMAL, Imageliste)
EndIf
EndIf
Until Exit=#True