ich brauchte für eines meiner Projekte einen Requester zum auswählen eines Icons. Da ich hier nirgendwo etwas dazu gefunden dachte ich mir, ich gebe den Code mal weiter, vielleicht kann ihn jemand verwenden:
Code: Alles auswählen
; PureBasic: IconRequester | tested on Windows XP
; Copyright by IceFish
Procedure MAKELONG(low, high)
ProcedureReturn low | (high<<16)
EndProcedure
Procedure IconRequester_WndProc(hwnd.l,msg.l,wParam.l,lParam.l)
Result = #PB_ProcessPureBasicEvents
Select msg
Case #WM_DRAWITEM
*item.DRAWITEMSTRUCT = lParam
Select *item\itemState-768
Case 0
brush = CreateSolidBrush_(RGB(255,255,255))
Default
brush = CreateSolidBrush_(RGB(0,0,80))
EndSelect
FillRect_(*item\hdc, *item\rcItem, brush)
SetBkMode_(*item\hdc, #TRANSPARENT)
DrawIcon_(*item\hdc,*item\rcItem\left+4,*item\rcItem\top+4,*item\itemData)
EndSelect
ProcedureReturn Result
EndProcedure
Procedure IconRequester_LoadIconList(hlist.l,path.s,id.l,title.s)
Protected count.l,hicon.l
SendMessage_(hlist,#LB_RESETCONTENT,0,0)
count = ExtractIconEx_(path,-1,0,0,0)
If count > 0
For i = 0 To count-1
ExtractIconEx_(path,i,@hicon,0,1)
SendMessage_(hlist,#LB_ADDSTRING,0,hicon)
Next
SendMessage_(hlist,#LB_SETCURSEL,id,0)
ProcedureReturn #True
Else
If path <> ""
MessageRequester(title,"Die Datei '"+path+"' konnte nicht geöffnet werden, oder enthält keine verwendbaren Symbole.")
EndIf
ProcedureReturn #False
EndIf
EndProcedure
Procedure.s IconRequester_GetPathPart(path.s)
Protected pos.l
pos = FindString(path,",",1)
If pos > 0
path = Left(path,pos-1)
EndIf
ProcedureReturn path
EndProcedure
Procedure.l IconRequester_GetIconPart(path.s)
Protected pos.l
pos = FindString(path,",",1)
If pos > 0
path = Right(path,Len(path)-pos)
ProcedureReturn Val(path)
Else
ProcedureReturn 0
EndIf
EndProcedure
Procedure.s IconRequester(title.s,path.s)
Protected parent.l,idwnd.l,hwnd.l,quit.b,id.l,fine.b,flags.l
Protected idedit.l,idbrowse.l,hlist.l,idcancel.l,idokay.l
id = IconRequester_GetIconPart(path.s)
path = IconRequester_GetPathPart(path.s)
parent = GetActiveWindow_()
idwnd = OpenWindow(#PB_Any,0,0,320,310,title,#PB_Window_SystemMenu | #PB_Window_TitleBar | #PB_Window_WindowCentered,parent)
hwnd = WindowID(idwnd)
If hwnd <> 0
EnableWindow_(parent,#False)
SetWindowCallback(@IconRequester_WndProc(),idwnd)
If CreateGadgetList(hwnd)
TextGadget(#PB_Any,10,10,300,20,"Nach Symbolen in dieser Datei suchen:")
idedit = StringGadget(#PB_Any,10,30,190,20,path)
idbrowse = ButtonGadget(#PB_Any,210,30,100,20,"Durchsuchen...")
TextGadget(#PB_Any,10,60,300,20,"Wählen Sie ein Symbol aus der folgenden Liste aus:")
flags = #WS_BORDER|#WS_CHILD|#WS_HSCROLL|#WS_VISIBLE|#LBS_OWNERDRAWFIXED|#LBS_MULTICOLUMN|#LBS_NOINTEGRALHEIGHT
hlist = CreateWindow_("ListBox","",flags,10,80,300,180,hwnd,0,0,0)
SendMessage_(hlist,#LB_SETCOLUMNWIDTH,40,0)
SendMessage_(hlist,#LB_SETITEMHEIGHT,0,40)
idcancel = ButtonGadget(#PB_Any,100,270,100,30,"Abbrechen")
idokay = ButtonGadget(#PB_Any,210,270,100,30,"Übernehmen")
AddKeyboardShortcut(idwnd,#PB_Shortcut_Return,1)
fine = IconRequester_LoadIconList(hlist,path,id,title)
Repeat
Select WindowEvent()
Case #PB_Event_CloseWindow
quit = 1
Case #PB_Event_Gadget
Select EventGadget()
Case idcancel
quit = 1
Case idbrowse
path = OpenFileRequester(title,GetGadgetText(idedit),"Symboldateien (*.dll;*.exe;*.ico)|*.dll;*.exe;*.ico|Bibliotheken (*.dll)|*.dll|Programme (*.exe)|*.exe|Symbole (*.ico)|*.ico|Alle Dateien (*.*)|*.*",0)
SetGadgetText(idedit,path)
fine = IconRequester_LoadIconList(hlist,path,0,title)
Case idedit
If EventType() = #PB_EventType_LostFocus
fine = IconRequester_LoadIconList(hlist,GetGadgetText(idedit),0,title)
EndIf
Case idokay
path = GetGadgetText(idedit)+","+Str(SendMessage_(hlist,#LB_GETCURSEL,0,0))
CloseWindow(idwnd)
EnableWindow_(parent,#True)
SetActiveWindow_(parent)
If fine = #True
ProcedureReturn path
Else
ProcedureReturn ""
EndIf
EndSelect
Case #PB_Event_Menu
If EventMenu() = 1 And GetActiveGadget() = idedit
fine = IconRequester_LoadIconList(hlist,GetGadgetText(idedit),0,title)
EndIf
EndSelect
Until quit = 1
CloseWindow(idwnd)
EnableWindow_(parent,#True)
SetActiveWindow_(parent)
EndIf
EndIf
ProcedureReturn ""
EndProcedure
path.s = IconRequester("Change Icon...","%SystemRoot%\system32\shell32.dll,2")
Debug path
