PureBoard

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

Code: Alles auswählen

Prototype.l PickIconW(WindowID,IconFile.p-unicode,Maxfile.l,IconIndex.l)
Prototype.l PickIconA(WindowID,IconFile.p-ascii,Maxfile.l,IconIndex.l)

Procedure.s PickIconEx(WindowID)
Library = OpenLibrary(0,"shell32")
Buffer$ = Space(128)
GetSystemDirectory_(@Buffer$,128);Systemordner ermitteln
IconFile$ = Buffer$+"\shell32.dll";IconFile anhaengen
IconIndex = -1

;wenn NT dann UNICODE
Select OSVersion()
Case #PB_OS_Windows_95,#PB_OS_Windows_98,#PB_OS_Windows_ME 
  Pick.PickIconA = GetProcAddress_(Library,62);Funktionsadresse ermitteln
  Pick(WindowID,IconFile$,@MaxFile,@IconIndex)
Default
  Pick.PickIconW = GetProcAddress_(Library,62);Funktionsadresse ermitteln
  Pick(WindowID,IconFile$,@MaxFile,@IconIndex)
EndSelect
CloseLibrary(0)
ProcedureReturn IconFile$+","+Str(IconIndex)
EndProcedure

Path.s = PickIconEX(0)
Debug Path