Seite 1 von 1

API ImageList_Create

Verfasst: 27.02.2019 23:25
von silbersurfer
Hallo Leute, habe mal versucht das ListIconGadget dazu zu überreden größere Icons als 16x16
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