2013-06-19 07:50

' Attention!  Si l'item est masqué (.Visible = False)
' l'icône devra être appliquée à nouveau une fois
' visible (.Visible = True)

'
'    BMPMenu.BMPHandle = Snew_bmp
'    ' Par position
'    CreateMenuBitmap (Popup1, 0, MF_BYPOSITION_AMIB, BMPMenu)
'    ' Par command
'    CreateMenuBitmap (Popup1, Item1.Command, 0, BMPMenu)
'

     $IFNDEF _AMIB
      $DEFINE _AMIB
      $OPTION EXPLICIT

      DECLARE FUNCTION CreateCompatibleBitmap_AMIB LIB "gdi32" ALIAS "CreateCompatibleBitmap" ( _
       BYVAL hdc AS LONG, BYVAL nWidth AS LONG, BYVAL nHeight AS LONG) AS LONG
      DECLARE FUNCTION CreateCompatibleDC_AMIB LIB "gdi32" ALIAS "CreateCompatibleDC" ( _
       BYVAL hdc AS LONG) AS LONG
      DECLARE FUNCTION DeleteDC_AMIB LIB "gdi32" ALIAS "DeleteDC" ( _
       BYVAL hdc AS LONG) AS LONG
      DECLARE FUNCTION DeleteObject_AMIB LIB "gdi32" ALIAS "DeleteObject" ( _
       BYVAL hObject AS LONG) AS LONG
      DECLARE FUNCTION SelectObject_AMIB LIB "gdi32" ALIAS "SelectObject" ( _
       BYVAL hdc AS LONG, BYVAL hObject AS LONG) AS LONG
      DECLARE FUNCTION SetBkMode_AMIB LIB "gdi32" ALIAS "SetBkMode" ( _
       BYVAL hdc AS LONG, BYVAL nBkMode AS LONG) AS LONG

      DECLARE FUNCTION GetSystemMetrics_AMIB LIB "user32" ALIAS "GetSystemMetrics" ( _
       BYVAL nIndex AS LONG) AS LONG

      DECLARE FUNCTION PatBlt_AMIB LIB "gdi32" ALIAS "PatBlt" ( _
       BYVAL hdc AS LONG, _
       BYVAL x AS LONG, BYVAL y AS LONG, _
       BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
       BYVAL dwRop AS LONG) AS LONG
      DECLARE FUNCTION TransparentBlt_AMIB LIB "msimg32.dll" ALIAS "TransparentBlt" ( _
       BYVAL hdc AS LONG, _
       BYVAL x AS LONG, BYVAL y AS LONG, _
       BYVAL nWidth AS LONG, BYVAL nHeight AS LONG, _
       BYVAL hSrcDC AS LONG, _
       BYVAL xSrc AS LONG, BYVAL ySrc AS LONG, _
       BYVAL nSrcWidth AS LONG, BYVAL nSrcHeight AS LONG, _
       BYVAL crTransparent AS LONG) AS LONG


      DECLARE FUNCTION SetMenuItemBitmaps_AMIB LIB "user32" ALIAS "SetMenuItemBitmaps" ( _
       BYVAL hMenu AS LONG, _
       BYVAL nPosition AS LONG, _
       BYVAL wFlags AS LONG, _
       BYVAL hBitmapUnchecked AS LONG, _
       BYVAL hBitmapChecked AS LONG) AS LONG

      CONST MF_BYCOMMAND_AMIB AS LONG		= &H0
      CONST MF_BYPOSITION_AMIB AS LONG	= &H400

      CONST WHITENESS_AMIB AS LONG		= &HFF0062
      CONST TRANSPARENT_AMIB				= 1

      TYPE Size_AMIB
       cx	AS LONG
       cy	AS LONG
      END TYPE

      CONST SM_CXMENUCHECK_AMIB AS LONG	= 71
      CONST SM_CYMENUCHECK_AMIB AS LONG	= 72

      DIM hwndDesktop_AMIB AS LONG, _
       hdcDesktop_AMIB	AS LONG, _
       hdcMem_AMIB		AS LONG
      DIM hbm_AMIB		AS LONG, _
       hbmOld_AMIB		AS LONG

      DIM BMPMenu AS QBITMAP

      SUB CreateMenuBitmap (mPopup AS QPOPUPMENU, mItem AS INTEGER, flag_mItem AS LONG, Me AS QBITMAP)
       DIM Ret AS LONG
       DIM size AS Size_AMIB
       IF flag_mItem <> MF_BYPOSITION_AMIB THEN _
        flag_mItem = MF_BYCOMMAND_AMIB

	' Crée un DC compatible avec l'image en cours.
       hdcMem_AMIB		= CreateCompatibleDC_AMIB	(Me.Handle)
	' Détermine la taille de l'image requise.
       size.cx			= GetSystemMetrics_AMIB		(SM_CXMENUCHECK_AMIB)
       size.cy			= GetSystemMetrics_AMIB		(SM_CYMENUCHECK_AMIB)
	' Crée un bitmap et le sélectionne.
       hbm_AMIB		= CreateCompatibleBitmap_AMIB (Me.Handle, Me.Width, Me.Height)
       hbmOld_AMIB		= SelectObject_AMIB			(hdcMem_AMIB, hbm_AMIB)

	' Définie la transparence du DC.
       SetBkMode_AMIB	hdcMem_AMIB, TRANSPARENT_AMIB
	' Efface le fond du DC.
       PatBlt_AMIB		(hdcMem_AMIB, 0, 0, size.cx, size.cy, WHITENESS_AMIB)

	' Copie l'image
       TransparentBlt_AMIB ( hdcMem_AMIB, 0, 0, _
        size.cx, size.cy, _
        Me.Handle, 0, 0, _
        Me.Width, Me.Height, _
        Me.Pixel(0,0))

	' Place l'image dans l'item du menu
       IF hbm_AMIB <> 0 THEN
        Ret = SetMenuItemBitmaps_AMIB (mPopup.Handle, mItem, flag_mItem, hbm_AMIB, hbm_AMIB)
        IF Ret = 0 THEN SHOWMESSAGE "Erreur:: imposible de définir l'handle, mnuindex%" +STR$(mItem)
       ELSE
        SHOWMESSAGE "Erreur:: bitmap invalide, mnuindex%" +STR$(mItem)
       END IF

	' Nettoie les ressources
       SelectObject_AMIB	(hdcMem_AMIB, hbmOld_AMIB)
       DeleteDC_AMIB		(hdcMem_AMIB)

      END SUB


      SUB ClearMenuBitmap (mPopup AS QPOPUPMENU, mItem AS LONG, flag_mItem AS LONG)
       IF flag_mItem <> MF_BYPOSITION_AMIB THEN _
        flag_mItem = MF_BYCOMMAND_AMIB

       SetMenuItemBitmaps_AMIB (mPopup.Handle, mItem, flag_mItem, 0, 0)
      END SUB
     $ENDIF ' _AMIB

2013-06-19 07:50