Icon selector

Share your advanced PureBasic knowledge/code with the community.
User avatar
Le Soldat Inconnu
Enthusiast
Enthusiast
Posts: 306
Joined: Wed Jul 09, 2003 11:33 am
Location: France

Icon selector

Post by Le Soldat Inconnu »

Hi,

i do rpogram to get any icon from computer

it's allow to get icon used for file in explorer (for example to get icon of txt file) or icon included in dll or exe.

it's support size 16*16, 32*32, 48*48 and 128*128 or 256*256
(for 48*48, only on XP and more, for 128 and 256, only on Vista)

Sorry, code is in French

Bye

Code: Select all

; Auteur : Le Soldat Inconnu
; Version de PB : 4
;
; Explication du programme :
; Récupérer une icône de la taille 16*16, 32*32, 48*48

Procedure.s GetSpecialFolderLocation(Valeur.L) ; Récupère l'adresse d'un dossier spécifique de Windows
  Protected SpecialFolderLocation.s, Dossier_ID.L
  If SHGetSpecialFolderLocation_(0, Valeur, @Dossier_ID) = 0
    SpecialFolderLocation = Space(255)
    SHGetPathFromIDList_(Dossier_ID, @SpecialFolderLocation)
    If SpecialFolderLocation
      If Right(SpecialFolderLocation, 1) <> "\"
        SpecialFolderLocation + "\"
      EndIf
    EndIf
  EndIf
  ProcedureReturn SpecialFolderLocation
EndProcedure

#SHIL_SMALL = $1
#SHIL_LARGE = $0
#SHIL_EXTRALARGE = $2
#SHIL_JUMBO = $4

#LOAD_LIBRARY_AS_DATAFILE = 2

DataSection
  IID_IImageList:
  Data.L $46EB5926
  Data.w $582E,$4017
  Data.b $9F,$DF,$E8,$99,$8D,$AA,$09,$50
EndDataSection 
Structure IMAGELISTDRAWPARAMS
  cbSize.L
  himl.L
  i.L
  hdcDst.L
  x.L
  y.L
  cx.L
  cy.L
  xBitmap.L
  yBitmap.L
  rgbBk.L
  rgbFg.L
  fStyle.L
  dwRop.L
  fState.L
  frame.L
  crEffect.L
EndStructure
Interface IImageList2 Extends iUnknown
  Add(hbmImage, hbmMask, pi)
  ReplaceIcon(i, hIcon, pi)
  SetOverlayImage(iImage, iOverlay)
  Replace(i, hbmImage, hbmMask)
  AddMasked(hbmImage, crMask, pi)
  Draw(pimldp.IMAGELISTDRAWPARAMS)
  Remove(i)
  GetIcon(i, flags, picon)
  GetImageInfo(i, pImageInfo.IMAGEINFO)
  Copy(iDst, punkSrc.IImageList, iSrc, uFlags)
  Merge(i1, punk2.IImageList, i2, dx, dy, riid, ppv)
  Clone(riid, ppv)
  GetImageRect(i, prc.RECT)
  GetIconSize(cx, cy)
  SetIconSize(cx, cy)
  GetImageCount(pi)
  SetImageCount(uNewCount)
  SetBkColor(clrBk, pclr)
  GetBkColor(pclr)
  BeginDrag(iTrack, dxHotspot, dyHotspot)
  EndDrag()
  DragEnter(hwndLock, x, y)
  DragLeave(hwndLock)
  DragMove(x, y)
  SetDragCursorImage(punk.IImageList, iDrag, dxHotspot, dyHotspot)
  DragShowNolock(fShow)
  GetDragImage(ppt.POINT, pptHotspot.POINT, riid, ppv)
  GetItemFlags(i, dwFlags)
  GetOverlayImage(iOverlay, piIndex)
EndInterface


