PureBasic

Bonjour a tous

je decouvre purebasic (je connais le c++) et j'ai un probleme. Je souhaiterais creer un menu popup depuis le systray (jusque la pas de probleme) et mettre une icone sur le cote de chaque entre du menu. Jusque la, j'ai pas de probleme. La ou j'en ai un, c'est que je souhaiterais que ces icones soient celle d'un fichier exe (ou dll).

Code : Tout sélectionner

Global PopUpMenu
Global nomessai.s = "c:\windows\system32\shell32.dll"
Global idicon
Enumeration
  #windows_1
  #popupmenu_1 
  #MENU_1 
EndEnumeration 

Declare GetExeIcon()
Declare CatchExeSmallIcon()
Declare CatchExeBigIcon()
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Procedure fenetretray()
  If OpenWindow(#windows_1, 100, 150, 300, 100, "H.L.M.",#PB_Window_SystemMenu)

  PopUpMenu= CreatePopupMenu(#popupmenu_1)        ; La création du menu contextuel commence...
        MenuItem(#MENU_1, "ouvrir")    ; comme si c'était un menu normal...
CatchExeSmallIcon()
SetMenuItemBitmaps_(PopUpMenu, #MENU_1,  #MF_BYCOMMAND, idicon,idicon)
  EndIf 
EndProcedure


Procedure.l CatchExeIcon( Flags.l)
  ExeName.s = Space(255)
  GetModuleFileName_(0, @ExeName, 255)
  SHGetFileInfo_(nomessai, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | Flags)
  idicon=InfosFile\hIcon
  ProcedureReturn idicon
EndProcedure

Procedure.l CatchExeBigIcon()
  ProcedureReturn CatchExeIcon(#SHGFI_LARGEICON)
EndProcedure

Procedure.l CatchExeSmallIcon()
  ProcedureReturn CatchExeIcon(#SHGFI_SMALLICON)
EndProcedure
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

fenetretray()
  AddSysTrayIcon(1, WindowID(0), LoadImage(1000, "back.ico"))
  SysTrayIconToolTip(1, "tray1")
  
  Repeat
    Event = WaitWindowEvent()   
    If Event = #PB_Event_SysTray ; si clique sur systray
      If EventType() = #PB_EventType_LeftClick
         DisplayPopupMenu(#popupmenu_1,WindowID(0))
      EndIf
      If EventType() = #PB_EventType_RightClick
        Event = #PB_Event_CloseWindow
      EndIf
    EndIf
  Until Event = #PB_Event_CloseWindow

le probleme semble etre par ici "SetMenuItemBitmaps_(PopUpMenu, #MENU_1, #MF_BYCOMMAND, idicon,idicon)" mais je vois pas quoi faire.

Salut,

Tiens, voilà un code que j'ai récupéré et qui pourra t'aider. Il te demande d'ouvrir un fichier EXE ou ICO contenant des icônes pour les explorer. Les DLLs, je ne sais pas, je n'ai pas encore eu besoin de me servir de cette application pour pouvoir t'informer plus.

Bonne bourre

Code : Tout sélectionner

; Idea from Rikuk 
; File specifies the File where Icon is extracted 
; Icon = 0 To ? --> Return handle of Image 
; Icon = -1 --> Return the count of Icon 

Procedure IconExtract(File.s,Icon.l) 
  ProcedureReturn ExtractIcon_(0,File,Icon) 
EndProcedure 

fichier$ = OpenFileRequester("ouvrir fichier icone","","Fichier|*.*",0) 
;/ Test 

Count=IconExtract(fichier$,-1) 
OpenWindow(0,0,0,130,80,Str(Count)+" Icons",#PB_Window_SystemMenu|#PB_Window_ScreenCentered) 
CreateGadgetList(WindowID(0)) 
ButtonImageGadget(0,10,10,48,48,IconExtract(fichier$,pointer)) 
TextGadget(1,80,30,40,20,"n° 1") 
TextGadget(2,10,60,130,20,GetFilePart(fichier$)) 


Repeat 
  event=WaitWindowEvent() 
  
  If event= #PB_Event_Gadget And EventGadget()=0 And EventType()=#PB_EventType_LeftClick 
    pointer+1 
    If pointer=Count : pointer=0 : EndIf 
    SetGadgetState(0,IconExtract(fichier$,pointer)) 
    SetGadgetText(1,"n° "+Str(pointer+1)) 
  EndIf 
Until event=#PB_Event_CloseWindow

ca ne m'aide pas car c'est pour le mettre dans le menu que ca bloque

Oui j'ai vu que je ne répondais pas à ta question... Je suis en train de voir s'il y a solution à ce petit souci. On va partir de bcp plus simple: une icône là-dedans ce sera déjà pas mal:

Code : Tout sélectionner

OpenWindow(0, 0, 0, 400, 300, "rf", #PB_Window_SystemMenu)
CreateMenu(0, WindowID(0) )
OpenSubMenu("Fichier")
  MenuItem(0, "Quitte")
CloseSubMenu()
;ici...
Repeat
  Ev = WaitWindowEvent()
Until Ev = #PB_Event_CloseWindow

J'espère qu'un pro pourra répondre à ton message. La Doc de l'api en anglais me ruine le bulbe. Je n'arrive à exécuter une seule fois cette fonction setMenuItemBitMap. Elle me met toujours une erreur.

Dans ton exemple, j'ai du mal à saisir la partie où tu récupères la petite icône. En particulier, idicon=InfosFile\hIcon dans CatchIconExe() :
Il n'y a pas de structure à définir ? (peut-être que je me goure et qu'elle est déjà définie mais bon...)

Ensuite, avec ma méthode, je récupère des icônes mais elles ne correspondent pas à la taille (13x13).

hap! trouvé! mais jvais à lidl avant que ça ferme!

au debut la procedure n'etait pas

Code : Tout sélectionner

  idicon=InfosFile\hIcon
  ProcedureReturn idicon

mais

Code : Tout sélectionner

ProcedureReturn InfosFile\hIcon

je voulais juste voir si cela changeait quelque chose mais helas non.

Donc j'ai péché ce code ultra bien fait.

http://www.purebasic.fr/english/viewtop ... tembitmaps

(Inutile de dire que je vais mettre un mois à le comprendre) Il y a l'inclusion et l'exemple:

Code : Tout sélectionner

;By Trond 

Procedure MenuItemEx(MenuItemID, Text.s, Icon.l) 
  MenuItem(MenuItemID, Text) 
  If Icon 
    Icon = Icon ;CatchImage(#PB_Any, Icon) 
  EndIf 
  ModifyMenu_(MenuID(0), MenuItemID, #MF_OWNERDRAW, MenuItemID, Icon) 
EndProcedure 

Procedure MenuItemFix(MenuItemID) 
  ModifyMenu_(MenuID(0), MenuItemID, #MF_OWNERDRAW, MenuItemID, 0) 
EndProcedure 

Procedure MeasureMenuItem(WindowID, Message, wParam, lParam) 
  Protected ItemHeight.l = 20 
  Protected *MeasureItem.MEASUREITEMSTRUCT = lParam 
  Protected Text.s 
  Protected Img.l 
  Protected hDC.l 
  Protected Rect.RECT 
  Protected TextWidth.l 
  Protected Metrics.NONCLIENTMETRICS 
  Protected MenuFont.l 
  If *MeasureItem\CtlType = #ODT_MENU 
    Text = Space(8192) 
    GetMenuString_(MenuID(0), *MeasureItem\itemID, @Text, 8192, 0) 
    
    Img = CreateImage(-1, 1, 1) 
    hDC = StartDrawing(ImageOutput(Img)) 
      Metrics\cbSize = SizeOf(NONCLIENTMETRICS) 
      SystemParametersInfo_(#SPI_GETNONCLIENTMETRICS, SizeOf(NONCLIENTMETRICS), @Metrics, 0) 
      MenuFont = CreateFontIndirect_(@Metrics\lfMenuFont) 
      SelectObject_(hDC, MenuFont) 
      SetTextAlign_(hDC,#TA_LEFT|#TA_TOP|#TA_NOUPDATECP) 
      Rect.RECT\Right = 0 
      Rect\Bottom = 0 
      DrawText_(hDC, Text, Len(Text), @Rect, #DT_CALCRECT | #DT_EXPANDTABS | #DT_NOCLIP   | #DT_SINGLELINE) 
      *MeasureItem\itemWidth = ItemHeight + Rect\Right ;TextWidth(ReplaceString(Text, #TAB$, Space(8))) 
    StopDrawing() 
    
    With *MeasureItem 
      If \itemWidth < 100 
        \itemWidth = 100 
      EndIf 
    EndWith 
    
    FreeImage(Img) 
    DeleteObject_(MenuFont) 
    *MeasureItem\itemHeight = ItemHeight 
  EndIf 
EndProcedure 

Procedure DrawMenuItem(WindowID, Message, wParam, lParam) 
  Protected ItemHeight.l = 20 
  Protected ItemWidth.l = 24 
  Protected *DrawItem.DRAWITEMSTRUCT = lParam 
  Protected Item.MENUITEMINFO 
  Protected Glyph.l = *DrawItem\itemData 
  Protected Text.s = Space(8192) 
  Protected hDC 
  Protected Left, Top, Right, Bottom 
  Protected Brush1, Pen1 
  Protected DrawFlag 
  GetMenuString_(MenuID(0), *DrawItem\itemID, @Text.s, 8192, 0) 
  If *DrawItem\CtlType = #ODT_MENU 
    hDC = *DrawItem\hDC 
    Left   = *DrawItem\rcItem\left 
    Top    = *DrawItem\rcItem\top 
    Right  = *DrawItem\rcItem\right 
    Bottom = *DrawItem\rcItem\bottom 
    If (#ODS_SELECTED & *DrawItem\itemState) 
      If (#ODS_GRAYED & *DrawItem\itemState) 
        Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU)) 
        SetTextColor_(hDC, GetSysColor_(#COLOR_GRAYTEXT)) 
        Pen1   = CreateSolidBrush_(GetSysColor_(#COLOR_MENU)) 
      Else 
        Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_HIGHLIGHT)) 
        SetTextColor_(hDC, GetSysColor_(#COLOR_HIGHLIGHTTEXT)) 
        Pen1   = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_HIGHLIGHT)) 
      EndIf 
    ElseIf (#ODS_GRAYED & *DrawItem\itemState) 
      Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU)) 
      SetTextColor_(hDC, GetSysColor_(#COLOR_GRAYTEXT)) 
      Pen1   = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_MENU)) 
    Else 
      Brush1 = CreateSolidBrush_(GetSysColor_(#COLOR_MENU)) 
      SetTextColor_(hDC, GetSysColor_(#COLOR_MENUTEXT)) 
      Pen1   = CreatePen_(#PS_SOLID, 1, GetSysColor_(#COLOR_MENU)) 
    EndIf 
    SelectObject_(hDC, Brush1) 
    SelectObject_(hDC, Pen1) 
    Rectangle_(hDC, Left, Top, Right, Bottom) 
    SetBkMode_(hDC, #TRANSPARENT) 
    *DrawItem\rcItem\left + ItemWidth + 3 
    SystemParametersInfo_(#SPI_GETKEYBOARDCUES, 0, @DrawFlag, 0) 
    If (Not DrawFlag) And ((*DrawItem\itemState | #ODS_NOACCEL) = *DrawItem\itemState) 
      DrawFlag = #DT_HIDEPREFIX 
    Else 
      DrawFlag = 0 
    EndIf 
    DrawFlag = DrawFlag | #DT_SINGLELINE | #DT_VCENTER | #DT_EXPANDTABS 
    DrawText_(hDC, Text, Len(Text), *DrawItem\rcItem, DrawFlag) 
    *DrawItem\rcItem\left - ItemHeight 
    If Glyph 
      ;hDCGlyph = StartDrawing(ImageOutput(Glyph)) 
      ;BitBlt_(hDC, (ItemHeight-ImageHeight(Glyph))/2, (ItemHeight-ImageHeight(Glyph))/2 + Top, ImageWidth(Glyph), ImageHeight(Glyph), hDCGlyph, 0, 0, #SRCCOPY) 
      ;StopDrawing() 
      DrawIconEx_(hDC, (ItemWidth-ImageWidth(Glyph))/2, (ItemHeight-ImageHeight(Glyph))/2 + Top, ImageID(Glyph), ImageWidth(Glyph), ImageHeight(Glyph), 0, 0, #DI_NORMAL | #DI_COMPAT) 
    EndIf 
    DeleteObject_(Pen1) 
    DeleteObject_(Brush1) 
  EndIf 
EndProcedure

Code : Tout sélectionner

XIncludeFile "super_menu_system.pbi" 

Procedure MainWindowCallback(WindowID, Message, wParam, lParam) 
  Protected Result = #PB_ProcessPureBasicEvents 
    Select Message 
      Case #WM_MEASUREITEM 
        MeasureMenuItem(WindowID, Message, wParam, lParam) 
      Case #WM_DRAWITEM 
        DrawMenuItem(WindowID, Message, wParam, lParam) 
    EndSelect 
  ProcedureReturn Result 
EndProcedure 

OpenWindow(0, 0, 0, 512, 384, "", #PB_Window_ScreenCentered | #PB_Window_SystemMenu) 
CreateGadgetList(WindowID(0)) 
SetWindowCallback(@MainWindowCallback(), 0) 
  CreateMenu(0, WindowID(MainWindow)) 
    MenuTitle("&File") 
    n = LoadImage(-1, "tonicone.ico")
      MenuItemEx(00, "&Open", n) 
  

Repeat 
  Select WaitWindowEvent() 
    Case #PB_Event_CloseWindow 
      Break 
  EndSelect 
ForEver

Rem : S'il y a tant de lignes c'est parce qu'il y a plusieurs fonctions. Je n'ai pas du tout regardé. Par contre, tu mets le nom de fichier icône à la place de "tonicone.ico".

j'avais deja vu ce programme, mais c'est 99% de c et 1% de purebasic.
et apres essai, ca fonctionne toujours pas sur un exe.

Le probleme semble venir du fait que tous les programme avec menu+icone font du LOADIMAGE, pas des icones.

Apres avoir refait un peu du programme, j'ai trouvée une astuce :

Code : Tout sélectionner

Procedure fenetretray()
  If OpenWindow(#windows_1, 100, 150, 300, 100, "H.L.M.",#PB_Window_SystemMenu)
  PopUpMenu= CreatePopupMenu(#popupmenu_1)        ; La création du menu contextuel commence...
        MenuItem(#MENU_1, "       ouvrir")    ; comme si c'était un menu normal...
        MenuItem(#MENU_2, "       e2")
 EndIf 
EndProcedure

Procedure.l CatchExeIcon( Flags.l)
  ExeName.s = Space(255)
  GetModuleFileName_(0, @ExeName, 255)
  SHGetFileInfo_(nomessai, 0, @InfosFile.SHFILEINFO, SizeOf(SHFILEINFO), #SHGFI_ICON | Flags)
  idicon=InfosFile\hIcon
EndProcedure

Procedure.l CatchExeBigIcon()
  ProcedureReturn CatchExeIcon(#SHGFI_LARGEICON)
EndProcedure

Procedure.l CatchExeSmallIcon()
  ProcedureReturn CatchExeIcon(#SHGFI_SMALLICON)
EndProcedure 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
fenetretray()

CatchExeSmallIcon()

 If CreateImage(#imagetest, 16, 16)
    If StartDrawing(ImageOutput(#imagetest))
DrawImage(idicon,0,0)
      StopDrawing()
    Else  
      Debug "erreur"
    EndIf
  EndIf
  CreateGadgetList(WindowID(0))
  ImageGadget(0, 0, 0, 0, 0,ImageID(#imagetest))


SetMenuItemBitmaps_(PopUpMenu, #MENU_1,  #MF_BYCOMMAND,ImageID(#imagetest),ImageID(#imagetest))


  AddSysTrayIcon(1, WindowID(0), idicon)
.........

c'est pas tres elegant, mais j'ai pas trouvée d'autres moyen pour le moment.

Je ne comprends pas trop ton pourcentage. Enfin, ce n'est pas grave.

Maintenant, excuse-moi mais je ne peux pas m'investir trop dans ce code juste pour une ou deux icônes dans un menu.

Laisse quelques heures passer que des personnes expérimentées rentrent du week-end pour voir ton post. Il y a forcément solution et ça ne t'empêchera pas d'avancer dans ton projet en attendant.

Il y a malgré tout une foule de fonctions complètement gérées par le compilateur PureBasic. C'est vrai que celle-là n'en fait pas partie.

Pour ton souci de compilation, ne t'inquiète pas. Insère cette procédure en tête de ton programme :

Code : Tout sélectionner

Procedure Deb(Message.S)
  MessageRequester("", Message, 0)
EndProcedure

C'est tout bête mais cerne le souci en bombardant ton EXE de ses appels pour afficher les états de fonctionnement et pour vérifier si ton EXE trouve le bon chemin.("Deb(Str(FileIs("Fichier.DLL") ) ) " par exemple)

A mon avis, c'est un réglage des chemins dans les options du compilateur qui te pose souci. En plus, il me semble que la DLL que tu appelles n'est pas 'embarquée'. Là encore, ça fait seulement 3 semaines que je travaille avec PureBasic, je n'ai pas étudié cette problématique.

Une règle d'or : si ça marche dans ton éditeur, ça marchera obligatoirement dans ton EXE (les pros me contrediront si je me goure mais je ne pense pas me tromper à ce sujet)

Seulement, il y a deux trois réglages à prendre en main. Une fois cet obstacle franchi, ça te semblera plus aisé pour bosser.

Au fait, quelle version tu as?

Le callback ça fait aussi partie de purebasic. Il me semble aussi que c'est une question de compatibilité avec d'éventuelles versions à venir.

Je vais étudier bientôt l'exemple de Trond au-dessus bien que je ne cerne pas trop ton problème.

On peut charger des icônes et des images. On peut mettre une icône dans un menu désormais. Reste peut-être à raccourcir le code pour arriver à de telle fins.

Hello,

Est-ce que quelqu'un a réussi à ajouter une icône à un OpenSubMenu() ?
Je sais pas si c'est possible. J'espère que la solution n'est pas de passer par l'appel API pour créer leSubMenu (pour récupérer l'ID).

Merci d'avance.
Lio

PureBasic

icone d'un exe dans un menu flottant

icone d'un exe dans un menu flottant