Messagebox with custom icon from any EXE or DLL (Windows)

[RASHAD]

PB x86 & x64

Code: Select all

#MB_USERICON = $00000080
Global NewList IconGroupID(),msg.MSGBOXPARAMS,LibHandle,LibName$

Procedure EnumResNameProc(ResHandle, ResType, ResName, AppParam)
  AddElement(IconGroupID())
  IconGroupID() = ResName
  ProcedureReturn #True
EndProcedure

Procedure EnumResTypeProc(ResHandle, ResType, AppParam)
  If ResType = #RT_GROUP_ICON
      EnumResourceNames_(ResHandle, ResType, @EnumResNameProc(), 0)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure Icon_index(LibName$)
  LibHandle = LoadLibraryEx_(@LibName$, 0, #LOAD_LIBRARY_AS_DATAFILE)
  If LibHandle = 0
      MessageRequester("Error", "Unable to load library " + LibName$, #MB_ICONERROR)
      End
  EndIf
  EnumResourceTypes_(LibHandle, @EnumResTypeProc(), 0)
  ForEach IconGroupID()
      *GrpIconDir = LoadResource_(LibHandle, FindResource_(LibHandle, IconGroupID(), #RT_GROUP_ICON))
      Debug " Index "+Str(item)+" = "+Str(IconGroupID())
      item + 1
  Next
EndProcedure

LibName$ = "regedit.exe"
Icon_index(LibName$)

Lastindex = ListSize(IconGroupID()) - 1
SelectElement(IconGroupID(), 0)  ;Select any available index (from 0 to Lastindex)

With msg
  \cbSize = SizeOf(MSGBOXPARAMS)
  \hwndOwner = GetForegroundWindow_()
  \hInstance = LibHandle
  \lpszText = @"Text"
  \lpszCaption = @"Title"
  \dwStyle = #MB_USERICON | #MB_YESNO
  \lpszIcon = IconGroupID()
EndWith
MessageBoxIndirect_(@msg)
FreeLibrary_(LibHandle)

[kvitaliy]

Thank you, useful code!

[Kwai chang caine]

Cool, works great on W10
Thanks rashad

[RASHAD]

@kvitaliy
Thanks mate and it is a good opportunity to say thank you for the imitation coal drawing effect

@KCC
Thanks mate

Using Array instead of List
Much faster and easy to use

Code: Select all

#MB_USERICON = $00000080
Global Dim IconGroupID(0),msg.MSGBOXPARAMS,LibHandle,LibName$,item

Procedure EnumResNameProc(ResHandle, ResType, ResName, AppParam)
  IconGroupID(item) = ResName
  item + 1
  ReDim IconGroupID(item)
  ProcedureReturn #True
EndProcedure

Procedure EnumResTypeProc(ResHandle, ResType, AppParam)
  If ResType = #RT_GROUP_ICON
      EnumResourceNames_(ResHandle, ResType, @EnumResNameProc(), 0)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure Icon_index(LibName$)
  LibHandle = LoadLibraryEx_(@LibName$, 0, #LOAD_LIBRARY_AS_DATAFILE)
  If LibHandle = 0
      MessageRequester("Error", "Unable to load library " + LibName$, #MB_ICONERROR)
      End
  EndIf
  EnumResourceTypes_(LibHandle, @EnumResTypeProc(), 0)
  For item = 0 To ArraySize(IconGroupID())-1
      *GrpIconDir = LoadResource_(LibHandle, FindResource_(LibHandle, IconGroupID(item), #RT_GROUP_ICON))
      Debug " Index "+Str(item)+" = "+Str(IconGroupID(item))
  Next
EndProcedure

LibName$ = "explorer.exe"
Icon_index(LibName$)

With msg
  \cbSize = SizeOf(msg)
  \hwndOwner = GetForegroundWindow_()
  \hInstance = LibHandle
  \lpszText = @"Text"
  \lpszCaption = @"Title"
  \dwStyle = #MB_USERICON | #MB_YESNO
  \lpszIcon = IconGroupID(0)
EndWith
MessageBoxIndirect_(@msg)
FreeLibrary_(LibHandle)

[uweb]

Thank you RASHAD!
But with explorer.exe only icons above Index 0 are visible here (Win7 x64 PB 5.5).

Index 0 = 5471848
Index 1 = 101
Index 2 = 102
Index 3 = 103
Index 4 = 104
Index 5 = 107
Index 6 = 108
Index 7 = 109
Index 8 = 110
Index 9 = 111
Index 10 = 205
Index 11 = 250
Index 12 = 251
Index 13 = 252
Index 14 = 253
Index 15 = 254
Index 16 = 256
Index 17 = 257
Index 18 = 258
Index 19 = 259
Index 20 = 260
Index 21 = 261
Index 22 = 262
Index 23 = 500
Index 24 = 501

[RASHAD]

@uweb
Hi
Thanks for pointing out this bug
Please check
Edit : Compile in Unicode mode (ex PB 5.50)

Code: Select all

#MB_USERICON = $00000080
Global Dim IconGroupID.s(0),msg.MSGBOXPARAMS,LibHandle,LibName$,item

Procedure EnumResNameProc(ResHandle, ResType, ResName, AppParam)
  If ResName & $FFFF0000
    IconGroupID(item) = PeekS(ResName)
  Else 
    IconGroupID(item) = Str(ResName)
  EndIf
  item + 1
  ReDim IconGroupID(item)
  ProcedureReturn #True
EndProcedure

Procedure EnumResTypeProc(ResHandle, ResType, AppParam)
  If ResType = #RT_GROUP_ICON
      EnumResourceNames_(ResHandle, ResType, @EnumResNameProc(), 0)
  EndIf
  ProcedureReturn #True
EndProcedure

Procedure Icon_index(LibName$)
  LibHandle = LoadLibraryEx_(@LibName$, 0, #LOAD_LIBRARY_AS_DATAFILE)
  If LibHandle = 0
      MessageRequester("Error", "Unable to load library " + LibName$, #MB_ICONERROR)
      End
  EndIf
  EnumResourceTypes_(LibHandle, @EnumResTypeProc(), 0)
  For item = 0 To ArraySize(IconGroupID())-1
      *GrpIconDir = LoadResource_(LibHandle, FindResource_(LibHandle, IconGroupID(item), #RT_GROUP_ICON))
      Debug " Index "+Str(item)+" = "+ IconGroupID(item)
  Next
EndProcedure

LibName$ = "Explorer.exe"

Icon_index(LibName$)

;***************** Change the displayed icon index here ***************

ico.s = IconGroupID(0)

;***************************************************************
If ico = ""
  MessageRequester("Error","No such icon !",#MB_OK|#MB_ICONINFORMATION)
  End
Else
  iico = 0
  For i = 1 To Len(ico)
    If Asc(Mid(ico, i ,1)) > 57
       iico = 1
       Break
    EndIf
  Next
EndIf

With msg
  \cbSize = SizeOf(msg)
  \hwndOwner = GetForegroundWindow_()
  \hInstance = LibHandle
  \lpszText = @"Text"
  \lpszCaption = @"Title"
  \dwStyle = #MB_USERICON | #MB_YESNO
  If iico = 1
    \lpszIcon = @ico
  Else
    \lpszIcon = ValD(ico)
  EndIf
EndWith
MessageBoxIndirect_(@msg)
FreeLibrary_(LibHandle)

Edit :Modified for better performance

[uweb]

Now it works fine. Thank you!