Global OS = OSVersion()
ProcedureDLL.l GetIconFile(IconFile.s, Size.l) ; Get icon 16*16, 32*32 or 48*48
  Protected hIcon.l, FileInfo.SHFILEINFO, dll_Shell32.l, hResult.l, *Guid.l
  Select Size
    Case #SHIL_SMALL, 16
      SHIL = #SHIL_SMALL
    Case #SHIL_LARGE, 32
      SHIL = #SHIL_LARGE
    Case #SHIL_EXTRALARGE, 48
      SHIL = #SHIL_EXTRALARGE
    Case #SHIL_JUMBO, 128, 256
      If OS >= #PB_OS_Windows_Vista
        SHIL = #SHIL_JUMBO
      Else
        SHIL = #SHIL_EXTRALARGE
      EndIf
    Default
      SHIL = #SHIL_SMALL
  EndSelect
  If OS >= #PB_OS_Windows_XP ; Pour Windows XP et plus, toute taille d'icône
    dll_Shell32 = OpenLibrary(#PB_Any, "Shell32.dll")
    If dll_Shell32
      *Guid = ?IID_IImageList
      SHGetFileInfo_(IconFile, 0, @FileInfo, SizeOf(SHFILEINFO), #SHGFI_SYSICONINDEX)
      hResult = CallFunction(dll_Shell32, "SHGetImageList", SHIL, *Guid, @ImageList.IImageList2)
      If hResult = 0
        ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @hIcon)
        ImageList\Release()
      EndIf
      CloseLibrary(dll_Shell32)
    EndIf
  Else ; Avant windows XP, icône 16*16 ou 32*32
    If SHIL = #SHIL_EXTRALARGE Or SHIL = #SHIL_LARGE
      SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_LARGEICON)
      hIcon = InfosFile\hIcon
    Else
      SHGetFileInfo_(IconFile, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | #SHGFI_SMALLICON)
      hIcon = InfosFile\hIcon
    EndIf
  EndIf
  ProcedureReturn hIcon
EndProcedure
ProcedureDLL.l GetSmallIconFile(IconFile.s) ; Get icon 16*16
  ; Cette procedure permet d'extraire l'ID de l'icône 16*16 associée au type de fichier ou au dossier dont l'adresse est IconFile
  ProcedureReturn GetIconFile(IconFile.s, 16)
EndProcedure
ProcedureDLL.l GetLargeIconFile(IconFile.s) ; Get icon 32*32
  ; Cette procedure permet d'extraire l'ID de l'icône 32*32 associée au type de fichier ou au dossier dont l'adresse est IconFile
  ProcedureReturn GetIconFile(IconFile.s, 32)
EndProcedure
ProcedureDLL.l GetExtraLargeIconFile(IconFile.s) ; Get icon 48*48
  ; Cette procedure permet d'extraire l'ID de l'icône 48*48 associée au type de fichier ou au dossier dont l'adresse est IconFile
  ProcedureReturn GetIconFile(IconFile.s, 48)
EndProcedure
ProcedureDLL.l GetJumboIconFile(IconFile.s) ; Get icon 128*128 or 256*256
  ; Cette procedure permet d'extraire l'ID de l'icône 128*128 ou 256*256 associée au type de fichier ou au dossier dont l'adresse est IconFile
  ProcedureReturn GetIconFile(IconFile.s, 128)
EndProcedure

Procedure GetIconIndexList_Enumerate(hLibrary, lpszType, lpszName, *Memory.Long)
  Protected Result.l, Name.s
  *Memory\l = ReAllocateMemory(*Memory\l, MemorySize(*Memory\l) + 4)
  If *Memory\l
    If lpszName >> 16
      Name = PeekS(lpszName) 
      lpszName = AllocateMemory(StringByteLength(Name + "0"))
      Debug Name
      PokeS(lpszName, Name)
    EndIf
    Debug lpszName
    PokeL(*Memory\l + MemorySize(*Memory\l) - 8, lpszName)
    Result = #True
  Else
    Result = #False
  EndIf 
  ProcedureReturn Result
EndProcedure
ProcedureDLL.l GetIconIndexList(IconFile.s) ; Get icon index list
  Protected hLibrary, Memory.l
  hLibrary = LoadLibraryEx_(IconFile, #NULL, #LOAD_LIBRARY_AS_DATAFILE)
  If hLibrary <> #NULL
    *Memory = AllocateMemory(4)
    If *Memory
      EnumResourceNames_(hLibrary, #RT_GROUP_ICON, @GetIconIndexList_Enumerate(), @*Memory)
    EndIf
    FreeLibrary_(hLibrary)
  EndIf
  ProcedureReturn *Memory
EndProcedure
ProcedureDLL FreeIconIndexList(Memory.l) ; Free icon index list
  Protected Index.l, Value.l
  Index = 0
  Repeat
    Value = PeekL(Memory + Index * 4) ; Numéro de l'icône
    If Value > 0
      If Value >> 16
        FreeMemory(Value)
      EndIf
      Index + 1
    EndIf
  Until Value = 0
  FreeMemory(Memory)
EndProcedure
ProcedureDLL ExtractIconFile(IconFile.s, IconIndex.l, Size.l) ; Extract icon from library or exe
  Protected hLibrary, hIcon.l
  If IconIndex > 0
    hLibrary = LoadLibraryEx_(IconFile, #NULL, #LOAD_LIBRARY_AS_DATAFILE)
    If hLibrary <> #NULL
      If IconIndex >> 16
        hIcon = LoadImage_(hLibrary, PeekS(IconIndex), #IMAGE_ICON, Size, Size, 0)
      Else
        hIcon = LoadImage_(hLibrary, IconIndex & $FFFF, #IMAGE_ICON, Size, Size, 0)
      EndIf
      FreeLibrary_(hLibrary)
    EndIf
  Else
    hIcon = GetIconFile(IconFile, Size)
  EndIf
  ProcedureReturn hIcon
EndProcedure
ProcedureDLL ExtractSmallIconFile(IconFile.s, IconIndex.l) ; Extract icon 16*16 from library or exe
  ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 16)
EndProcedure
ProcedureDLL ExtractLargeIconFile(IconFile.s, IconIndex.l) ; Extract icon 32*32 from library or exe
  ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 32)
EndProcedure
ProcedureDLL ExtractExtraLargeIconFile(IconFile.s, IconIndex.l) ; Extract icon 48*48 from library or exe
  ProcedureReturn ExtractIconFile(IconFile.s, IconIndex.l, 48)
EndProcedure


Structure IconFileRequester_IconInfo
  File.s
  Index.L
EndStructure
Procedure IconFileRequester(*Icon.IconFileRequester_IconInfo, WindowParentID.L = -1)
  Protected IconFileRequester_Window, IconFileRequester_Quit, IconFileRequester_Select, IconFileRequester_Index, IconFileRequester_File.s, IconFileRequester_NewFile.s
  Protected IconFileRequester_List, IconFileRequester_16, IconFileRequester_32, IconFileRequester_48, IconFileRequester_OpenFile, IconFileRequester_OpenDirectory, IconFileRequester_OK, IconFileRequester_String
  Protected NewList IconFileRequester_Icon()
  Protected IconFileRequester_Icon16, IconFileRequester_Icon32, IconFileRequester_Icon48, IconFileRequester_SearchIndex, IconFileRequester_SearchIcon, *IconFileRequester_ListIcon, IconFileRequester_ListIndex
  #IconFileRequester_X = 480
  #IconFileRequester_Y = 300
  #IconFileRequester_B = 4
  #IconFileRequester_Button = 75
  #IconFileRequester_StringY = 23
  IconFileRequester_File = *Icon\File
  If IconFileRequester_File = ""
    IconFileRequester_File = GetSpecialFolderLocation(41) + "shell32.dll"
  EndIf
  IconFileRequester_Index = *Icon\Index
  IconFileRequester_16 = #PB_Any
  If IsWindow(WindowParentID)
    ; On désactive la fenêtre mère
    DisableWindow(WindowParentID, 1)
    IconFileRequester_Window = OpenWindow(#PB_Any, 0, 0, #IconFileRequester_X, #IconFileRequester_Y, "Sélection d'une icône", #PB_Window_WindowCentered | #PB_Window_SystemMenu | #PB_Window_Invisible, WindowParentID)
  Else
    IconFileRequester_Window = OpenWindow(#PB_Any, 0, 0, #IconFileRequester_X, #IconFileRequester_Y, "Sélection d'une icône", #PB_Window_SystemMenu | #PB_Window_Invisible)
  EndIf
  IconFileRequester_Select = 0
  If IconFileRequester_Window
    ; Création des gadgets
    IconFileRequester_List = ListIconGadget(#PB_Any, #IconFileRequester_B, #IconFileRequester_B + #IconFileRequester_StringY, #IconFileRequester_X - 3 * #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_Y - 3 * #IconFileRequester_B - #IconFileRequester_Button - #IconFileRequester_StringY, "Icône", 100, #PB_ListIcon_AlwaysShowSelection)
    SetGadgetAttribute(IconFileRequester_List, #PB_ListIcon_DisplayMode, #PB_ListIcon_LargeIcon)
    IconFileRequester_String = StringGadget(#PB_Any, #IconFileRequester_B, #IconFileRequester_B, #IconFileRequester_X - 3 * #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_StringY, IconFileRequester_File)
    Frame3DGadget(#PB_Any, #IconFileRequester_B, #IconFileRequester_Y - #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_X - 3 * #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_Button, "Prévisualisation")
    IconFileRequester_OpenFile = ButtonGadget(#PB_Any, #IconFileRequester_X - #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_B, #IconFileRequester_Button, #IconFileRequester_Button, "Icône d'un fichier", #PB_Button_MultiLine)
    IconFileRequester_OpenDirectory = ButtonGadget(#PB_Any, #IconFileRequester_X - #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_B + #IconFileRequester_Button, #IconFileRequester_Button, #IconFileRequester_Button, "Icône d'un dossier", #PB_Button_MultiLine)
    IconFileRequester_OK = ButtonGadget(#PB_Any, #IconFileRequester_X - #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_Y - #IconFileRequester_B - #IconFileRequester_Button, #IconFileRequester_Button, #IconFileRequester_Button, "Valider", #PB_Button_MultiLine | #PB_Button_Default)
    HideWindow(IconFileRequester_Window, 0)
    ; On force l'actualisation de l'affichage
    IconFileRequester_Action = 1
    ; Boucle
    Repeat
      ; Actions à faire
      Repeat
        Select IconFileRequester_Action
          Case 1 ; Mise à jour de la liste des icônes
            ; On vide le ListIconGadget
            ClearGadgetItems(IconFileRequester_List)
            ; On supprime les anciennes icones
            ForEach IconFileRequester_Icon()
              DestroyIcon_(IconFileRequester_Icon())
            Next
            ClearList(IconFileRequester_Icon())
            ; On reremplie la liste
            ; Icône du fichier
            IconFileRequester_ListIndex = 0
            IconFileRequester_SearchIcon = GetIconFile(IconFileRequester_File, 32)
            AddGadgetItem(IconFileRequester_List, 0, "Icône du fichier", IconFileRequester_SearchIcon)
            SetGadgetState(IconFileRequester_List, 0)
            SetGadgetItemData(IconFileRequester_List, IconFileRequester_ListIndex, 0)
            ; Icônes contenu dans le fichier
            *IconFileRequester_ListIcon = GetIconIndexList(IconFileRequester_File) ; On liste tous les icônes
            If *IconFileRequester_ListIcon
              Repeat
                IconFileRequester_SearchIndex = PeekL(*IconFileRequester_ListIcon + IconFileRequester_ListIndex * 4) ; Numéro de l'icône
                IconFileRequester_ListIndex + 1
                If IconFileRequester_SearchIndex > 0
                  IconFileRequester_SearchIcon = ExtractIconFile(IconFileRequester_File, IconFileRequester_SearchIndex, 32) ; Extraction de l'icône
                  If IconFileRequester_SearchIcon > 0
                    ; Affichage de l'icône
                    AddElement(IconFileRequester_Icon())
                    IconFileRequester_Icon() = IconFileRequester_SearchIcon
                    If IconFileRequester_SearchIndex >> 16 = 0
                      AddGadgetItem(IconFileRequester_List, IconFileRequester_ListIndex, "Icône inclue " + Str(IconFileRequester_SearchIndex), IconFileRequester_SearchIcon)
                    Else
                      AddGadgetItem(IconFileRequester_List, IconFileRequester_ListIndex, "Icône inclue " + PeekS(IconFileRequester_SearchIndex), IconFileRequester_SearchIcon)
                    EndIf
                    SetGadgetItemData(IconFileRequester_List, IconFileRequester_ListIndex, IconFileRequester_SearchIndex)
                    If IconFileRequester_SearchIndex = IconFileRequester_Index ; Si c'est licône par défaut, on le sélectionne
                      SetGadgetState(IconFileRequester_List, IconFileRequester_ListIndex)
                    EndIf
                  EndIf
                EndIf
              Until IconFileRequester_SearchIndex = 0
              FreeIconIndexList(*IconFileRequester_ListIcon)
            EndIf
            ; On actualise l'aperçu
            IconFileRequester_Action = 2
          Case 2 ; Mise à jour des aperçus
            ; On supprime les anciennes icônes
            If IconFileRequester_Icon16
              DestroyIcon_(IconFileRequester_Icon16)
              IconFileRequester_Icon16 = 0
            EndIf
            If IconFileRequester_Icon32
              DestroyIcon_(IconFileRequester_Icon32)
              IconFileRequester_Icon32 = 0
            EndIf
            If IconFileRequester_Icon48
              DestroyIcon_(IconFileRequester_Icon48)
              IconFileRequester_Icon48 = 0
            EndIf
            ; On charge les nouvelles icones
            IconFileRequester_Icon16 = ExtractIconFile(IconFileRequester_File, IconFileRequester_Index, 16)
            IconFileRequester_Icon32 = ExtractIconFile(IconFileRequester_File, IconFileRequester_Index, 32)
            IconFileRequester_Icon48 = ExtractIconFile(IconFileRequester_File, IconFileRequester_Index, 48)
            If IsGadget(IconFileRequester_16)
              ; On actualise les images des gadgets
              If IconFileRequester_Icon16 > 0
                SetGadgetState(IconFileRequester_16, IconFileRequester_Icon16)
              Else
                FreeGadget(IconFileRequester_16)
              EndIf
              If IconFileRequester_Icon32 > 0
                SetGadgetState(IconFileRequester_32, IconFileRequester_Icon32)
              Else
                FreeGadget(IconFileRequester_32)
              EndIf
              If IconFileRequester_Icon48 > 0
                SetGadgetState(IconFileRequester_48, IconFileRequester_Icon48)
              Else
                FreeGadget(IconFileRequester_48)
              EndIf
            Else
              ; On crée les gadgets
              If IconFileRequester_Icon16 > 0
                IconFileRequester_16 = ImageGadget(#PB_Any, #IconFileRequester_B + 24, #IconFileRequester_Y - #IconFileRequester_B - #IconFileRequester_Button + 24, 16, 16, IconFileRequester_Icon16)
              EndIf
              If IconFileRequester_Icon32 > 0
                IconFileRequester_32 = ImageGadget(#PB_Any, #IconFileRequester_B * 2 + 24 + 16, #IconFileRequester_Y - #IconFileRequester_B - #IconFileRequester_Button + 24, 32, 32, IconFileRequester_Icon32)
              EndIf
              If IconFileRequester_Icon48 > 0
                IconFileRequester_48 = ImageGadget(#PB_Any, #IconFileRequester_B * 3 + 24 + 16 + 32, #IconFileRequester_Y - #IconFileRequester_B - #IconFileRequester_Button + 24, 48, 48, IconFileRequester_Icon48)
              EndIf
            EndIf
            IconFileRequester_Action = 0
          Case 3 ; Mise à jour du StringGadget
            SetGadgetText(IconFileRequester_String, IconFileRequester_File)
            IconFileRequester_Action = 1
        EndSelect
      Until IconFileRequester_Action = 0
      ; Boucle d'évènements
      IconFileRequester_Event = WaitWindowEvent()
      If EventWindow() = IconFileRequester_Window
        Select IconFileRequester_Event
          Case #PB_Event_Gadget
            Select EventGadget()
              Case IconFileRequester_OpenFile
                IconFileRequester_NewFile = OpenFileRequester("Ouvrir", IconFileRequester_File, "Tous les fichiers|*.*", 0)
                If IconFileRequester_NewFile
                  IconFileRequester_File = IconFileRequester_NewFile
                  IconFileRequester_Index = 0
                  IconFileRequester_Action = 3
                EndIf
              Case IconFileRequester_OpenDirectory
                IconFileRequester_NewFile = PathRequester("Ouvrir", GetPathPart(IconFileRequester_File))
                If IconFileRequester_NewFile
                  IconFileRequester_File = IconFileRequester_NewFile
                  IconFileRequester_Index = 0
                  IconFileRequester_Action = 3
                EndIf
              Case IconFileRequester_List
                If GetGadgetState(IconFileRequester_List) >= 0
                  IconFileRequester_Index = GetGadgetItemData(IconFileRequester_List, GetGadgetState(IconFileRequester_List))
                  IconFileRequester_Action = 2
                Else
                  For IconFileRequester_ListIndex = 0 To CountGadgetItems(IconFileRequester_List) - 1
                    If IconFileRequester_Index = GetGadgetItemData(IconFileRequester_List, IconFileRequester_ListIndex)
                      SetGadgetState(IconFileRequester_List, IconFileRequester_ListIndex)
                    EndIf
                  Next
                EndIf
              Case IconFileRequester_String
                If EventType() = #PB_EventType_Change
                  If FileSize(GetGadgetText(IconFileRequester_String)) <> -1
                    IconFileRequester_File = GetGadgetText(IconFileRequester_String)
                    IconFileRequester_Index = 0
                    IconFileRequester_Action = 1
                  EndIf
                EndIf
              Case IconFileRequester_OK
                ; On envoie les nouvelles valeurs en résultat
                *Icon\File = IconFileRequester_File
                *Icon\Index = IconFileRequester_Index
                IconFileRequester_Select = 1
                IconFileRequester_Quit = 1
            EndSelect
          Case #PB_Event_CloseWindow
            IconFileRequester_Quit = 1
        EndSelect
      EndIf
    Until IconFileRequester_Quit
    CloseWindow(IconFileRequester_Window)
    ; On supprime les icones ouvertes
    ForEach IconFileRequester_Icon()
      DestroyIcon_(IconFileRequester_Icon())
    Next
    If IconFileRequester_Icon16
      DestroyIcon_(IconFileRequester_Icon16)
    EndIf
    If IconFileRequester_Icon32
      DestroyIcon_(IconFileRequester_Icon32)
    EndIf
    If IconFileRequester_Icon48
      DestroyIcon_(IconFileRequester_Icon48)
    EndIf
  EndIf
  If IsWindow(WindowParentID)
    ; On réactive la fenêtre mère
    DisableWindow(WindowParentID, 0)
    SetActiveWindow(WindowParentID)
  EndIf
  ProcedureReturn IconFileRequester_Select
EndProcedure



; Création de la fenêtre et de la GadgetList
If OpenWindow(0, 0, 0, 500, 500, "Test", #PB_Window_SystemMenu | #PB_Window_ScreenCentered | #PB_Window_MinimizeGadget) = 0
  End
EndIf

Icone.IconFileRequester_IconInfo
Icone\File = GetSpecialFolderLocation(41) + "shell32.dll"
Icone\Index = -1
hIcone = ExtractIconFile(Icone\File, Icone\Index, 48)
ButtonImageGadget(0, 50, 50, 100, 100, hIcone)

Repeat
  Event = WaitWindowEvent()
  Select Event
    Case #PB_Event_Gadget
      Select EventGadget()
        Case 0
          If IconFileRequester(@Icone, 0)
            VielleIcone = hIcone
            hIcone = ExtractIconFile(Icone\File, Icone\Index, 48)
            If VielleIcone
              DestroyIcon_(VielleIcone)
            EndIf
            SetGadgetAttribute(0, #PB_Button_Image, hIcone)
          EndIf
      EndSelect
  EndSelect
  
Until Event = #PB_Event_CloseWindow

If hIcone
  DestroyIcon_(hIcone)
EndIf
Last edited by Le Soldat Inconnu on Fri May 22, 2009 10:46 am, edited 3 times in total.
LSI
rsts
Addict
Addict
Posts: 2736
Joined: Wed Aug 24, 2005 8:39 am
Location: Southwest OH - USA

Post by rsts »

Nice.

Useful too :)

Thanks for sharing.
User avatar
netmaestro
PureBasic Bullfrog
PureBasic Bullfrog
Posts: 8451
Joined: Wed Jul 06, 2005 5:42 am
Location: Fort Nelson, BC, Canada

Post by netmaestro »

Looks very good overall, but I'm getting an IMA on ProcedureReturn from the IconFileRequester procedure sometimes. It seems to occur more often when I select an icon far down the list. (it's finding 306 icons)
BERESHEIT
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Crashes 50% of the time here regardless of which icon I select.

There are certain obvious problems with the code which, when I fix, doesn't stop the crashing! :)

@Le Soldat Inconnu : you need to use the Release() method on the iImageList objects you retrieve when you are finished with them. Also take a look at your ReallocateMemory() in the IconFileRequester function. ReallocateMemory() can change the address of the memory buffer so you need to check for a zero return and then, if non-zero, reassign the buffer address etc.

As to why it is crashing so often....? Unknown! :)
I may look like a mule, but I'm not a complete ass.
User avatar
Le Soldat Inconnu
Enthusiast
Enthusiast
Posts: 306
Joined: Wed Jul 09, 2003 11:33 am
Location: France

Post by Le Soldat Inconnu »

oh yes, you have right, i do mistake with reallocatememory

what do you mean with
you need to use the Release() method on the iImageList objects you retrieve when you are finished with them
I don't catch what i have to release.
Thanks
LSI
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

When you retrieve some COM object from a function or other then you must release that object when you are finished with it. If you don't then the underlying component may never be released and can result in a memory leak etc.

In your GetIconFile() function, replace :

Code: Select all

If hResult = 0 
  ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @hIcon) 
EndIf 
with

Code: Select all

If hResult = 0 
  ImageList\GetIcon(FileInfo\iIcon, #ILD_TRANSPARENT, @hIcon) 
  ImageList\Release()
EndIf 
I may look like a mule, but I'm not a complete ass.
User avatar
Le Soldat Inconnu
Enthusiast
Enthusiast
Posts: 306
Joined: Wed Jul 09, 2003 11:33 am
Location: France

Post by Le Soldat Inconnu »

oki :)

I do all corrections

I hope it will don't crash again :wink:
LSI
Hi-Toro
Enthusiast
Enthusiast
Posts: 270
Joined: Sat Apr 26, 2003 3:23 pm

Post by Hi-Toro »

This is great -- I needed something like this, and I had no crashes even after selecting icons from a few files. Is it public domain code, ie. can it be used freely for any purpose?
James Boyd
http://www.hi-toro.com/
Death to the Pixies!
User avatar
Le Soldat Inconnu
Enthusiast
Enthusiast
Posts: 306
Joined: Wed Jul 09, 2003 11:33 am
Location: France

Post by Le Soldat Inconnu »

I do all myself (thanks for help), and you can use all function like you want
LSI
srod
PureBasic Expert
PureBasic Expert
Posts: 10589
Joined: Wed Oct 29, 2003 4:35 pm
Location: Beyond the pale...

Post by srod »

Yep no crashes now! 8)

Well done and thanks for sharing.
I may look like a mule, but I'm not a complete ass.
User avatar
Le Soldat Inconnu
Enthusiast
Enthusiast
Posts: 306
Joined: Wed Jul 09, 2003 11:33 am
Location: France

Post by Le Soldat Inconnu »

Code Update : (see first message)

I add support for icon with String ressources name (Normally, Icon have number for ressource name, but sometime, it's string)
LSI
Tranquil
Addict
Addict
Posts: 952
Joined: Mon Apr 28, 2003 2:22 pm
Location: Europe

Post by Tranquil »

This is a great code! Look what I need for my actual project.
And the credits gi ti... Le Soldat Inconnu. :)

Thanks for posting!
Tranquil
Hi-Toro
Enthusiast
Enthusiast
Posts: 270
Joined: Sat Apr 26, 2003 3:23 pm

Post by Hi-Toro »

Excellent, thanks LSI!
Post Reply